1353 files changed, 40119 insertions, 36938 deletions

diff --git a/.circleci/config.yml b/.circleci/config.yml
new file mode 100644
index 000000000..352ec5a51
--- /dev/null
+++ b/.circleci/config.yml
@@ -0,0 +1,272 @@
+# This file used to contain configuration to also build documentation and CoqIDE,
+# run the test-suite and the validate targets,
+# including with 32-bits architecture or bleeding-edge compiler.
+
+defaults:
+  params: &params
+    # Following parameters are used in Coq CircleCI Job (using yaml
+    # reference syntax)
+    working_directory: ~/coq
+    docker:
+      - image: ocaml/opam:ubuntu
+
+  environment: &envvars
+    # required by some of the targets, e.g. compcert, passed for
+    # instance to opam to configure the number of parallel jobs
+    # allowed
+    NJOBS: 2
+    COMPILER: "system"
+    CAMLP5_VER: "6.14"
+    NATIVE_COMP: "yes"
+
+    # some useful values
+    TIMING_PACKAGES: &timing-packages "time python"
+
+version: 2
+
+before_script: &before_script
+  name: Install system packages
+  command: |
+    echo export TERM=xterm >> ~/.profile
+    source ~/.profile
+    printenv
+    if [ -n "${EXTRA_PACKAGES}" ]; then sudo apt-get update -yq && sudo apt-get install -yq --no-install-recommends ${EXTRA_PACKAGES}; fi
+
+opam-switch: &opam-switch
+  name: Select opam switch
+  command: |
+    source ~/.profile
+    opam switch ${COMPILER}
+    opam config list
+    opam list
+
+.opam-boot-template: &opam-boot-template
+  <<: *params
+  steps:
+    - checkout
+    - run: *before_script
+    - run:
+        name: Cache selection
+        command: |
+          source ~/.profile
+          # We can't use environment variables in cache names
+          # So put it in a file and use the checksum
+          echo "$COMPILER" > COMPILER
+    - restore_cache:
+        keys:
+          - coq-opam-cache-v1-{{ arch }}-{{ checksum "COMPILER" }}-{{ checksum ".circleci/config.yml" }}-
+          - coq-opam-cache-v1-{{ arch }}-{{ checksum "COMPILER" }}- # this grabs old cache if checksum doesn't match
+    - run:
+        name: Update opam lists
+        command: |
+          source ~/.profile
+          opam repository set-url default https://opam.ocaml.org
+          opam update
+    - run:
+        name: Install opam packages
+        command: |
+          source ~/.profile
+          opam switch -j ${NJOBS} ${COMPILER}
+          opam install -j ${NJOBS} -y camlp5.${CAMLP5_VER} ocamlfind ${EXTRA_OPAM}
+    - run:
+        name: Clean cache
+        command: |
+          source ~/.profile
+          rm -rf ~/.opam/log/
+    - save_cache:
+        key: coq-opam-cache-v1-{{ arch }}-{{ checksum "COMPILER" }}-{{ checksum ".circleci/config.yml" }}-
+        paths:
+          - ~/.opam
+    - persist_to_workspace:
+        root: &workspace ~/
+        paths:
+          - .opam/
+
+.build-template: &build-template
+  <<: *params
+  steps:
+    - checkout
+    - run: *before_script
+    - attach_workspace: &attach_workspace
+        at: *workspace
+    - run: *opam-switch
+    - run: &build-configure
+        name: Configure
+        command: |
+          source ~/.profile
+
+          ./configure -local -native-compiler ${NATIVE_COMP} -coqide no
+    - run: &build-build
+        name: Build
+        command: |
+          source ~/.profile
+          make -j ${NJOBS} byte
+          make -j ${NJOBS}
+          make test-suite/misc/universes/all_stdlib.v
+    - persist_to_workspace:
+        root: *workspace
+        paths:
+          - coq/
+
+  environment: *envvars
+
+.ci-template: &ci-template
+  <<: *params
+  steps:
+    - run: *before_script
+    - attach_workspace: *attach_workspace
+    - run:
+        name: Test
+        command: |
+          source ~/.profile
+          dev/ci/ci-wrapper.sh ${CIRCLE_JOB}
+    - persist_to_workspace:
+        root: *workspace
+        paths:
+          - coq/
+  environment: &ci-template-vars
+    <<: *envvars
+    EXTRA_PACKAGES: *timing-packages
+
+# Defines individual jobs, see the workflows section below for job orchestration
+jobs:
+
+  opam-boot:
+    <<: *opam-boot-template
+    environment:
+      <<: *envvars
+      EXTRA_OPAM: "ocamlgraph ppx_tools_versioned ppx_deriving ocaml-migrate-parsetree"
+
+  # Build and prepare test environment
+  build: *build-template
+
+  bignums:
+    <<: *ci-template
+
+  color:
+    <<: *ci-template
+    environment:
+      <<: *ci-template-vars
+      EXTRA_PACKAGES: *timing-packages
+
+  compcert:
+    <<: *ci-template
+
+  coq-dpdgraph:
+    <<: *ci-template
+    environment:
+      <<: *ci-template-vars
+      EXTRA_PACKAGES: "time python autoconf automake"
+
+  coquelicot:
+    <<: *ci-template
+    environment:
+      <<: *ci-template-vars
+      EXTRA_PACKAGES: "time python autoconf automake"
+
+  elpi:
+    <<: *ci-template
+
+  equations:
+    <<: *ci-template
+
+  geocoq:
+    <<: *ci-template
+
+  fiat-crypto:
+    <<: *ci-template
+
+  fiat-parsers:
+    <<: *ci-template
+    environment:
+      <<: *ci-template-vars
+      EXTRA_PACKAGES: *timing-packages
+
+  flocq:
+    <<: *ci-template
+    environment:
+      <<: *ci-template-vars
+      EXTRA_PACKAGES: "time python autoconf automake"
+
+  math-classes:
+    <<: *ci-template
+
+  corn:
+    <<: *ci-template
+
+  formal-topology:
+    <<: *ci-template
+
+  hott:
+    <<: *ci-template
+    environment:
+      <<: *ci-template-vars
+      EXTRA_PACKAGES: "time python autoconf automake"
+
+  iris-lambda-rust:
+    <<: *ci-template
+
+  ltac2:
+    <<: *ci-template
+
+  math-comp:
+    <<: *ci-template
+
+  sf:
+    <<: *ci-template
+    environment:
+      <<: *ci-template-vars
+      EXTRA_PACKAGES: "time python wget"
+
+  unimath:
+    <<: *ci-template
+
+  vst:
+    <<: *ci-template
+
+workflows:
+  version: 2
+  # Run on each push
+  main:
+    jobs:
+      - opam-boot
+
+      - build:
+          requires:
+            - opam-boot
+
+      - bignums: &req-main
+          requires:
+            - build
+      - color:
+          requires:
+            - build
+            - bignums
+      - compcert: *req-main
+      - coq-dpdgraph: *req-main
+      - coquelicot: *req-main
+      - elpi: *req-main
+      - equations: *req-main
+      - geocoq: *req-main
+      - fiat-crypto: *req-main
+      - fiat-parsers: *req-main
+      - flocq: *req-main
+      - math-classes:
+          requires:
+            - build
+            - bignums
+      - corn:
+          requires:
+            - build
+            - math-classes
+      - formal-topology:
+          requires:
+            - build
+            - corn
+      - hott: *req-main
+      - iris-lambda-rust: *req-main
+      - ltac2: *req-main
+      - math-comp: *req-main
+      - sf: *req-main
+      - unimath: *req-main
+      - vst: *req-main
diff --git a/.dir-locals.el b/.dir-locals.el
deleted file mode 100644
index e32ce14a4..000000000
--- a/.dir-locals.el
+++ /dev/null
@@ -1,37 +0,0 @@
-;; EMACS CONFIGURATION FOR COQ DEVELOPPERS This configuration will be
-;; executed for each opened file under coq root directory.
-((nil
-  . ((eval
-      . (progn
-	  ;; coq root directory (ending with slash)
-	  (let ((coq-root-directory (when buffer-file-name
-				      (locate-dominating-file
-				       buffer-file-name
-				       ".dir-locals.el")))
-		(coq-project-find-file
-		 (and (boundp 'coq-project-find-file) coq-project-find-file)))
-	    ;; coq tags file and coq debugger executable
-	    (set (make-local-variable 'tags-file-name)
-		 (concat coq-root-directory "TAGS"))
-	    (setq camldebug-command-name (concat coq-root-directory
-						 "dev/ocamldebug-coq"))
-
-	    ;; Setting the compilation directory to coq root. This is
-	    ;; mutually exclusive with the setting of default-directory
-	    ;; below. Also setting the path for next error.
-	    (unless coq-project-find-file
-	      (set (make-local-variable 'compile-command)
-		   (concat "make -C " coq-root-directory))
-	      (set (make-local-variable 'compilation-search-path)
-		   (cons coq-root-directory nil)))
-
-	    ;; Set default directory to coq root ONLY IF variable
-	    ;; coq-project-find-file is non nil. This should remain a
-	    ;; user preference and not be set by default. This setting
-	    ;; is redundant with compile-command above as M-x compile
-	    ;; always CD's to default directory. To enable it add this
-	    ;; to your emacs config: (setq coq-project-find-file t)
-	    (when coq-project-find-file
-	      (setq default-directory coq-root-directory))))
-      ))
-  ))
diff --git a/.gitattributes b/.gitattributes
index 6af0a106b..51fa208a7 100644
--- a/.gitattributes
+++ b/.gitattributes
@@ -1,5 +1,38 @@
-.dir-locals.el export-ignore
 .gitattributes export-ignore
 .gitignore export-ignore
 .mailmap export-ignore
-TODO export-ignore
+
+*.out -whitespace
+
+*.asciidoc whitespace=trailing-space,tab-in-indent
+*.bat whitespace=cr-at-eol,trailing-space,tab-in-indent
+*.bib whitespace=trailing-space,tab-in-indent
+*.c whitespace=trailing-space,tab-in-indent
+*.css whitespace=trailing-space,tab-in-indent
+*.dtd whitespace=trailing-space,tab-in-indent
+*.el whitespace=trailing-space,tab-in-indent
+*.h whitespace=trailing-space,tab-in-indent
+*.html whitespace=trailing-space,tab-in-indent
+*.hva whitespace=trailing-space,tab-in-indent
+*.js whitespace=trailing-space,tab-in-indent
+*.json whitespace=trailing-space,tab-in-indent
+*.lang whitespace=trailing-space,tab-in-indent
+*.md whitespace=trailing-space,tab-in-indent
+*.merlin whitespace=trailing-space,tab-in-indent
+*.ml whitespace=trailing-space,tab-in-indent
+*.ml4 whitespace=trailing-space,tab-in-indent
+*.mli whitespace=trailing-space,tab-in-indent
+*.mll whitespace=trailing-space,tab-in-indent
+*.mllib whitespace=trailing-space,tab-in-indent
+*.mlp whitespace=trailing-space,tab-in-indent
+*.mlpack whitespace=trailing-space,tab-in-indent
+*.nsh whitespace=trailing-space,tab-in-indent
+*.nsi whitespace=trailing-space,tab-in-indent
+*.py whitespace=trailing-space,tab-in-indent
+*.sh whitespace=trailing-space,tab-in-indent
+*.sty whitespace=trailing-space,tab-in-indent
+*.tex whitespace=trailing-space,tab-in-indent
+*.txt whitespace=trailing-space,tab-in-indent
+*.v whitespace=trailing-space,tab-in-indent
+*.xml whitespace=trailing-space,tab-in-indent
+*.yml whitespace=trailing-space,tab-in-indent
diff --git a/.github/ISSUE_TEMPLATE.md b/.github/ISSUE_TEMPLATE.md
new file mode 100644
index 000000000..c9cb516cd
--- /dev/null
+++ b/.github/ISSUE_TEMPLATE.md
@@ -0,0 +1,18 @@
+<!-- Thank you for your contribution.
+     Please complete the following information when reporting a bug. -->
+
+#### Version
+
+<!-- You can get this information by running `coqtop -v`. -->
+
+
+#### Operating system
+
+
+#### Description of the problem
+
+<!-- It is helpful to provide enough information so that we can reproduce the bug.
+     In particular, please include a code example which produces it.
+     If the example is small, you can include it here between ``` ```.
+     Otherwise, please provide a link to a repository, a gist (https://gist.github.com)
+     or drag-and-drop a `.zip` archive. -->
diff --git a/.github/PULL_REQUEST_TEMPLATE.md b/.github/PULL_REQUEST_TEMPLATE.md
new file mode 100644
index 000000000..a9230042a
--- /dev/null
+++ b/.github/PULL_REQUEST_TEMPLATE.md
@@ -0,0 +1,16 @@
+<!-- Thank you for your contribution.
+     Make sure you read the contributing guide and fill this template. -->
+
+
+<!-- Keep what applies -->
+**Kind:** documentation / bug fix / feature / performance / infrastructure.
+
+
+<!-- If this is a bug fix, make sure the bug was reported beforehand. -->
+Fixes / closes #????
+
+
+<!-- If this is a feature pull request / breaks compatibility: -->
+<!-- (Otherwise, remove these lines.) -->
+- [ ] Corresponding documentation was added / updated.
+- [ ] Entry added in CHANGES.
diff --git a/.gitignore b/.gitignore
index 36536ec96..b857b754a 100644
--- a/.gitignore
+++ b/.gitignore
@@ -55,7 +55,7 @@ config/Makefile
 config/coq_config.ml
 config/Info-*.plist
 dev/ocamldebug-coq
-dev/camlp4.dbg
+dev/camlp5.dbg
 plugins/micromega/csdpcert
 plugins/micromega/.micromega.ml.generated
 kernel/byterun/dllcoqrun.so
@@ -82,11 +82,10 @@ test-suite/coq-makefile/*/html
 test-suite/coq-makefile/*/mlihtml
 test-suite/coq-makefile/*/subdir/done
 test-suite/coq-makefile/merlin1/.merlin
-test-suite/coq-makefile/plugin-reach-outside-API-and-fail/_CoqProject
-test-suite/coq-makefile/plugin-reach-outside-API-and-succeed-by-bypassing-the-API/_CoqProject
 test-suite/coqdoc/Coqdoc.*
 test-suite/coqdoc/index.html
 test-suite/coqdoc/coqdoc.css
+test-suite/output/MExtraction.out
 
 # documentation
 
@@ -157,7 +156,6 @@ plugins/ssr/ssrvernac.ml
 
 kernel/byterun/coq_jumptbl.h
 kernel/copcodes.ml
-tools/tolink.ml
 ide/index_urls.txt
 .lia.cache
 checker/names.ml
diff --git a/.gitlab-ci.yml b/.gitlab-ci.yml
index 8beeffcca..5dd376079 100644
--- a/.gitlab-ci.yml
+++ b/.gitlab-ci.yml
@@ -18,14 +18,15 @@ variables:
   # some useful values
   COMPILER_32BIT: "4.02.3+32bit"
 
-  COMPILER_BLEEDING_EDGE: "4.05.0"
-  CAMLP5_VER_BLEEDING_EDGE: "7.01"
+  COMPILER_BLEEDING_EDGE: "4.06.0"
+  CAMLP5_VER_BLEEDING_EDGE: "7.03"
 
-  TEST_PACKAGES: "time python"
+  TIMING_PACKAGES: "time python"
 
   COQIDE_PACKAGES: "libgtk2.0-dev libgtksourceview2.0-dev"
   #COQIDE_PACKAGES_32BIT: "libgtk2.0-dev:i386 libgtksourceview2.0-dev:i386"
   COQIDE_OPAM: "lablgtk-extras"
+  COQIDE_OPAM_BE: "num lablgtk.2.18.6 lablgtk-extras.1.6"
   COQDOC_PACKAGES: "texlive-latex-base texlive-latex-recommended texlive-latex-extra texlive-math-extra texlive-fonts-recommended texlive-fonts-extra latex-xcolor ghostscript transfig imagemagick tipa"
   COQDOC_OPAM: "hevea"
 
@@ -58,23 +59,27 @@ before_script:
   artifacts:
     name: "$CI_JOB_NAME"
     paths:
-      - install
+      - _install_ci
       - config/Makefile
+      - test-suite/misc/universes/all_stdlib.v
     expire_in: 1 week
   script:
     - set -e
 
     - echo 'start:coq.config'
-    - ./configure -prefix "$(pwd)/install" ${EXTRA_CONF}
+    - ./configure -prefix "$(pwd)/_install_ci" ${EXTRA_CONF}
     - echo 'end:coq.config'
 
     - echo 'start:coq.build'
+    - make -j ${NJOBS} byte
     - make -j ${NJOBS}
+    - make test-suite/misc/universes/all_stdlib.v
     - echo 'end:coq:build'
 
     - echo 'start:coq.install'
     - make install
-    - cp bin/fake_ide install/bin/
+    - make install-byte
+    - cp bin/fake_ide _install_ci/bin/
     - echo 'end:coq.install'
 
     - set +e
@@ -100,7 +105,7 @@ before_script:
 
     - set +e
   variables: &warnings-variables
-    EXTRA_CONF: "-native-compiler yes -coqide opt"
+    EXTRA_CONF: "-native-compiler yes -coqide byte -byte-only"
     EXTRA_PACKAGES: "$COQIDE_PACKAGES"
     EXTRA_OPAM: "$COQIDE_OPAM"
 
@@ -110,7 +115,9 @@ before_script:
     - cd test-suite
     - make clean
     # careful with the ending /
-    - make -j ${NJOBS} BIN=$(readlink -f ../install/bin)/ LIB=$(readlink -f ../install/lib/coq)/ all
+    - BIN=$(readlink -f ../_install_ci/bin)/
+    - LIB=$(readlink -f ../_install_ci/lib/coq)/
+    - make -j ${NJOBS} BIN="$BIN" LIB="$LIB" all
   artifacts:
     name: "$CI_JOB_NAME.logs"
     when: on_failure
@@ -120,7 +127,7 @@ before_script:
 .validate-template: &validate-template
   stage: test
   script:
-    - cd install
+    - cd _install_ci
     - find lib/coq/ -name '*.vo' -print0 > vofiles
     - for regexp in 's/.vo//' 's:lib/coq/plugins:Coq:' 's:lib/coq/theories:Coq:' 's:/:.:g'; do sed -z -i "$regexp" vofiles; done
     - xargs -0 --arg-file=vofiles bin/coqchk -boot -silent -o -m -coqlib lib/coq/
@@ -128,10 +135,9 @@ before_script:
 .documentation-template: &documentation-template
   stage: test
   script:
-    - ./configure -prefix "$(pwd)/install" ${EXTRA_CONF}
-    - cp install/lib/coq/tools/coqdoc/coqdoc.sty .
+    - INSTALLDIR=$(readlink -f _install_ci)
+    - cp "$INSTALLDIR/lib/coq/tools/coqdoc/coqdoc.sty" .
 
-    - INSTALLDIR=$(readlink -f install)
     - LIB="$INSTALLDIR/lib/coq"
     # WTF using a newline makes make sigsev
     # see https://gitlab.com/SkySkimmer/coq/builds/17313312
@@ -145,7 +151,7 @@ before_script:
   artifacts:
     name: "$CI_JOB_NAME"
     paths:
-      - install/share/doc
+      - _install_ci/share/doc
     expire_in: 1 week
 
 .ci-template: &ci-template
@@ -160,6 +166,7 @@ before_script:
     - build
   variables: &ci-template-vars
     TEST_TARGET: "$CI_JOB_NAME"
+    EXTRA_PACKAGES: "$TIMING_PACKAGES"
 
 build:
   <<: *build-template
@@ -178,6 +185,7 @@ build:bleeding-edge:
     <<: *build-variables
     COMPILER: "$COMPILER_BLEEDING_EDGE"
     CAMLP5_VER: "$CAMLP5_VER_BLEEDING_EDGE"
+    EXTRA_OPAM: "$COQIDE_OPAM_BE"
 
 warnings:
   <<: *warnings-template
@@ -195,13 +203,14 @@ warnings:bleeding-edge:
     <<: *warnings-variables
     COMPILER: "$COMPILER_BLEEDING_EDGE"
     CAMLP5_VER: "$CAMLP5_VER_BLEEDING_EDGE"
+    EXTRA_OPAM: "$COQIDE_OPAM_BE"
 
 test-suite:
   <<: *test-suite-template
   dependencies:
     - build
   variables:
-    EXTRA_PACKAGES: "$TEST_PACKAGES"
+    EXTRA_PACKAGES: "$TIMING_PACKAGES"
 
 test-suite:32bit:
   <<: *test-suite-template
@@ -209,7 +218,7 @@ test-suite:32bit:
     - build:32bit
   variables:
     COMPILER: "$COMPILER_32BIT"
-    EXTRA_PACKAGES: "gcc-multilib $TEST_PACKAGES"
+    EXTRA_PACKAGES: "gcc-multilib $TIMING_PACKAGES"
 
 test-suite:bleeding-edge:
   <<: *test-suite-template
@@ -218,7 +227,7 @@ test-suite:bleeding-edge:
   variables:
     COMPILER: "$COMPILER_BLEEDING_EDGE"
     CAMLP5_VER: "$CAMLP5_VER_BLEEDING_EDGE"
-    EXTRA_PACKAGES: "$TEST_PACKAGES"
+    EXTRA_PACKAGES: "$TIMING_PACKAGES"
 
 documentation:
   <<: *documentation-template
@@ -258,7 +267,7 @@ ci-color:
   <<: *ci-template
   variables:
     <<: *ci-template-vars
-    EXTRA_PACKAGES: "subversion"
+    EXTRA_PACKAGES: "$TIMING_PACKAGES"
 
 ci-compcert:
   <<: *ci-template
@@ -268,13 +277,22 @@ ci-coq-dpdgraph:
   variables:
     <<: *ci-template-vars
     EXTRA_OPAM: "ocamlgraph"
-    EXTRA_PACKAGES: "autoconf"
+    EXTRA_PACKAGES: "$TIMING_PACKAGES autoconf"
 
 ci-coquelicot:
   <<: *ci-template
   variables:
     <<: *ci-template-vars
-    EXTRA_PACKAGES: "autoconf"
+    EXTRA_PACKAGES: "$TIMING_PACKAGES autoconf"
+
+ci-elpi:
+  <<: *ci-template
+  variables:
+    <<: *ci-template-vars
+    EXTRA_OPAM: "ppx_tools_versioned ppx_deriving ocaml-migrate-parsetree"
+
+ci-equations:
+  <<: *ci-template
 
 ci-geocoq:
   <<: *ci-template
@@ -289,13 +307,13 @@ ci-fiat-parsers:
   <<: *ci-template
   variables:
     <<: *ci-template-vars
-    EXTRA_PACKAGES: "python"
+    EXTRA_PACKAGES: "$TIMING_PACKAGES"
 
 ci-flocq:
   <<: *ci-template
   variables:
     <<: *ci-template-vars
-    EXTRA_PACKAGES: "autoconf"
+    EXTRA_PACKAGES: "$TIMING_PACKAGES autoconf"
 
 ci-formal-topology:
   <<: *ci-template
@@ -304,9 +322,12 @@ ci-hott:
   <<: *ci-template
   variables:
     <<: *ci-template-vars
-    EXTRA_PACKAGES: "autoconf"
+    EXTRA_PACKAGES: "$TIMING_PACKAGES autoconf"
+
+ci-iris-lambda-rust:
+  <<: *ci-template
 
-ci-iris-coq:
+ci-ltac2:
   <<: *ci-template
 
 ci-math-classes:
@@ -319,7 +340,7 @@ ci-sf:
   <<: *ci-template
   variables:
     <<: *ci-template-vars
-    EXTRA_PACKAGES: "wget"
+    EXTRA_PACKAGES: "$TIMING_PACKAGES wget"
 
 ci-unimath:
   <<: *ci-template
diff --git a/.mailmap b/.mailmap
index b4271b961..3d40a2df7 100644
--- a/.mailmap
+++ b/.mailmap
@@ -55,6 +55,7 @@ Tom Hutchinson <thutchin@gforge>                   thutchin <thutchin@85f007b7-5
 Cezary Kaliszyk <cek@gforge>                       cek <cek@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Florent Kirchner <fkirchne@gforge>                 fkirchne <fkirchne@85f007b7-540e-0410-9357-904b9bb8a0f7>
 Florent Kirchner <fkirchne@gforge>                 kirchner <kirchner@85f007b7-540e-0410-9357-904b9bb8a0f7>
+Johannes Kloos <jkloos@mpi-sws.org>                jkloos <jkloos@mpi-sws.org>
 Matej Košík <matej.kosik@inria.fr>                 Matej Kosik <m4tej.kosik@gmail.com>
 Matej Košík <matej.kosik@inria.fr>                 Matej Kosik <matej.kosik@inria.fr>
 Marc Lasson <marc.lasson@gmail.com>                mlasson <marc.lasson@gmail.com>
diff --git a/.merlin b/.merlin
index 21555f5e5..d60f5037b 100644
--- a/.merlin
+++ b/.merlin
@@ -1,17 +1,17 @@
 FLG -rectypes -thread -safe-string -w +a-4-9-27-41-42-44-45-48-50
 
+S clib
+B clib
 S config
 B config
-S ide
-B ide
 S lib
 B lib
-S intf
-B intf
 S kernel
 B kernel
 S kernel/byterun
 B kernel/byterun
+S intf
+B intf
 S library
 B library
 S engine
@@ -30,14 +30,16 @@ S parsing
 B parsing
 S stm
 B stm
-S toplevel
-B toplevel
 S vernac
 B vernac
+S toplevel
+B toplevel
 S plugins/ltac
 B plugins/ltac
 S API
 B API
+S ide
+B ide
 
 S tools
 B tools
diff --git a/.travis.yml b/.travis.yml
index 2d6d9a2a6..f4f01d2f0 100644
--- a/.travis.yml
+++ b/.travis.yml
@@ -20,57 +20,122 @@ addons:
   apt:
     sources:
     - avsm
-    packages:
-    - opam
-    - aspcud
-    - gcc-multilib
+## Due to issues like
+## https://github.com/travis-ci/travis-ci/issues/8507 ,
+## https://github.com/travis-ci/travis-ci/issues/9000 ,
+## https://github.com/travis-ci/travis-ci/issues/9081 , and
+## https://github.com/travis-ci/travis-ci/issues/9126 , we get frequent
+## failures with using `packages`.  Therefore, for most targets, we
+## instead invoke `apt-get update` manually with `travis_retry` before
+## invoking `apt-get install`, manually, below in the `install:`
+## target.
+#    packages:
+#    - opam
+#    - aspcud
+#    - gcc-multilib
 
 env:
   global:
   - NJOBS=2
   # system is == 4.02.3
   - COMPILER="system"
+  - COMPILER_BE="4.06.0"
   - CAMLP5_VER="6.14"
+  - CAMLP5_VER_BE="7.03"
+  - FINDLIB_VER="1.4.1"
+  - FINDLIB_VER_BE="1.7.3"
+  - LABLGTK="lablgtk.2.18.3 lablgtk-extras.1.6"
+  - LABLGTK_BE="lablgtk.2.18.6 lablgtk-extras.1.6"
   - NATIVE_COMP="yes"
   - COQ_DEST="-local"
+  - MAIN_TARGET="world"
   # 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-bignums TIMED=1"
-  - TEST_TARGET="ci-color TIMED=1"
-  - TEST_TARGET="ci-compcert TIMED=1"
-  - TEST_TARGET="ci-coq-dpdgraph" EXTRA_OPAM="ocamlgraph"
-  - TEST_TARGET="ci-coquelicot TIMED=1"
-  - TEST_TARGET="ci-geocoq TIMED=1"
-  - TEST_TARGET="ci-fiat-crypto TIMED=1"
-  - TEST_TARGET="ci-fiat-parsers TIMED=1"
-  - TEST_TARGET="ci-flocq TIMED=1"
-  - TEST_TARGET="ci-formal-topology TIMED=1"
-  - TEST_TARGET="ci-hott TIMED=1"
-  - TEST_TARGET="ci-iris-coq TIMED=1"
-  - TEST_TARGET="ci-math-classes TIMED=1"
-  - TEST_TARGET="ci-math-comp TIMED=1"
-  - TEST_TARGET="ci-sf TIMED=1"
-  - TEST_TARGET="ci-unimath TIMED=1"
-  - TEST_TARGET="ci-vst TIMED=1"
-  # Not ready yet for 8.7
-  # - TEST_TARGET="ci-cpdt TIMED=1"
-  # - TEST_TARGET="ci-metacoq TIMED=1"
-  # - TEST_TARGET="ci-tlc TIMED=1"
+  - TEST_TARGET="validate"   COMPILER="${COMPILER_BE}+flambda" CAMLP5_VER="${CAMLP5_VER_BE}" NATIVE_COMP="no" EXTRA_CONF="-flambda-opts -O3" EXTRA_OPAM="num" FINDLIB_VER="${FINDLIB_VER_BE}"
 
 matrix:
 
-  allow_failures:
-  - env: TEST_TARGET="ci-geocoq TIMED=1"
-
   include:
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-bignums"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-color"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-compcert"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-coq-dpdgraph" EXTRA_OPAM="ocamlgraph"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-coquelicot"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-elpi" EXTRA_OPAM="ppx_tools_versioned ppx_deriving ocaml-migrate-parsetree"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-equations"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-geocoq"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-fiat-crypto"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-fiat-parsers"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-flocq"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-formal-topology"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-hott"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-iris-lambda-rust"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-ltac2"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-math-classes"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-math-comp"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-sf"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-unimath"
+    - if: NOT (type = pull_request)
+      env:
+      - TEST_TARGET="ci-vst"
+
+    - env:
+      - TEST_TARGET="lint"
+      install: []
+      before_script: []
+      addons:
+      apt:
+        sources: []
+        packages: []
+      script:
+        - dev/lint-repository.sh
+
     # Full Coq test-suite with two compilers
     - env:
       - TEST_TARGET="test-suite"
       - EXTRA_CONF="-coqide opt -with-doc yes"
-      - EXTRA_OPAM="lablgtk-extras hevea"
+      - EXTRA_OPAM="hevea ${LABLGTK}"
       addons:
         apt:
           sources:
@@ -94,10 +159,26 @@ matrix:
 
     - env:
       - TEST_TARGET="test-suite"
-      - COMPILER="4.05.0"
-      - CAMLP5_VER="7.01"
+      - COMPILER="${COMPILER_BE}"
+      - FINDLIB_VER="${FINDLIB_VER_BE}"
+      - CAMLP5_VER="${CAMLP5_VER_BE}"
       - EXTRA_CONF="-coqide opt -with-doc yes"
-      - EXTRA_OPAM="lablgtk-extras hevea"
+      - EXTRA_OPAM="num hevea ${LABLGTK_BE}"
+      addons:
+        apt:
+          sources:
+          - avsm
+          packages: *extra-packages
+
+    # Full test-suite with flambda
+    - env:
+      - TEST_TARGET="test-suite"
+      - COMPILER="${COMPILER_BE}+flambda"
+      - FINDLIB_VER="${FINDLIB_VER_BE}"
+      - CAMLP5_VER="${CAMLP5_VER_BE}"
+      - NATIVE_COMP="no"
+      - EXTRA_CONF="-coqide opt -with-doc yes -flambda-opts -O3"
+      - EXTRA_OPAM="num hevea ${LABLGTK_BE}"
       addons:
         apt:
           sources:
@@ -106,9 +187,9 @@ matrix:
 
     # Ocaml warnings with two compilers
     - env:
-      - TEST_TARGET="coqocaml"
-      - EXTRA_CONF="-coqide opt -warn-error"
-      - EXTRA_OPAM="lablgtk-extras hevea"
+      - MAIN_TARGET="coqocaml"
+      - EXTRA_CONF="-byte-only -coqide byte -warn-error"
+      - EXTRA_OPAM="hevea ${LABLGTK}"
       # dummy target
       - BUILD_TARGET="clean"
       addons:
@@ -122,11 +203,12 @@ matrix:
           - libgtksourceview2.0-dev
 
     - env:
-      - TEST_TARGET="coqocaml"
-      - COMPILER="4.05.0"
-      - CAMLP5_VER="7.01"
-      - EXTRA_CONF="-coqide opt -warn-error"
-      - EXTRA_OPAM="lablgtk-extras hevea"
+      - MAIN_TARGET="coqocaml"
+      - COMPILER="${COMPILER_BE}"
+      - FINDLIB_VER="${FINDLIB_VER_BE}"
+      - CAMLP5_VER="${CAMLP5_VER_BE}"
+      - EXTRA_CONF="-byte-only -coqide byte -warn-error"
+      - EXTRA_OPAM="num hevea ${LABLGTK_BE}"
       # dummy target
       - BUILD_TARGET="clean"
       addons:
@@ -139,14 +221,16 @@ matrix:
       env:
       - TEST_TARGET="test-suite"
       - COMPILER="4.02.3"
-      - CAMLP5_VER="6.17"      
+      - CAMLP5_VER="6.17"
       - NATIVE_COMP="no"
       - COQ_DEST="-local"
       before_install:
       - brew update
       - brew install opam gnu-time
 
-    - os: osx
+    - if: NOT (type = pull_request)
+      os: osx
+      osx_image: xcode7.3
       env:
       - TEST_TARGET=""
       - COMPILER="4.02.3"
@@ -154,7 +238,7 @@ matrix:
       - NATIVE_COMP="no"
       - COQ_DEST="-prefix ${PWD}/_install"
       - EXTRA_CONF="-coqide opt -warn-error"
-      - EXTRA_OPAM="lablgtk-extras"
+      - EXTRA_OPAM="${LABLGTK}"
       before_install:
       - brew update
       - brew install opam gnu-time gtk+ expat gtksourceview libxml2 gdk-pixbuf python3
@@ -170,23 +254,17 @@ matrix:
         skip_cleanup: true
         on:
           all_branches: true
-      - provider: releases
-        api_key:
-          secure: "Z/ewvydCLXEhlBBtQGYm2nZ8o+2RP+MwA5uEDuu6mEpZttUZAYaoHivChxADLXz8LNKvUloIeBeIL/PrLk6QnhSur/s2iEYHssrnl99SkAPtoWggyfsdacuKLMkpLoZGOBIEYKPuXuEZyqvugSUO42rSya1zdjcnXc4l+E/bXMc="
-        file: _build/*.dmg
-        skip_cleanup: true
-        on:
-          tags: true
-          repo: coq/coq
 
 before_install:
 - if [ "${TRAVIS_PULL_REQUEST}" != "false" ]; then echo "Tested commit (followed by parent commits):"; git log -1; for commit in `git log -1 --format="%P"`; do echo; git log -1 $commit; done; fi
 
 install:
+- if [ "${TRAVIS_OS_NAME}" == "linux" ]; then travis_retry ./dev/tools/sudo-apt-get-update.sh -q; fi
+- if [ "${TRAVIS_OS_NAME}" == "linux" ]; then sudo apt-get install -y opam aspcud gcc-multilib; fi
 - opam init -j ${NJOBS} --compiler=${COMPILER} -n -y
 - eval $(opam config env)
 - opam config list
-- opam install -j ${NJOBS} -y camlp5.${CAMLP5_VER} ocamlfind ${EXTRA_OPAM}
+- opam install -j ${NJOBS} -y camlp5.${CAMLP5_VER} ocamlfind.${FINDLIB_VER} ${EXTRA_OPAM}
 - opam list
 
 script:
@@ -197,11 +275,11 @@ script:
 - echo -en 'travis_fold:end:coq.config\\r'
 
 - echo 'Building Coq...' && echo -en 'travis_fold:start:coq.build\\r'
-- make -j ${NJOBS}
+- make -j ${NJOBS} ${MAIN_TARGET}
 - 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}
+- if [ -n "${TEST_TARGET}" ]; then ${TW} make -j ${NJOBS} ${TEST_TARGET}; fi
 - echo -en 'travis_fold:end:coq.test\\r'
 - set +e
 
diff --git a/API/API.ml b/API/API.ml
deleted file mode 100644
index c4bcef6f6..000000000
--- a/API/API.ml
+++ /dev/null
@@ -1,284 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(* Warning, this file respects the dependency order established in Coq.
-
-   To see such order issue the comand:
-
-```
-bash -c 'for i in kernel intf library engine pretyping interp proofs parsing printing tactics vernac stm toplevel; do echo -e "\n## $i files" && cat ${i}/${i}.mllib; done && echo -e "\n## highparsing files" && cat parsing/highparsing.mllib' > API/link
-```
- *)
-
-(******************************************************************************)
-(* config                                                                     *)
-(******************************************************************************)
-module Coq_config = Coq_config
-
-(******************************************************************************)
-(* Kernel *)
-(******************************************************************************)
-(* "mli" files *)
-module Declarations = Declarations
-module Entries = Entries
-
-module Names = Names
-(* module Uint31 *)
-module Univ = Univ
-module UGraph = UGraph
-module Esubst = Esubst
-module Sorts = Sorts
-module Evar = Evar
-module Constr = Constr
-module Context = Context
-module Vars = Vars
-module Term = Term
-module Mod_subst = Mod_subst
-module Cbytecodes = Cbytecodes
-(* module Copcodes *)
-module Cemitcodes = Cemitcodes
-(* module Nativevalues *)
-(* module CPrimitives *)
-module Opaqueproof = Opaqueproof
-module Declareops = Declareops
-module Retroknowledge = Retroknowledge
-module Conv_oracle = Conv_oracle
-(* module Pre_env *)
-(* module Cbytegen *)
-(* module Nativelambda *)
-(* module Nativecode *)
-(* module Nativelib *)
-module Environ = Environ
-module CClosure = CClosure
-module Reduction = Reduction
-(* module Nativeconv *)
-module Type_errors = Type_errors
-module Modops = Modops
-module Inductive = Inductive
-module Typeops = Typeops
-(* module Indtypes *)
-(* module Cooking *)
-(* module Term_typing *)
-(* module Subtyping *)
-module Mod_typing = Mod_typing
-(* module Nativelibrary *)
-module Safe_typing = Safe_typing
-(* module Vm *)
-(* module Csymtable *)
-(* module Vconv *)
-
-(******************************************************************************)
-(* Intf                                                                       *)
-(******************************************************************************)
-module Constrexpr = Constrexpr
-module Locus = Locus
-module Glob_term = Glob_term
-module Extend = Extend
-module Misctypes = Misctypes
-module Decl_kinds = Decl_kinds
-module Vernacexpr = Vernacexpr
-module Notation_term = Notation_term
-module Evar_kinds = Evar_kinds
-module Genredexpr = Genredexpr
-
-(******************************************************************************)
-(* Library *)
-(******************************************************************************)
-module Univops = Univops
-module Nameops = Nameops
-module Libnames = Libnames
-module Globnames = Globnames
-module Libobject = Libobject
-module Summary = Summary
-module Nametab = Nametab
-module Global = Global
-module Lib = Lib
-module Declaremods = Declaremods
-(* module Loadpath *)
-module Library = Library
-module States = States
-module Kindops = Kindops
-(* module Dischargedhypsmap *)
-module Goptions = Goptions
-(* module Decls *)
-(* module Heads *)
-module Keys = Keys
-module Coqlib = Coqlib
-
-(******************************************************************************)
-(* Engine                                                                     *)
-(******************************************************************************)
-(* module Logic_monad *)
-module Universes = Universes
-module UState = UState
-module Evd = Evd
-module EConstr = EConstr
-module Tactypes = Tactypes
-module Pattern = Pattern
-module Namegen = Namegen
-module Termops = Termops
-module Proofview_monad = Proofview_monad
-module Evarutil = Evarutil
-module Proofview = Proofview
-module Ftactic = Ftactic
-module Geninterp = Geninterp
-
-(******************************************************************************)
-(* Pretyping                                                                  *)
-(******************************************************************************)
-module Locusops = Locusops
-module Pretype_errors = Pretype_errors
-module Reductionops = Reductionops
-module Inductiveops = Inductiveops
-(* module Vnorm *)
-(* module Arguments_renaming *)
-module Impargs = Impargs
-(* module Nativenorm *)
-module Retyping = Retyping
-(* module Cbv *)
-module Find_subterm = Find_subterm
-(* module Evardefine *)
-module Evarsolve = Evarsolve
-module Recordops = Recordops
-module Evarconv = Evarconv
-module Typing = Typing
-module Miscops = Miscops
-module Glob_ops = Glob_ops
-module Redops = Redops
-module Patternops = Patternops
-module Constr_matching = Constr_matching
-module Tacred = Tacred
-module Typeclasses = Typeclasses
-module Classops = Classops
-(* module Program *)
-(* module Coercion *)
-module Detyping = Detyping
-module Indrec = Indrec
-(* module Cases *)
-module Pretyping = Pretyping
-module Unification = Unification
-(******************************************************************************)
-(* interp                                                                     *)
-(******************************************************************************)
-module Stdarg = Stdarg
-module Genintern = Genintern
-module Constrexpr_ops = Constrexpr_ops
-module Notation_ops = Notation_ops
-module Notation = Notation
-module Dumpglob = Dumpglob
-(* module Syntax_def *)
-module Smartlocate = Smartlocate
-module Topconstr = Topconstr
-(* module Reserve *)
-(* module Implicit_quantifiers *)
-module Constrintern = Constrintern
-(* module Modintern *)
-module Constrextern = Constrextern
-(* module Discharge *)
-module Declare = Declare
-
-(******************************************************************************)
-(* Proofs                                                                     *)
-(******************************************************************************)
-module Miscprint = Miscprint
-module Goal = Goal
-module Evar_refiner = Evar_refiner
-(* module Proof_using *)
-module Proof_type = Proof_type
-module Logic = Logic
-module Refine = Refine
-module Proof = Proof
-module Proof_bullet = Proof_bullet
-module Proof_global = Proof_global
-module Redexpr = Redexpr
-module Refiner = Refiner
-module Tacmach = Tacmach
-module Pfedit = Pfedit
-module Clenv = Clenv
-(* module Clenvtac *)
-(* "mli" file *)
-
-(******************************************************************************)
-(* Printing                                                                   *)
-(******************************************************************************)
-module Genprint = Genprint
-module Pputils = Pputils
-module Ppconstr = Ppconstr
-module Printer = Printer
-(* module Printmod *)
-(* module Prettyp *)
-module Ppvernac = Ppvernac
-
-(******************************************************************************)
-(* Parsing                                                                    *)
-(******************************************************************************)
-module Tok = Tok
-module CLexer = CLexer
-module Pcoq = Pcoq
-module Egramml = Egramml
-(* Egramcoq *)
-
-(******************************************************************************)
-(* Tactics                                                                    *)
-(******************************************************************************)
-(* module Dnet *)
-(* module Dn *)
-(* module Btermdn *)
-module Tacticals = Tacticals
-module Hipattern = Hipattern
-module Ind_tables = Ind_tables
-(* module Eqschemes *)
-module Elimschemes = Elimschemes
-module Tactics = Tactics
-module Elim = Elim
-module Equality = Equality
-module Contradiction = Contradiction
-module Inv = Inv
-module Leminv = Leminv
-module Hints = Hints
-module Auto = Auto
-module Eauto = Eauto
-module Class_tactics = Class_tactics
-(* module Term_dnet *)
-module Eqdecide = Eqdecide
-module Autorewrite = Autorewrite
-
-(******************************************************************************)
-(* Vernac                                                                     *)
-(******************************************************************************)
-(* module Vernacprop *)
-module Lemmas = Lemmas
-module Himsg = Himsg
-module ExplainErr = ExplainErr
-(* module Class *)
-module Locality = Locality
-module Metasyntax = Metasyntax
-(* module Auto_ind_decl *)
-module Search = Search
-(* module Indschemes *)
-module Obligations = Obligations
-module Command = Command
-module Classes = Classes
-(* module Record *)
-(* module Assumptions *)
-module Vernacinterp = Vernacinterp
-module Mltop = Mltop
-module Topfmt = Topfmt
-module Vernacentries = Vernacentries
-
-(******************************************************************************)
-(* Stm                                                                        *)
-(******************************************************************************)
-module Vernac_classifier = Vernac_classifier
-module Stm = Stm
-
-(******************************************************************************)
-(* Highparsing                                                               *)
-(******************************************************************************)
-module G_vernac = G_vernac
-module G_proofs = G_proofs
diff --git a/API/API.mli b/API/API.mli
deleted file mode 100644
index d1774afe5..000000000
--- a/API/API.mli
+++ /dev/null
@@ -1,5744 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(* Warning, this file should respect the dependency order established
-   in Coq. To see such order issue the comand:
-
-   ```
-   bash -c 'for i in kernel intf library engine pretyping interp proofs parsing printing tactics vernac stm toplevel; do echo -e "\n## $i files" && cat ${i}/${i}.mllib; done && echo -e "\n## highparsing files" && cat parsing/highparsing.mllib' > API/link
-   ```
-
-   Note however that files in intf/ are located manually now as their
-   conceptual linking order in the Coq codebase is incorrect (but it
-   works due to these files being implementation-free.
-
-   See below in the file for their concrete position.
-*)
-
-(************************************************************************)
-(* Modules from config/                                                 *)
-(************************************************************************)
-module Coq_config :
-sig
-  val exec_extension : string
-end
-
-(************************************************************************)
-(* Modules from kernel/                                                 *)
-(************************************************************************)
-module Names :
-sig
-
-  open Util
-
-  module Id :
-  sig
-    type t
-    val equal : t -> t -> bool
-    val compare : t -> t -> int
-    val hash : t -> int
-    val is_valid : string -> bool
-    val of_bytes : bytes -> t
-    val of_string : string -> t
-    val of_string_soft : string -> t
-    val to_string : t -> string
-    val print : t -> Pp.t
-
-    module Set  : Set.S with type elt = t
-    module Map  : Map.ExtS with type key = t and module Set := Set
-    module Pred : Predicate.S with type elt = t
-    module List : List.MonoS with type elt = t
-    val hcons : t -> t
-  end
-
-  module Name :
-  sig
-    type t = Anonymous     (** anonymous identifier *)
-	   | Name of Id.t  (** non-anonymous identifier *)
-    val mk_name : Id.t -> t
-    val is_anonymous : t -> bool
-    val is_name : t -> bool
-    val compare : t -> t -> int
-    val equal : t -> t -> bool
-    val hash : t -> int
-    val hcons : t -> t
-    val print : t -> Pp.t
-  end
-
-  type name = Name.t =
-    | Anonymous
-    | Name of Id.t
-  [@@ocaml.deprecated "alias of API.Name.t"]
-
-  module DirPath :
-  sig
-    type t
-    val empty : t
-    val make : Id.t list -> t
-    val repr : t -> Id.t list
-    val equal : t -> t -> bool
-    val to_string : t -> string
-  end
-
-  module MBId : sig
-    type t
-    val equal : t -> t -> bool
-    val to_id : t -> Id.t
-    val repr : t -> int * Id.t * DirPath.t
-    val debug_to_string : t -> string
-  end
-
-  module Label :
-  sig
-    type t
-    val make : string -> t
-    val equal : t -> t -> bool
-    val compare : t -> t -> int
-    val of_id : Id.t -> t
-    val to_id : t -> Id.t
-    val to_string : t -> string
-  end
-
-  module ModPath :
-  sig
-    type t =
-      | MPfile of DirPath.t
-      | MPbound of MBId.t
-      | MPdot of t * Label.t
-    val compare : t -> t -> int
-    val equal : t -> t -> bool
-    val hash : t -> int
-    val initial : t
-    val to_string : t -> string
-    val debug_to_string : t -> string
-  end
-
-  module KerName :
-  sig
-    type t
-    val make : ModPath.t -> DirPath.t -> Label.t -> t
-    val make2 : ModPath.t -> Label.t -> t
-    val modpath : t -> ModPath.t
-    val equal : t -> t -> bool
-    val compare : t -> t -> int
-    val label : t -> Label.t
-    val repr : t -> ModPath.t * DirPath.t * Label.t
-    val print : t -> Pp.t
-    val to_string : t -> string
-  end
-
-  type kernel_name = KerName.t
-  [@@ocaml.deprecated "alias of API.Names.KerName.t"]
-
-  module Constant :
-  sig
-    type t
-    val equal : t -> t -> bool
-    val make1 : KerName.t -> t
-    val make2 : ModPath.t -> Label.t -> t
-    val make3 : ModPath.t -> DirPath.t -> Label.t -> t
-    val repr3 : t -> ModPath.t * DirPath.t * Label.t
-    val canonical : t -> KerName.t
-    val user : t -> KerName.t
-    val label : t -> Label.t
-  end
-
-  module MutInd :
-  sig
-    type t
-    val make1 : KerName.t -> t
-    val make2 : ModPath.t -> Label.t -> t
-    val equal : t -> t -> bool
-    val repr3 : t -> ModPath.t * DirPath.t * Label.t
-    val canonical : t -> KerName.t
-    val modpath : t -> ModPath.t
-    val label : t -> Label.t
-    val user : t -> KerName.t
-    val print : t -> Pp.t
-  end
-
-  module Projection :
-  sig
-    type t
-    val make : Constant.t -> bool -> t
-    val map : (Constant.t -> Constant.t) -> t -> t
-    val constant : t -> Constant.t
-    val equal : t -> t -> bool
-    val unfolded : t -> bool
-    val unfold : t -> t
-  end
-
-  type evaluable_global_reference =
-    | EvalVarRef of Id.t
-    | EvalConstRef of Constant.t
-
-  type inductive = MutInd.t * int
-  val eq_ind : inductive -> inductive -> bool
-
-  type constructor = inductive * int
-  val eq_constructor : constructor -> constructor -> bool
-  val constructor_hash : constructor -> int
-
-  module MPset : Set.S with type elt = ModPath.t
-  module MPmap : Map.ExtS with type key = ModPath.t and module Set := MPset
-
-  module KNset  : CSig.SetS with type elt = KerName.t
-  module KNpred : Predicate.S with type elt = KerName.t
-  module KNmap  : Map.ExtS with type key = KerName.t and module Set := KNset
-
-  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
-  module Cmap_env : Map.ExtS with type key = Constant.t and module Set := Cset_env
-
-  module Mindset : CSig.SetS with type elt = MutInd.t
-  module Mindmap : Map.ExtS with type key = MutInd.t and module Set := Mindset
-  module Mindmap_env : CSig.MapS with type key = MutInd.t
-
-  module Indmap : CSig.MapS with type key = inductive
-  module Constrmap : CSig.MapS with type key = constructor
-  module Indmap_env : CSig.MapS with type key = inductive
-  module Constrmap_env : CSig.MapS with type key = constructor
-
-  type transparent_state = Id.Pred.t * Cpred.t
-
-  val empty_transparent_state : transparent_state
-  val full_transparent_state : transparent_state
-  val var_full_transparent_state : transparent_state
-  val cst_full_transparent_state : transparent_state
-
-  val pr_kn : KerName.t -> Pp.t
-  [@@ocaml.deprecated "alias of API.Names.KerName.print"]
-
-  val eq_constant : Constant.t -> Constant.t -> bool
-  [@@ocaml.deprecated "alias of API.Names.Constant.equal"]
-
-  type module_path = ModPath.t =
-    | MPfile of DirPath.t
-    | MPbound of MBId.t
-    | MPdot of ModPath.t * Label.t
-  [@@ocaml.deprecated "alias of API.Names.ModPath.t"]
-
-  type variable = Id.t
-
-  type 'a tableKey =
-    | ConstKey of 'a
-    | VarKey of Id.t
-    | RelKey of Int.t
-
-  val id_of_string : string -> Id.t
-  [@@ocaml.deprecated "alias of API.Names.Id.of_string"]
-
-  val string_of_id : Id.t -> string
-  [@@ocaml.deprecated "alias of API.Names.Id.to_string"]
-
-  type mutual_inductive = MutInd.t
-  [@@ocaml.deprecated "alias of API.Names.MutInd.t"]
-
-  val eq_mind : MutInd.t -> MutInd.t -> bool
-  [@@ocaml.deprecated "alias of API.Names.MutInd.equal"]
-
-  val repr_con : Constant.t -> ModPath.t * DirPath.t * Label.t
-  [@@ocaml.deprecated "alias of API.Names.Constant.repr3"]
-
-  val repr_mind : MutInd.t -> ModPath.t * DirPath.t * Label.t
-  [@@ocaml.deprecated "alias of API.Names.MutInd.repr3"]
-
-  val initial_path : ModPath.t
-  [@@ocaml.deprecated "alias of API.Names.ModPath.initial"]
-
-  val con_label : Constant.t -> Label.t
-  [@@ocaml.deprecated "alias of API.Names.Constant.label"]
-
-  val mind_label : MutInd.t -> Label.t
-  [@@ocaml.deprecated "alias of API.Names.MutInd.label"]
-
-  val string_of_mp : ModPath.t -> string
-  [@@ocaml.deprecated "alias of API.Names.ModPath.to_string"]
-
-  val mind_of_kn : KerName.t -> MutInd.t
-  [@@ocaml.deprecated "alias of API.Names.MutInd.make1"]
-
-  type constant = Constant.t
-  [@@ocaml.deprecated "alias of API.Names.Constant.t"]
-
-  val mind_modpath : MutInd.t -> ModPath.t
-  [@@ocaml.deprecated "alias of API.Names.MutInd.modpath"]
-
-  val canonical_mind : MutInd.t -> KerName.t
-  [@@ocaml.deprecated "alias of API.Names.MutInd.canonical"]
-
-  val user_mind : MutInd.t -> KerName.t
-  [@@ocaml.deprecated "alias of API.Names.MutInd.user"]
-
-  val repr_kn : KerName.t -> ModPath.t * DirPath.t * Label.t
-  [@@ocaml.deprecated "alias of API.Names.KerName.repr"]
-
-  val constant_of_kn : KerName.t -> Constant.t
-  [@@ocaml.deprecated "alias of API.Names.Constant.make1"]
-
-  val user_con : Constant.t -> KerName.t
-  [@@ocaml.deprecated "alias of API.Names.Constant.user"]
-
-  val modpath : KerName.t -> ModPath.t
-  [@@ocaml.deprecated "alias of API.Names.KerName.modpath"]
-
-  val canonical_con : Constant.t -> KerName.t
-  [@@ocaml.deprecated "alias of API.Names.Constant.canonical"]
-
-  val make_kn : ModPath.t -> DirPath.t -> Label.t -> KerName.t
-  [@@ocaml.deprecated "alias of API.Names.KerName.make"]
-
-  val make_con : ModPath.t -> DirPath.t -> Label.t -> Constant.t
-  [@@ocaml.deprecated "alias of API.Names.Constant.make3"]
-
-  val debug_pr_con : Constant.t -> Pp.t
-
-  val debug_pr_mind : MutInd.t -> Pp.t
-
-  val pr_con : Constant.t -> Pp.t
-
-  val string_of_con : Constant.t -> string
-
-  val string_of_mind : MutInd.t -> string
-
-  val debug_string_of_mind : MutInd.t -> string
-
-  val debug_string_of_con : Constant.t -> string
-
-  type identifier = Id.t
-  module Idset  : Set.S with type elt = identifier and type t = Id.Set.t
-
-end
-
-module Univ :
-sig
-
-  module Level :
-  sig
-    type t
-    val set : t
-    val pr : t -> Pp.t
-  end
-
-  type universe_level = Level.t
-
-  module LSet :
-  sig
-    include CSig.SetS with type elt = universe_level
-    val pr : (Level.t -> Pp.t) -> t -> Pp.t
-  end
-
-  module Universe :
-  sig
-    type t
-    val pr : t -> Pp.t
-  end
-
-  type universe = Universe.t
-
-  module Instance :
-  sig
-    type t
-    val empty : t
-    val of_array : Level.t array -> t
-    val to_array : t -> Level.t array
-    val pr : (Level.t -> Pp.t) -> t -> Pp.t
-  end
-
-  type 'a puniverses = 'a * Instance.t
-
-  val out_punivs : 'a puniverses -> 'a
-
-  type constraint_type = Lt | Le | Eq
-
-  type univ_constraint = universe_level * constraint_type * universe_level
-
-  module Constraint : sig
-    include Set.S with type elt = univ_constraint
-  end
-
-  type 'a constrained = 'a * Constraint.t
-
-  module UContext :
-  sig
-    type t
-    val empty : t
-  end
-
-  type universe_context = UContext.t
-
-  module AUContext :
-  sig
-    type t
-    val empty : t
-  end
-
-  type abstract_universe_context = AUContext.t
-
-  module CumulativityInfo :
-  sig
-    type t
-  end
-
-  type cumulativity_info = CumulativityInfo.t
-
-  module ACumulativityInfo :
-  sig
-    type t
-  end
-  type abstract_cumulativity_info = ACumulativityInfo.t
-
-  module ContextSet :
-  sig
-    type t
-    val empty : t
-    val of_context : UContext.t -> t
-    val to_context : t -> UContext.t
-  end
-
-  type 'a in_universe_context_set = 'a * ContextSet.t
-  type 'a in_universe_context = 'a * UContext.t
-
-  type universe_context_set = ContextSet.t
-
-  type universe_set = LSet.t
-
-  type 'a constraint_function = 'a -> 'a -> Constraint.t -> Constraint.t
-
-  module LMap :
-  sig
-    include CMap.ExtS with type key = universe_level and module Set := LSet
-
-    val union : 'a t -> 'a t -> 'a t
-    val diff : 'a t -> 'a t -> 'a t
-    val subst_union : 'a option t -> 'a option t -> 'a option t
-    val pr : ('a -> Pp.t) -> 'a t -> Pp.t
-  end
-
-  type 'a universe_map = 'a LMap.t
-  type universe_subst = universe universe_map
-  type universe_level_subst = universe_level universe_map
-
-  val enforce_leq : Universe.t constraint_function
-  val pr_uni : Universe.t -> Pp.t
-  val pr_universe_context : (Level.t -> Pp.t) -> UContext.t -> Pp.t
-  val pr_universe_context_set : (Level.t -> Pp.t) -> ContextSet.t -> Pp.t
-  val pr_universe_subst : universe_subst -> Pp.t
-  val pr_universe_level_subst : universe_level_subst -> Pp.t
-  val pr_constraints : (Level.t -> Pp.t) -> Constraint.t -> Pp.t
-end
-
-module UGraph :
-sig
-  type t
-  val pr_universes : (Univ.Level.t -> Pp.t) -> t -> Pp.t
-end
-
-module Esubst :
-sig
-  type 'a subs
-  val subs_id : int -> 'a subs
-end
-
-module Sorts :
-sig
-  type contents = Pos | Null
-  type t =
-         | Prop of contents
-         | Type of Univ.Universe.t
-  val is_prop : t -> bool
-  val hash : t -> int
-
-  type family = InProp | InSet | InType
-  val family : t -> family
-end
-
-module Evar :
-sig
-  (** Unique identifier of some {i evar} *)
-  type t
-
-  (** Recover the underlying integer. *)
-  val repr : t -> int
-
-  val equal : t -> t -> bool
-
-  (** a set of unique identifiers of some {i evars} *)
-  module Set : Set.S with type elt = t
-  module Map : CMap.ExtS with type key = t and module Set := Set
-
-end
-
-module Constr :
-sig
-  open Names
-
-  type t
-
-  type constr = t
-  type types = t
-
-  type cast_kind =
-                 | VMcast
-                 | NATIVEcast
-                 | DEFAULTcast
-                 | REVERTcast
-
-  type metavariable = int
-
-  type existential_key = Evar.t
-  type 'constr pexistential = existential_key * 'constr array
-
-  type 'a puniverses = 'a Univ.puniverses
-  type pconstant = Constant.t puniverses
-  type pinductive = inductive puniverses
-  type pconstructor = constructor puniverses
-
-  type ('constr, 'types) prec_declaration =
-    Name.t array * 'types array * 'constr array
-
-  type ('constr, 'types) pfixpoint =
-    (int array * int) * ('constr, 'types) prec_declaration
-
-  type ('constr, 'types) pcofixpoint =
-    int * ('constr, 'types) prec_declaration
-
-  type case_style =
-      LetStyle | IfStyle | LetPatternStyle | MatchStyle
-    | RegularStyle (** infer printing form from number of constructor *)
-
-  type case_printing =
-    { ind_tags : bool list; (** tell whether letin or lambda in the arity of the inductive type *)
-      cstr_tags : bool list array; (** tell whether letin or lambda in the signature of each constructor *)
-      style     : case_style }
-
-  type case_info =
-    { ci_ind        : inductive;      (* inductive type to which belongs the value that is being matched *)
-      ci_npar       : int;            (* number of parameters of the above inductive type *)
-      ci_cstr_ndecls : int array;     (* For each constructor, the corresponding integer determines
-                                         the number of values that can be bound in a match-construct.
-                                         NOTE: parameters of the inductive type are therefore excluded from the count *)
-      ci_cstr_nargs : int array;      (* for each constructor, the corresponding integers determines
-                                         the number of values that can be applied to the constructor,
-                                         in addition to the parameters of the related inductive type
-                                         NOTE: "lets" are therefore excluded from the count
-                                         NOTE: parameters of the inductive type are also excluded from the count *)
-      ci_pp_info    : case_printing   (* not interpreted by the kernel *)
-    }
-
-  type ('constr, 'types, 'sort, 'univs) kind_of_term =
-     | Rel       of int
-     | Var       of Id.t
-     | Meta      of metavariable
-     | Evar      of 'constr pexistential
-     | Sort      of 'sort
-     | Cast      of 'constr * cast_kind * 'types
-     | Prod      of Name.t * 'types * 'types
-     | Lambda    of Name.t * 'types * 'constr
-     | LetIn     of Name.t * 'constr * 'types * 'constr
-     | App       of 'constr * 'constr array
-     | Const     of (Constant.t * 'univs)
-     | Ind       of (inductive * 'univs)
-     | Construct of (constructor * 'univs)
-     | Case      of case_info * 'constr * 'constr * 'constr array
-     | Fix       of ('constr, 'types) pfixpoint
-     | CoFix     of ('constr, 'types) pcofixpoint
-     | Proj      of Projection.t * 'constr
-
-  val equal : t -> t -> bool
-  val eq_constr_nounivs : t -> t -> bool
-  val compare : t -> t -> int
-
-  val hash : t -> int
-
-  val mkRel : int -> t
-  val mkVar : Id.t -> t
-  val mkMeta : metavariable -> t
-  type existential = existential_key * constr array
-  val mkEvar : existential -> t
-  val mkSort : Sorts.t -> t
-  val mkProp : t
-  val mkSet  : t
-  val mkType : Univ.Universe.t -> t
-  val mkCast : t * cast_kind * t -> t
-  val mkProd : Name.t * types * types -> types
-  val mkLambda : Name.t * types * t -> t
-  val mkLetIn : Name.t * t * types * t -> t
-  val mkApp : t * t array -> t
-  val map_puniverses : ('a -> 'b) -> 'a puniverses -> 'b puniverses
-
-  val mkConst : Constant.t -> t
-  val mkConstU : pconstant -> t
-
-  val mkProj : (Projection.t * t) -> t
-
-  val mkInd : inductive -> t
-  val mkIndU : pinductive -> t
-
-  val mkConstruct : constructor -> t
-  val mkConstructU : pconstructor -> t
-  val mkConstructUi : pinductive * int -> t
-
-  val mkCase : case_info * t * t * t array -> t
-
-end
-
-module Context :
-sig
-  module Rel :
-  sig
-    module Declaration :
-    sig
-      (* local declaration *)
-      (* local declaration *)
-      type ('constr, 'types) pt =
-        | LocalAssum of Names.Name.t * 'types            (** name, type *)
-        | LocalDef of Names.Name.t * 'constr * 'types    (** name, value, type *)
-
-      type t = (Constr.constr, Constr.types) pt
-
-      (** Return the name bound by a given declaration. *)
-      val get_name : ('c, 't) pt -> Names.Name.t
-
-      (** Return the type of the name bound by a given declaration. *)
-      val get_type : ('c, 't) pt -> 't
-
-      (** Set the name that is bound by a given declaration. *)
-      val set_name : Names.Name.t -> ('c, 't) pt -> ('c, 't) pt
-
-      (** Set the type of the bound variable in a given declaration. *)
-      val set_type : 't -> ('c, 't) pt -> ('c, 't) pt
-
-      (** Return [true] iff a given declaration is a local assumption. *)
-      val is_local_assum : ('c, 't) pt -> bool
-
-      (** Return [true] iff a given declaration is a local definition. *)
-      val is_local_def : ('c, 't) pt -> bool
-
-      (** Check whether the two given declarations are equal. *)
-      val equal : ('c -> 'c -> bool) -> ('c, 'c) pt -> ('c, 'c) pt -> bool
-
-      (** Map the name bound by a given declaration. *)
-      val map_name : (Names.Name.t -> Names.Name.t) -> ('c, 't) pt -> ('c, 't) pt
-
-      (** For local assumptions, this function returns the original local assumptions.
-        For local definitions, this function maps the value in the local definition. *)
-      val map_value : ('c -> 'c) -> ('c, 't) pt -> ('c, 't) pt
-
-      (** Map the type of the name bound by a given declaration. *)
-      val map_type : ('t -> 't) -> ('c, 't) pt -> ('c, 't) pt
-
-      (** Map all terms in a given declaration. *)
-      val map_constr : ('c -> 'c) -> ('c, 'c) pt -> ('c, 'c) pt
-
-      (** Perform a given action on all terms in a given declaration. *)
-      val iter_constr : ('c -> unit) -> ('c, 'c) pt -> unit
-
-      (** Reduce all terms in a given declaration to a single value. *)
-      val fold_constr : ('c -> 'a -> 'a) -> ('c, 'c) pt -> 'a -> 'a
-    end
-
-    (** Rel-context is represented as a list of declarations.
-        Inner-most declarations are at the beginning of the list.
-        Outer-most declarations are at the end of the list. *)
-    type ('constr, 'types) pt = ('constr, 'types) Declaration.pt list
-    type t = Declaration.t list
-
-    (** empty rel-context *)
-    val empty : ('c, 't) pt
-
-    (** Return a new rel-context enriched by with a given inner-most declaration. *)
-    val add : ('c, 't) Declaration.pt -> ('c, 't) pt -> ('c, 't) pt
-
-    (** Return the number of {e local declarations} in a given context. *)
-    val length : ('c, 't) pt -> int
-
-    (** Check whether given two rel-contexts are equal. *)
-    val equal : ('c -> 'c -> bool) -> ('c, 'c) pt -> ('c, 'c) pt -> bool
-
-    (** Return the number of {e local assumptions} in a given rel-context. *)
-    val nhyps : ('c, 't) pt -> int
-
-    (** Return a declaration designated by a given de Bruijn index.
-      @raise Not_found if the designated de Bruijn index outside the range. *)
-    val lookup : int -> ('c, 't) pt -> ('c, 't) Declaration.pt
-
-    (** Map all terms in a given rel-context. *)
-    val map : ('c -> 'c) -> ('c, 'c) pt -> ('c, 'c) pt
-
-    (** Perform a given action on every declaration in a given rel-context. *)
-    val iter : ('c -> unit) -> ('c, 'c) pt -> unit
-
-    (** Reduce all terms in a given rel-context to a single value.
-      Innermost declarations are processed first. *)
-    val fold_inside : ('a -> ('c, 't) Declaration.pt -> 'a) -> init:'a -> ('c, 't) pt -> 'a
-
-    (** Reduce all terms in a given rel-context to a single value.
-      Outermost declarations are processed first. *)
-    val fold_outside : (('c, 't) Declaration.pt -> 'a -> 'a) -> ('c, 't) pt -> init:'a -> 'a
-
-    (** [extended_vect n Γ] does the same, returning instead an array. *)
-    val to_extended_vect : (int -> 'r) -> int -> ('c, 't) pt -> 'r array
-  end
-  module Named :
-  sig
-    module Declaration :
-    sig
-      (** local declaration *)
-      type ('constr, 'types) pt =
-        | LocalAssum of Names.Id.t * 'types             (** identifier, type *)
-        | LocalDef of Names.Id.t * 'constr * 'types     (** identifier, value, type *)
-
-      type t = (Constr.constr, Constr.types) pt
-
-      (** Return the identifier bound by a given declaration. *)
-      val get_id : ('c, 't) pt -> Names.Id.t
-
-      (** Return the type of the name bound by a given declaration. *)
-      val get_type : ('c, 't) pt -> 't
-
-      (** Set the identifier that is bound by a given declaration. *)
-      val set_id : Names.Id.t -> ('c, 't) pt -> ('c, 't) pt
-
-      (** Set the type of the bound variable in a given declaration. *)
-      val set_type : 't -> ('c, 't) pt -> ('c, 't) pt
-
-      (** Return [true] iff a given declaration is a local assumption. *)
-      val is_local_assum : ('c, 't) pt -> bool
-
-      (** Return [true] iff a given declaration is a local definition. *)
-      val is_local_def : ('c, 't) pt -> bool
-
-      (** Check whether any term in a given declaration satisfies a given predicate. *)
-      val exists : ('c -> bool) -> ('c, 'c) pt -> bool
-
-      (** Check whether all terms in a given declaration satisfy a given predicate. *)
-      val for_all : ('c -> bool) -> ('c, 'c) pt -> bool
-
-      (** Check whether the two given declarations are equal. *)
-      val equal : ('c -> 'c -> bool) -> ('c, 'c) pt -> ('c, 'c) pt -> bool
-
-      (** Map the identifier bound by a given declaration. *)
-      val map_id : (Names.Id.t -> Names.Id.t) -> ('c, 't) pt -> ('c, 't) pt
-
-      (** For local assumptions, this function returns the original local assumptions.
-        For local definitions, this function maps the value in the local definition. *)
-      val map_value : ('c -> 'c) -> ('c, 't) pt -> ('c, 't) pt
-
-      (** Map the type of the name bound by a given declaration. *)
-      val map_type : ('t -> 't) -> ('c, 't) pt -> ('c, 't) pt
-
-      (** Map all terms in a given declaration. *)
-      val map_constr : ('c -> 'c) -> ('c, 'c) pt -> ('c, 'c) pt
-
-      (** Perform a given action on all terms in a given declaration. *)
-      val iter_constr : ('c -> unit) -> ('c, 'c) pt -> unit
-
-      (** Reduce all terms in a given declaration to a single value. *)
-      val fold_constr : ('c -> 'a -> 'a) -> ('c, 'c) pt -> 'a -> 'a
-
-      val to_rel_decl : ('c, 't) pt -> ('c, 't) Rel.Declaration.pt
-    end
-    (** Named-context is represented as a list of declarations.
-      Inner-most declarations are at the beginning of the list.
-      Outer-most declarations are at the end of the list. *)
-    type ('constr, 'types) pt = ('constr, 'types) Declaration.pt list
-    type t = Declaration.t list
-
-    (** empty named-context *)
-    val empty : ('c, 't) pt
-
-    (** Return a new named-context enriched by with a given inner-most declaration. *)
-    val add : ('c, 't) Declaration.pt -> ('c, 't) pt -> ('c, 't) pt
-
-    (** Return the number of {e local declarations} in a given named-context. *)
-    val length : ('c, 't) pt -> int
-
-    (** Return a declaration designated by an identifier of the variable bound in that declaration.
-      @raise Not_found if the designated identifier is not bound in a given named-context. *)
-    val lookup : Names.Id.t -> ('c, 't) pt -> ('c, 't) Declaration.pt
-
-    (** Check whether given two named-contexts are equal. *)
-    val equal : ('c -> 'c -> bool) -> ('c, 'c) pt -> ('c, 'c) pt -> bool
-
-    (** Map all terms in a given named-context. *)
-    val map : ('c -> 'c) -> ('c, 'c) pt -> ('c, 'c) pt
-
-    (** Perform a given action on every declaration in a given named-context. *)
-    val iter : ('c -> unit) -> ('c, 'c) pt -> unit
-
-    (** Reduce all terms in a given named-context to a single value.
-      Innermost declarations are processed first. *)
-    val fold_inside : ('a -> ('c, 't) Declaration.pt -> 'a) -> init:'a -> ('c, 't) pt -> 'a
-
-    (** Reduce all terms in a given named-context to a single value.
-      Outermost declarations are processed first. *)
-    val fold_outside : (('c, 't) Declaration.pt -> 'a -> 'a) -> ('c, 't) pt -> init:'a -> 'a
-
-    (** Return the set of all identifiers bound in a given named-context. *)
-    val to_vars : ('c, 't) pt -> Names.Id.Set.t
-
-    (** [to_instance Ω] builds an instance [args] such
-      that [Ω ⊢ args:Ω] where [Ω] is a named-context and with the local
-      definitions of [Ω] skipped. Example: for [id1:T,id2:=c,id3:U], it
-      gives [Var id1, Var id3]. All [idj] are supposed distinct. *)
-    val to_instance : (Names.Id.t -> 'r) -> ('c, 't) pt -> 'r list
-  end
-end
-
-module Vars :
-sig
-  type substl = Constr.t list
-
-  val substl : substl -> Constr.t -> Constr.t
-
-  val subst1 : Constr.t -> Constr.t -> Constr.t
-
-  val lift : int -> Constr.t -> Constr.t
-
-  val closed0 : Constr.t -> bool
-
-  val closedn : int -> Constr.t -> bool
-
-  val replace_vars : (Names.Id.t * Constr.t) list -> Constr.t -> Constr.t
-
-  val noccurn : int -> Constr.t -> bool
-  val subst_var : Names.Id.t -> Constr.t -> Constr.t
-  val subst_vars : Names.Id.t list -> Constr.t -> Constr.t
-  val substnl : substl -> int -> Constr.t -> Constr.t
-end
-
-module Term :
-sig
-
-  type sorts_family = Sorts.family = InProp | InSet | InType
-
-  type contents = Sorts.contents = Pos | Null
-
-  type sorts = Sorts.t =
-    | Prop of contents
-    | Type of Univ.Universe.t
-  [@@ocaml.deprecated "alias of API.Sorts.t"]
-
-  type constr = Constr.t
-  type types = Constr.t
-
-  type metavariable = int
-
-  type ('constr, 'types) prec_declaration = Names.Name.t array * 'types array * 'constr array
-
-  type 'constr pexistential = 'constr Constr.pexistential
-  type cast_kind = Constr.cast_kind =
-                 | VMcast
-                 | NATIVEcast
-                 | DEFAULTcast
-                 | REVERTcast
-
-  type 'a puniverses = 'a Univ.puniverses
-  type pconstant = Names.Constant.t puniverses
-  type pinductive = Names.inductive puniverses
-  type pconstructor = Names.constructor puniverses
-  type case_style = Constr.case_style =
-    | LetStyle
-    | IfStyle
-    | LetPatternStyle
-    | MatchStyle
-    | RegularStyle
-
-  type case_printing = Constr.case_printing =
-    { ind_tags  : bool list;
-      cstr_tags : bool list array;
-      style     : case_style
-    }
-
-  type case_info = Constr.case_info =
-    { ci_ind        : Names.inductive;
-      ci_npar       : int;
-      ci_cstr_ndecls: int array;
-      ci_cstr_nargs : int array;
-      ci_pp_info    : case_printing
-    }
-
-  type ('constr, 'types) pfixpoint =
-    (int array * int) * ('constr, 'types) prec_declaration
-
-  type ('constr, 'types) pcofixpoint =
-    int * ('constr, 'types) prec_declaration
-
-  type ('constr, 'types, 'sort, 'univs) kind_of_term = ('constr, 'types, 'sort, 'univs) Constr.kind_of_term =
-     | Rel       of int
-     | Var       of Names.Id.t
-     | Meta      of Constr.metavariable
-     | Evar      of 'constr pexistential
-     | Sort      of 'sort
-     | Cast      of 'constr * cast_kind * 'types
-     | Prod      of Names.Name.t * 'types * 'types
-     | Lambda    of Names.Name.t * 'types * 'constr
-     | LetIn     of Names.Name.t * 'constr * 'types * 'constr
-     | App       of 'constr * 'constr array
-     | Const     of (Names.Constant.t * 'univs)
-     | Ind       of (Names.inductive * 'univs)
-     | Construct of (Names.constructor * 'univs)
-     | Case      of case_info * 'constr * 'constr * 'constr array
-     | Fix       of ('constr, 'types) pfixpoint
-     | CoFix     of ('constr, 'types) pcofixpoint
-     | Proj      of Names.Projection.t * 'constr
-  type existential = Constr.existential_key * constr array
-  type rec_declaration = Names.Name.t array * constr array * constr array
-  type fixpoint = (int array * int) * rec_declaration
-  type cofixpoint = int * rec_declaration
-  val kind_of_term : constr -> (constr, types, Sorts.t, Univ.Instance.t) kind_of_term
-  val applistc : constr -> constr list -> constr
-
-  val applist : constr * constr list -> constr
-  [@@ocaml.deprecated "(sort of an) alias of API.Term.applistc"]
-
-  val mkArrow : types -> types -> constr
-  val mkRel : int -> constr
-  val mkVar : Names.Id.t -> constr
-
-  val mkMeta : Constr.metavariable -> constr
-
-  val mkEvar : existential -> constr
-  val mkSort : Sorts.t -> types
-  val mkProp : types
-  val mkSet  : types
-  val mkType : Univ.Universe.t -> types
-  val mkCast : constr * cast_kind * constr -> constr
-  val mkProd : Names.Name.t * types * types -> types
-  val mkLambda : Names.Name.t * types * constr -> constr
-  val mkLetIn : Names.Name.t * constr * types * constr -> constr
-  val mkApp : constr * constr array -> constr
-  val mkConst : Names.Constant.t -> constr
-  val mkProj : Names.Projection.t * constr -> constr
-  val mkInd : Names.inductive -> constr
-  val mkConstruct : Names.constructor -> constr
-  val mkConstructU : Names.constructor puniverses -> constr
-  val mkConstructUi : (pinductive * int) -> constr
-  val mkCase : case_info * constr * constr * constr array -> constr
-  val mkFix : fixpoint -> constr
-  val mkCoFix : cofixpoint -> constr
-  val mkNamedLambda : Names.Id.t -> types -> constr -> constr
-  val mkNamedLetIn : Names.Id.t -> constr -> types -> constr -> constr
-  val mkNamedProd : Names.Id.t -> types -> types -> types
-
-  val decompose_app : constr -> constr * constr list
-  val decompose_prod : constr -> (Names.Name.t*constr) list * constr
-  val decompose_prod_n : int -> constr -> (Names.Name.t * constr) list * constr
-  val decompose_prod_assum : types -> Context.Rel.t * types
-  val decompose_lam : constr -> (Names.Name.t * constr) list * constr
-  val decompose_lam_n : int -> constr -> (Names.Name.t * constr) list * constr
-  val decompose_prod_n_assum : int -> types -> Context.Rel.t * types
-
-  val compose_prod : (Names.Name.t * constr) list -> constr -> constr
-  val compose_lam : (Names.Name.t * constr) list -> constr -> constr
-
-  val destSort : constr -> Sorts.t
-  val destVar : constr -> Names.Id.t
-  val destApp : constr -> constr * constr array
-  val destProd : types -> Names.Name.t * types * types
-  val destLetIn : constr -> Names.Name.t * constr * types * constr
-  val destEvar : constr -> existential
-  val destRel : constr -> int
-  val destConst : constr -> Names.Constant.t puniverses
-  val destCast : constr -> constr * cast_kind * constr
-  val destLambda : constr -> Names.Name.t * types * constr
-
-  val isRel : constr -> bool
-  val isVar  : constr -> bool
-  val isEvar : constr -> bool
-  val isLetIn : constr -> bool
-  val isLambda : constr -> bool
-  val isConst : constr -> bool
-  val isEvar_or_Meta : constr -> bool
-  val isCast : constr -> bool
-  val isMeta : constr -> bool
-  val isApp : constr -> bool
-
-  val fold_constr : ('a -> constr -> 'a) -> 'a -> constr -> 'a
-
-  val eq_constr : constr -> constr -> bool
-
-  val hash_constr : constr -> int
-  val it_mkLambda_or_LetIn : constr -> Context.Rel.t -> constr
-  val it_mkProd_or_LetIn : types -> Context.Rel.t -> types
-  val prod_applist : constr -> constr list -> constr
-  exception DestKO
-  val map_constr : (constr -> constr) -> constr -> constr
-
-  val mkIndU : pinductive -> constr
-  val mkConstU : pconstant -> constr
-  val map_constr_with_binders :
-    ('a -> 'a) -> ('a -> constr -> constr) -> 'a -> constr -> constr
-  val iter_constr : (constr -> unit) -> constr -> unit
-
-  (* Quotients away universes: really needed?
-   * Can't we just call eq_c_univs_infer and discard the inferred csts?
-   *)
-  val eq_constr_nounivs : constr -> constr -> bool
-
-  type ('constr, 'types) kind_of_type =
-    | SortType   of Sorts.t
-    | CastType   of 'types * 'types
-    | ProdType   of Names.Name.t * 'types * 'types
-    | LetInType  of Names.Name.t * 'constr * 'types * 'types
-    | AtomicType of 'constr * 'constr array
-
-  val kind_of_type : types -> (constr, types) kind_of_type
-
-  val is_prop_sort : Sorts.t -> bool
-  [@@ocaml.deprecated "alias of API.Sorts.is_prop"]
-
-  type existential_key = Constr.existential_key
-
-  val family_of_sort : Sorts.t -> Sorts.family
-
-  val compare : constr -> constr -> int
-
-  val constr_ord : constr -> constr -> int
-  [@@ocaml.deprecated "alias of API.Term.compare"]
-
-  val destInd : constr -> Names.inductive puniverses
-  val univ_of_sort : Sorts.t -> Univ.Universe.t
-
-  val strip_lam : constr -> constr
-  val strip_prod_assum : types -> types
-
-  val decompose_lam_assum : constr -> Context.Rel.t * constr
-  val destFix : constr -> fixpoint
-
-  val compare_constr : (constr -> constr -> bool) -> constr -> constr -> bool
-end
-
-module Mod_subst :
-sig
-  type delta_resolver
-  type substitution
-  type 'a substituted
-
-  val force_constr : Constr.t substituted -> Constr.t
-
-  val empty_delta_resolver : delta_resolver
-  val constant_of_delta_kn : delta_resolver -> Names.KerName.t -> Names.Constant.t
-  val mind_of_delta_kn : delta_resolver -> Names.KerName.t -> Names.MutInd.t
-  val subst_kn : substitution -> Names.KerName.t -> Names.KerName.t
-  val subst_evaluable_reference :
-    substitution -> Names.evaluable_global_reference -> Names.evaluable_global_reference
-  val subst_mps : substitution -> Constr.t -> Constr.t
-  val subst_constant : substitution -> Names.Constant.t -> Names.Constant.t
-  val subst_ind : substitution -> Names.inductive -> Names.inductive
-  val debug_pr_subst : substitution -> Pp.t
-  val debug_pr_delta : delta_resolver -> Pp.t
-end
-
-module Opaqueproof :
-sig
-  type opaquetab
-  type opaque
-  val empty_opaquetab : opaquetab
-  val force_proof : opaquetab -> opaque -> Constr.t
-end
-
-module Cbytecodes :
-sig
-  type tag = int
-  type reloc_table = (tag * int) array
-end
-
-module Cemitcodes :
-sig
-  type to_patch_substituted
-end
-
-module Decl_kinds :
-sig
-  type polymorphic = bool
-  type cumulative_inductive_flag = bool
-  type recursivity_kind =
-    | Finite
-    | CoFinite
-    | BiFinite
-
-  type locality =
-    | Discharge
-    | Local
-    | Global
-
-  type definition_object_kind =
-    | Definition
-    | Coercion
-    | SubClass
-    | CanonicalStructure
-    | Example
-    | Fixpoint
-    | CoFixpoint
-    | Scheme
-    | StructureComponent
-    | IdentityCoercion
-    | Instance
-    | Method
-  type theorem_kind =
-    | Theorem
-    | Lemma
-    | Fact
-    | Remark
-    | Property
-    | Proposition
-    | Corollary
-  type goal_object_kind =
-    | DefinitionBody of definition_object_kind
-    | Proof of theorem_kind
-  type goal_kind = locality * polymorphic * goal_object_kind
-  type assumption_object_kind =
-    | Definitional
-    | Logical
-    | Conjectural
-  type logical_kind =
-    | IsAssumption of assumption_object_kind
-    | IsDefinition of definition_object_kind
-    | IsProof of theorem_kind
-  type binding_kind =
-    | Explicit
-    | Implicit
-  type private_flag = bool
-  type definition_kind = locality * polymorphic * definition_object_kind
-end
-
-module Retroknowledge :
-sig
-  type action
-  type nat_field =
-    | NatType
-    | NatPlus
-    | NatTimes
-  type n_field =
-    | NPositive
-    | NType
-    | NTwice
-    | NTwicePlusOne
-    | NPhi
-    | NPhiInv
-    | NPlus
-    | NTimes
-  type int31_field =
-    | Int31Bits
-    | Int31Type
-    | Int31Constructor
-    | Int31Twice
-    | Int31TwicePlusOne
-    | Int31Phi
-    | Int31PhiInv
-    | Int31Plus
-    | Int31PlusC
-    | Int31PlusCarryC
-    | Int31Minus
-    | Int31MinusC
-    | Int31MinusCarryC
-    | Int31Times
-    | Int31TimesC
-    | Int31Div21
-    | Int31Div
-    | Int31Diveucl
-    | Int31AddMulDiv
-    | Int31Compare
-    | Int31Head0
-    | Int31Tail0
-    | Int31Lor
-    | Int31Land
-    | Int31Lxor
-  type field =
-    | KInt31 of string * int31_field
-end
-
-module Conv_oracle :
-sig
-  type level
-end
-
-module Declarations :
-sig
-
-  open Names
-
-  type recarg =
-    | Norec
-    | Mrec of Names.inductive
-    | Imbr of Names.inductive
-  type wf_paths = recarg Rtree.t
-  type inline = int option
-  type constant_def =
-                    | Undef of inline
-                    | Def of Constr.t Mod_subst.substituted
-                    | OpaqueDef of Opaqueproof.opaque
-  type template_arity = {
-    template_param_levels : Univ.Level.t option list;
-    template_level : Univ.Universe.t;
-  }
-
-  type ('a, 'b) declaration_arity =
-    | RegularArity of 'a
-    | TemplateArity of 'b
-
-  type constant_universes =
-    | Monomorphic_const of Univ.universe_context
-    | Polymorphic_const of Univ.abstract_universe_context
-
-  type projection_body = {
-        proj_ind : Names.MutInd.t;
-        proj_npars : int;
-        proj_arg : int;
-        proj_type : Constr.types;
-        proj_eta  : Constr.t * Constr.types;
-        proj_body : Constr.t;
-      }
-
-  type typing_flags = {
-    check_guarded : bool;
-    check_universes : bool;
-  }
-
-  type constant_body = {
-        const_hyps : Context.Named.t;
-        const_body : constant_def;
-        const_type : Term.types;
-        const_body_code : Cemitcodes.to_patch_substituted option;
-        const_universes : constant_universes;
-        const_proj : projection_body option;
-        const_inline_code : bool;
-        const_typing_flags : typing_flags;
-      }
-
-  type regular_inductive_arity = {
-    mind_user_arity : Constr.types;
-    mind_sort : Sorts.t;
-  }
-
-  type inductive_arity = (regular_inductive_arity, template_arity) declaration_arity
-
-  type one_inductive_body = {
-        mind_typename : Names.Id.t;
-        mind_arity_ctxt : Context.Rel.t;
-        mind_arity : inductive_arity;
-        mind_consnames : Names.Id.t array;
-        mind_user_lc : Constr.types array;
-        mind_nrealargs : int;
-        mind_nrealdecls : int;
-        mind_kelim : Sorts.family list;
-        mind_nf_lc : Constr.types array;
-        mind_consnrealargs : int array;
-        mind_consnrealdecls : int array;
-        mind_recargs : wf_paths;
-        mind_nb_constant : int;
-        mind_nb_args : int;
-        mind_reloc_tbl :  Cbytecodes.reloc_table;
-      }
-
-  type ('ty,'a) functorize =
-                           | NoFunctor of 'a
-                           | MoreFunctor of Names.MBId.t * 'ty * ('ty,'a) functorize
-
-  type with_declaration =
-                        | WithMod of Names.Id.t list * Names.ModPath.t
-                        | WithDef of Names.Id.t list * Constr.t Univ.in_universe_context
-
-  type module_alg_expr =
-                       | MEident of Names.ModPath.t
-                       | MEapply of module_alg_expr * Names.ModPath.t
-                       | MEwith of module_alg_expr * with_declaration
-
-  type abstract_inductive_universes =
-  | Monomorphic_ind of Univ.universe_context
-  | Polymorphic_ind of Univ.abstract_universe_context
-  | Cumulative_ind of Univ.abstract_cumulativity_info
-
-  type record_body = (Id.t * Constant.t array * projection_body array) option
-  
-  type mutual_inductive_body = {
-        mind_packets : one_inductive_body array;
-        mind_record : record_body option;
-        mind_finite : Decl_kinds.recursivity_kind;
-        mind_ntypes : int;
-        mind_hyps : Context.Named.t;
-        mind_nparams : int;
-        mind_nparams_rec : int;
-        mind_params_ctxt : Context.Rel.t;
-        mind_universes : abstract_inductive_universes;
-        mind_private : bool option;
-        mind_typing_flags : typing_flags;
-      }
-   and module_expression = (module_type_body,module_alg_expr) functorize
-   and module_implementation =
-                             | Abstract
-                               | Algebraic of module_expression
-                             | Struct of module_signature
-                             | FullStruct
-   and module_body =
-                       { mod_mp : Names.ModPath.t;
-                         mod_expr : module_implementation;
-                         mod_type : module_signature;
-                         mod_type_alg : module_expression option;
-                         mod_constraints : Univ.ContextSet.t;
-                         mod_delta : Mod_subst.delta_resolver;
-                         mod_retroknowledge : Retroknowledge.action list
-                       }
-   and module_signature = (module_type_body,structure_body) functorize
-   and module_type_body = module_body
-   and structure_body = (Names.Label.t * structure_field_body) list
-   and structure_field_body =
-                            | SFBconst of constant_body
-                            | SFBmind of mutual_inductive_body
-                            | SFBmodule of module_body
-                            | SFBmodtype of module_type_body
-end
-
-module Declareops :
-sig
-  val constant_has_body : Declarations.constant_body -> bool
-  val is_opaque : Declarations.constant_body -> bool
-  val eq_recarg : Declarations.recarg -> Declarations.recarg -> bool
-end
-
-module Entries :
-sig
-
-  open Names
-  open Constr
-
-  type local_entry =
-    | LocalDefEntry   of constr
-    | LocalAssumEntry of constr
-
-  type inductive_universes =
-    | Monomorphic_ind_entry of Univ.universe_context
-    | Polymorphic_ind_entry of Univ.universe_context
-    | Cumulative_ind_entry of Univ.cumulativity_info
-
-  type one_inductive_entry = {
-    mind_entry_typename : Id.t;
-    mind_entry_arity : constr;
-    mind_entry_template : bool; (* Use template polymorphism *)
-    mind_entry_consnames : Id.t list;
-    mind_entry_lc : constr list }
-
-  type mutual_inductive_entry = {
-    mind_entry_record : (Names.Id.t option) option;
-    (** Some (Some id): primitive record with id the binder name of the record
-        in projections.
-        Some None: non-primitive record *)
-    mind_entry_finite : Decl_kinds.recursivity_kind;
-    mind_entry_params : (Id.t * local_entry) list;
-    mind_entry_inds : one_inductive_entry list;
-    mind_entry_universes : inductive_universes;
-    (* universe constraints and the constraints for subtyping of
-       inductive types in the block. *)
-    mind_entry_private : bool option;
-  }
-
-  type inline = int option
-  type 'a proof_output = Constr.t Univ.in_universe_context_set * 'a
-  type 'a const_entry_body = 'a proof_output Future.computation
-  type constant_universes_entry =
-    | Monomorphic_const_entry of Univ.universe_context
-    | Polymorphic_const_entry of Univ.universe_context
-  type 'a definition_entry =
-                               { const_entry_body   : 'a const_entry_body;
-                                 (* List of section variables *)
-                                 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        : Constr.types option;
-                                 const_entry_universes   : constant_universes_entry;
-                                 const_entry_opaque      : bool;
-                                 const_entry_inline_code : bool }
-  type parameter_entry = Context.Named.t option * bool * Constr.types Univ.in_universe_context * inline
-
-  type projection_entry = {
-    proj_entry_ind : MutInd.t;
-    proj_entry_arg : int }
-
-  type 'a constant_entry =
-                         | DefinitionEntry of 'a definition_entry
-                         | ParameterEntry of parameter_entry
-                         | ProjectionEntry of projection_entry
-  type module_struct_entry = Declarations.module_alg_expr
-  type module_params_entry =
-    (Names.MBId.t * module_struct_entry) list
-  type module_type_entry = module_params_entry * module_struct_entry
-end
-
-module Environ :
-sig
-  type env
-  type named_context_val
-
-  type ('constr, 'types) punsafe_judgment =
-    {
-      uj_val : 'constr;
-      uj_type : 'types
-    }
-  type 'types punsafe_type_judgment = {
-    utj_val : 'types;
-    utj_type : Sorts.t }
-
-  type unsafe_type_judgment = Term.types punsafe_type_judgment
-  val empty_env : env
-  val lookup_mind : Names.MutInd.t -> env -> Declarations.mutual_inductive_body
-  val push_rel : Context.Rel.Declaration.t -> env -> env
-  val push_rel_context : Context.Rel.t -> env -> env
-  val push_rec_types : Term.rec_declaration -> env -> env
-  val lookup_rel : int -> env -> Context.Rel.Declaration.t
-  val lookup_named : Names.Id.t -> env -> Context.Named.Declaration.t
-  val lookup_named_val : Names.Id.t -> named_context_val -> Context.Named.Declaration.t
-  val lookup_constant : Names.Constant.t -> env -> Declarations.constant_body
-  val opaque_tables : env -> Opaqueproof.opaquetab
-  val is_projection : Names.Constant.t -> env -> bool
-  val lookup_projection : Names.Projection.t -> env -> Declarations.projection_body
-  val named_context_of_val : named_context_val -> Context.Named.t
-  val push_named : Context.Named.Declaration.t -> env -> env
-  val named_context : env -> Context.Named.t
-  val named_context_val : env -> named_context_val
-  val push_named_context_val : Context.Named.Declaration.t -> named_context_val -> named_context_val
-  val reset_with_named_context : named_context_val -> env -> env
-  val rel_context : env -> Context.Rel.t
-  val constant_value_in : env -> Names.Constant.t Univ.puniverses -> Constr.t
-  val named_type : Names.Id.t -> env -> Constr.types
-  val constant_opt_value_in : env -> Names.Constant.t Univ.puniverses -> Constr.t option
-  val fold_named_context_reverse :
-    ('a -> Context.Named.Declaration.t -> 'a) -> init:'a -> env -> 'a
-  val evaluable_named  : Names.Id.t -> env -> bool
-  val push_context_set : ?strict:bool -> Univ.ContextSet.t -> env -> env
-end
-
-module CClosure :
-sig
-
-  type table_key = Names.Constant.t Univ.puniverses Names.tableKey
-
-  type fconstr
-
-  type fterm =
-    | FRel of int
-    | FAtom of Constr.t (** Metas and Sorts *)
-    | FCast of fconstr * Constr.cast_kind * fconstr
-    | FFlex of table_key
-    | FInd of Names.inductive Univ.puniverses
-    | FConstruct of Names.constructor Univ.puniverses
-    | FApp of fconstr * fconstr array
-    | FProj of Names.Projection.t * fconstr
-    | FFix of Term.fixpoint * fconstr Esubst.subs
-    | FCoFix of Term.cofixpoint * fconstr Esubst.subs
-    | FCaseT of Term.case_info * Constr.t * fconstr * Constr.t array * fconstr Esubst.subs (* predicate and branches are closures *)
-    | FLambda of int * (Names.Name.t * Constr.t) list * Constr.t * fconstr Esubst.subs
-    | FProd of Names.Name.t * fconstr * fconstr
-    | FLetIn of Names.Name.t * fconstr * fconstr * Constr.t * fconstr Esubst.subs
-    | FEvar of Term.existential * fconstr Esubst.subs
-    | FLIFT of int * fconstr
-    | FCLOS of Constr.t * fconstr Esubst.subs
-    | FLOCKED
-
-  module RedFlags : sig
-    type reds
-    type red_kind
-    val mkflags : red_kind list -> reds
-    val fBETA : red_kind
-    val fCOFIX : red_kind
-    val fCONST : Names.Constant.t -> red_kind
-    val fFIX : red_kind
-    val fMATCH : red_kind
-    val fZETA : red_kind
-    val red_add_transparent : reds -> Names.transparent_state -> reds
-  end
-
-  type 'a infos_cache
-  type 'a infos = {
-    i_flags : RedFlags.reds;
-    i_cache : 'a infos_cache }
-
-  type clos_infos = fconstr infos
-
-  val mk_clos : fconstr Esubst.subs -> Constr.t -> fconstr
-  val mk_atom : Constr.t -> fconstr
-  val mk_clos_deep :
-    (fconstr Esubst.subs -> Constr.t -> fconstr) ->
-    fconstr Esubst.subs -> Constr.t -> fconstr
-  val mk_red : fterm -> fconstr
-  val all : RedFlags.reds
-  val beta : RedFlags.reds
-  val betaiota : RedFlags.reds
-  val betaiotazeta : RedFlags.reds
-
-  val create_clos_infos : ?evars:(Term.existential -> Constr.t option) -> RedFlags.reds -> Environ.env -> clos_infos
-
-  val whd_val : clos_infos -> fconstr -> Constr.t
-
-  val inject : Constr.t -> fconstr
-
-  val kl : clos_infos -> fconstr -> Constr.t
-  val term_of_fconstr : fconstr -> Constr.t
-end
-
-module Reduction :
-sig
-  exception NotConvertible
-  type conv_pb =
-               | CONV
-               | CUMUL
-
-  val whd_all : Environ.env -> Constr.t -> Constr.t
-
-  val whd_betaiotazeta : Environ.env -> Constr.t -> Constr.t
-
-  val is_arity : Environ.env -> Term.types -> bool
-
-  val dest_prod : Environ.env -> Term.types -> Context.Rel.t * Term.types
-
-  type 'a extended_conversion_function =
-    ?l2r:bool -> ?reds:Names.transparent_state -> Environ.env ->
-    ?evars:((Term.existential->Constr.t option) * UGraph.t) ->
-    'a -> 'a -> unit
-  val conv : Constr.t extended_conversion_function
-end
-
-module Type_errors :
-sig
-
-  open Names
-  open Term
-  open Environ
-
-  type 'constr pguard_error =
-    (** Fixpoints *)
-    | NotEnoughAbstractionInFixBody
-    | RecursionNotOnInductiveType of 'constr
-    | RecursionOnIllegalTerm of int * (env * 'constr) * int list * int list
-    | NotEnoughArgumentsForFixCall of int
-    (** CoFixpoints *)
-    | CodomainNotInductiveType of 'constr
-    | NestedRecursiveOccurrences
-    | UnguardedRecursiveCall of 'constr
-    | RecCallInTypeOfAbstraction of 'constr
-    | RecCallInNonRecArgOfConstructor of 'constr
-    | RecCallInTypeOfDef of 'constr
-    | RecCallInCaseFun of 'constr
-    | RecCallInCaseArg of 'constr
-    | RecCallInCasePred of 'constr
-    | NotGuardedForm of 'constr
-    | ReturnPredicateNotCoInductive of 'constr
-
-  type arity_error =
-    | NonInformativeToInformative
-    | StrongEliminationOnNonSmallType
-    | WrongArity
-
-  type ('constr, 'types) ptype_error =
-    | UnboundRel of int
-    | UnboundVar of variable
-    | NotAType of ('constr, 'types) punsafe_judgment
-    | BadAssumption of ('constr, 'types) punsafe_judgment
-    | ReferenceVariables of identifier * 'constr
-    | ElimArity of pinductive * sorts_family list * 'constr * ('constr, 'types) punsafe_judgment
-                   * (sorts_family * sorts_family * arity_error) option
-    | CaseNotInductive of ('constr, 'types) punsafe_judgment
-    | WrongCaseInfo of pinductive * case_info
-    | NumberBranches of ('constr, 'types) punsafe_judgment * int
-    | IllFormedBranch of 'constr * pconstructor * 'constr * 'constr
-    | Generalization of (Name.t * 'types) * ('constr, 'types) punsafe_judgment
-    | ActualType of ('constr, 'types) punsafe_judgment * 'types
-    | CantApplyBadType of
-        (int * 'constr * 'constr) * ('constr, 'types) punsafe_judgment * ('constr, 'types) punsafe_judgment array
-    | CantApplyNonFunctional of ('constr, 'types) punsafe_judgment * ('constr, 'types) punsafe_judgment array
-    | IllFormedRecBody of 'constr pguard_error * Name.t array * int * env * ('constr, 'types) punsafe_judgment array
-    | IllTypedRecBody of
-        int * Name.t array * ('constr, 'types) punsafe_judgment array * 'types array
-    | UnsatisfiedConstraints of Univ.Constraint.t
-
-  type type_error = (constr, types) ptype_error
-
-  exception TypeError of Environ.env * type_error
-end
-
-module Modops :
-sig
-  val destr_nofunctor : ('ty,'a) Declarations.functorize -> 'a
-  val add_structure :
-    Names.ModPath.t -> Declarations.structure_body -> Mod_subst.delta_resolver ->
-    Environ.env -> Environ.env
-  val add_module_type : Names.ModPath.t -> Declarations.module_type_body -> Environ.env -> Environ.env
-end
-
-module Inductive :
-sig
-  type mind_specif = Declarations.mutual_inductive_body * Declarations.one_inductive_body
-  val type_of_inductive : Environ.env -> mind_specif Univ.puniverses -> Term.types
-  exception SingletonInductiveBecomesProp of Names.Id.t
-  val lookup_mind_specif : Environ.env -> Names.inductive -> mind_specif
-  val find_inductive  : Environ.env -> Term.types -> Term.pinductive * Constr.t list
-end
-
-module Typeops :
-sig
-  val infer_type : Environ.env -> Term.types -> Environ.unsafe_type_judgment
-  val type_of_constant_in : Environ.env -> Term.pconstant -> Term.types
-end
-
-module Mod_typing :
-sig
-  type 'alg translation =
-    Declarations.module_signature * 'alg * Mod_subst.delta_resolver * Univ.ContextSet.t
-  val translate_modtype :
-    Environ.env -> Names.ModPath.t -> Entries.inline ->
-     Entries.module_type_entry -> Declarations.module_type_body
-  val translate_mse :
-    Environ.env -> Names.ModPath.t option -> Entries.inline -> Declarations.module_alg_expr ->
-    Declarations.module_alg_expr translation
-end
-
-module Safe_typing :
-sig
-  type private_constants
-  val mk_pure_proof : Constr.t -> private_constants Entries.proof_output
-end
-
-(************************************************************************)
-(* End of modules from kernel/                                          *)
-(************************************************************************)
-
-(************************************************************************)
-(* Modules from intf/                                                   *)
-(************************************************************************)
-
-module Misctypes :
-sig
-  type evars_flag = bool
-  type clear_flag = bool option
-  type advanced_flag = bool
-  type rec_flag = bool
-
-  type 'a or_by_notation =
-    | AN of 'a
-    | ByNotation of (string * string option) Loc.located
-
-  type 'a or_var =
-                 | ArgArg of 'a
-                 | ArgVar of Names.Id.t Loc.located
-
-  type 'a and_short_name = 'a * Names.Id.t Loc.located option
-
-  type 'a glob_sort_gen =
-    | GProp (** representation of [Prop] literal *)
-    | GSet  (** representation of [Set] literal *)
-    | GType of 'a (** representation of [Type] literal *)
-
-  type level_info = Names.Name.t Loc.located option
-  type glob_level = level_info glob_sort_gen
-
-  type sort_info = Names.Name.t Loc.located list
-  type glob_sort = sort_info glob_sort_gen
-
-  type case_style = Term.case_style =
-    | LetStyle
-    | IfStyle
-    | LetPatternStyle
-    | MatchStyle
-    | RegularStyle (** infer printing form from number of constructor *)
-
-  type 'a cast_type =
-                    | CastConv of 'a
-                    | CastVM of 'a
-                    | CastCoerce
-                    | CastNative of 'a
-
-  type 'constr intro_pattern_expr =
-    | IntroForthcoming of bool
-    | IntroNaming of intro_pattern_naming_expr
-    | IntroAction of 'constr intro_pattern_action_expr
-  and intro_pattern_naming_expr =
-    | IntroIdentifier of Names.Id.t
-    | IntroFresh of Names.Id.t
-    | IntroAnonymous
-  and 'constr intro_pattern_action_expr =
-    | IntroWildcard
-    | IntroOrAndPattern of 'constr or_and_intro_pattern_expr
-    | IntroInjection of ('constr intro_pattern_expr) Loc.located list
-    | IntroApplyOn of 'constr Loc.located * 'constr intro_pattern_expr Loc.located
-    | IntroRewrite of bool
-  and 'constr or_and_intro_pattern_expr =
-    | IntroOrPattern of ('constr intro_pattern_expr) Loc.located list list
-    | IntroAndPattern of ('constr intro_pattern_expr) Loc.located list
-
-  type quantified_hypothesis =
-    | AnonHyp of int
-    | NamedHyp of Names.Id.t
-
-  type 'a explicit_bindings = (quantified_hypothesis * 'a) Loc.located list
-
-  type 'a bindings =
-    | ImplicitBindings of 'a list
-    | ExplicitBindings of 'a explicit_bindings
-    | NoBindings
-
-  type 'a with_bindings = 'a * 'a bindings
-
-  type 'a core_destruction_arg =
-    | ElimOnConstr of 'a
-    | ElimOnIdent of Names.Id.t Loc.located
-    | ElimOnAnonHyp of int
-
-  type inversion_kind =
-    | SimpleInversion
-    | FullInversion
-    | FullInversionClear
-
-  type multi =
-    | Precisely of int
-    | UpTo of int
-    | RepeatStar
-    | RepeatPlus
-  type 'id move_location =
-    | MoveAfter of 'id
-    | MoveBefore of 'id
-    | MoveFirst
-    | MoveLast
-
-  type 'a destruction_arg = clear_flag * 'a core_destruction_arg
-
-end
-
-module Locus :
-sig
-  type 'a occurrences_gen =
-  | AllOccurrences
-  | AllOccurrencesBut of 'a list (** non-empty *)
-  | NoOccurrences
-  | OnlyOccurrences of 'a list (** non-empty *)
-  type occurrences = int occurrences_gen
-  type occurrences_expr = (int Misctypes.or_var) occurrences_gen
-  type 'a with_occurrences = occurrences_expr * 'a
-  type hyp_location_flag =
-                             InHyp | InHypTypeOnly | InHypValueOnly
-  type 'a hyp_location_expr = 'a with_occurrences * hyp_location_flag
-  type 'id clause_expr =
-  { onhyps : 'id hyp_location_expr list option;
-    concl_occs : occurrences_expr }
-  type clause = Names.Id.t clause_expr
-  type hyp_location = Names.Id.t * hyp_location_flag
-  type goal_location = hyp_location option
-end
-
-(************************************************************************)
-(* End Modules from intf/                                               *)
-(************************************************************************)
-
-(************************************************************************)
-(* Modules from library/                                                *)
-(************************************************************************)
-
-module Univops :
-sig
-  val universes_of_constr : Term.constr -> Univ.universe_set
-  val restrict_universe_context : Univ.universe_context_set -> Univ.universe_set -> Univ.universe_context_set
-end
-
-module Nameops :
-sig
-  val atompart_of_id : Names.Id.t -> string
-
-  val pr_id : Names.Id.t -> Pp.t
-  [@@ocaml.deprecated "alias of API.Names.Id.print"]
-
-  val pr_name : Names.Name.t -> Pp.t
-  [@@ocaml.deprecated "alias of API.Names.Name.print"]
-
-  val name_fold : (Names.Id.t -> 'a -> 'a) -> Names.Name.t -> 'a -> 'a
-  val name_app : (Names.Id.t -> Names.Id.t) -> Names.Name.t -> Names.Name.t
-  val add_suffix : Names.Id.t -> string -> Names.Id.t
-  val increment_subscript : Names.Id.t -> Names.Id.t
-  val make_ident : string -> int option -> Names.Id.t
-  val out_name : Names.Name.t -> Names.Id.t
-  val pr_lab : Names.Label.t -> Pp.t
-  module Name :
-  sig
-    include module type of struct include Names.Name end
-    val get_id : t -> Names.Id.t
-    val fold_right : (Names.Id.t -> 'a -> 'a) -> t -> 'a -> 'a
-  end
-end
-
-module Libnames :
-sig
-
-  open Util
-  open Names
-
-  type full_path
-  val pr_path : full_path -> Pp.t
-  val make_path : Names.DirPath.t -> Names.Id.t -> full_path
-  val eq_full_path : full_path -> full_path -> bool
-  val dirpath : full_path -> Names.DirPath.t
-  val path_of_string : string -> full_path
-
-  type qualid
-  val make_qualid : Names.DirPath.t -> Names.Id.t -> qualid
-  val qualid_eq : qualid -> qualid -> bool
-  val repr_qualid : qualid -> Names.DirPath.t * Names.Id.t
-  val pr_qualid : qualid -> Pp.t
-  val string_of_qualid : qualid -> string
-  val qualid_of_string : string -> qualid
-  val qualid_of_path : full_path -> qualid
-  val qualid_of_dirpath : Names.DirPath.t -> qualid
-  val qualid_of_ident : Names.Id.t -> qualid
-
-  type reference =
-    | Qualid of qualid Loc.located
-    | Ident of Names.Id.t Loc.located
-  val loc_of_reference : reference -> Loc.t option
-  val qualid_of_reference : reference -> qualid Loc.located
-  val pr_reference : reference -> Pp.t
-
-  val is_dirpath_prefix_of : Names.DirPath.t -> Names.DirPath.t -> bool
-  val split_dirpath : Names.DirPath.t -> Names.DirPath.t * Names.Id.t
-  val dirpath_of_string : string -> Names.DirPath.t
-  val pr_dirpath : Names.DirPath.t -> Pp.t
-
-  val string_of_path : full_path -> string
-  val basename : full_path -> Names.Id.t
-
-  type object_name = full_path * Names.KerName.t
-  type object_prefix = Names.DirPath.t * (Names.ModPath.t * Names.DirPath.t)
-
-  module Dirset : Set.S with type elt = DirPath.t
-  module Dirmap : Map.ExtS with type key = DirPath.t and module Set := Dirset
-  module Spmap  : CSig.MapS with type key = full_path
-end
-
-module Globnames :
-sig
-
-  open Util
-
-  type global_reference =
-    | VarRef of Names.Id.t
-    | ConstRef of Names.Constant.t
-    | IndRef of Names.inductive
-    | ConstructRef of Names.constructor
-
-  type extended_global_reference =
-                                 | TrueGlobal of global_reference
-                                 | SynDef of Names.KerName.t
-
-  (* Long term: change implementation so that only 1 kind of order is needed.
-   * Today: _env ones are fine grained, which one to pick depends.  Eg.
-   *   - conversion rule are implemented by the non_env ones
-   *   - pretty printing (of user provided names/aliases) are implemented by
-   *     the _env ones
-   *)
-  module Refset : CSig.SetS with type elt = global_reference
-  module Refmap : Map.ExtS
-    with type key = global_reference and module Set := Refset
-
-  module Refset_env : CSig.SetS with type elt = global_reference
-  module Refmap_env : Map.ExtS
-    with type key = global_reference and module Set := Refset_env
-
-  module RefOrdered :
-  sig
-    type t = global_reference
-    val compare : t -> t -> int
-  end
-
-  val pop_global_reference : global_reference -> global_reference
-  val eq_gr : global_reference -> global_reference -> bool
-  val destIndRef : global_reference -> Names.inductive
-
-  val encode_mind : Names.DirPath.t -> Names.Id.t -> Names.MutInd.t
-  val encode_con : Names.DirPath.t -> Names.Id.t -> Names.Constant.t
-
-  val global_of_constr : Constr.t -> global_reference
-
-  val subst_global : Mod_subst.substitution -> global_reference -> global_reference * Constr.t
-  val destConstructRef : global_reference -> Names.constructor
-
-  val reference_of_constr : Constr.t -> global_reference
-  [@@ocaml.deprecated "alias of API.Globnames.global_of_constr"]
-
-  val is_global : global_reference -> Constr.t -> bool
-end
-
-module Libobject :
-sig
-  type obj
-  type 'a substitutivity =
-                         | Dispose
-                           | Substitute of 'a
-                         | Keep of 'a
-                         | Anticipate of 'a
-
-  type 'a object_declaration =   {
-                                   object_name : string;
-                                   cache_function : Libnames.object_name * 'a -> unit;
-                                   load_function : int -> Libnames.object_name * 'a -> unit;
-                                   open_function : int -> Libnames.object_name * 'a -> unit;
-                                   classify_function : 'a -> 'a substitutivity;
-                                   subst_function :  Mod_subst.substitution * 'a -> 'a;
-                                   discharge_function : Libnames.object_name * 'a -> 'a option;
-                                   rebuild_function : 'a -> 'a
-                                 }
-  val declare_object : 'a object_declaration -> ('a -> obj)
-  val default_object : string -> 'a object_declaration
-  val object_tag : obj -> string
-end
-
-module Summary :
-sig
-
-  type frozen
-  type marshallable
-
-  type 'a summary_declaration =
-    { freeze_function : marshallable -> 'a;
-      unfreeze_function : 'a -> unit;
-      init_function : unit -> unit; }
-
-  val ref : ?freeze:(marshallable -> 'a -> 'a) -> name:string -> 'a -> 'a ref
-  val declare_summary : string -> 'a summary_declaration -> unit
-  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
-end
-
-module Nametab :
-sig
-  exception GlobalizationError of Libnames.qualid
-
-  type ltac_constant = Names.KerName.t
-
-  val global : Libnames.reference -> Globnames.global_reference
-  val global_of_path : Libnames.full_path -> Globnames.global_reference
-  val shortest_qualid_of_global : Names.Id.Set.t -> Globnames.global_reference -> Libnames.qualid
-  val path_of_global : Globnames.global_reference -> Libnames.full_path
-  val locate_extended : Libnames.qualid -> Globnames.extended_global_reference
-  val full_name_module : Libnames.qualid -> Names.DirPath.t
-  val locate_tactic : Libnames.qualid -> Names.KerName.t
-  val pr_global_env : Names.Id.Set.t -> Globnames.global_reference -> Pp.t
-  val shortest_qualid_of_tactic : Names.KerName.t -> Libnames.qualid
-  val basename_of_global : Globnames.global_reference -> Names.Id.t
-
-  type visibility =
-    | Until of int
-    | Exactly of int
-
-  val push_tactic : visibility -> Libnames.full_path -> Names.KerName.t -> unit
-  val error_global_not_found : ?loc:Loc.t -> Libnames.qualid -> 'a
-  val shortest_qualid_of_module : Names.ModPath.t -> Libnames.qualid
-  val dirpath_of_module : Names.ModPath.t -> Names.DirPath.t
-  val locate_module : Libnames.qualid -> Names.ModPath.t
-  val dirpath_of_global : Globnames.global_reference -> Names.DirPath.t
-  val locate : Libnames.qualid -> Globnames.global_reference
-  val locate_constant : Libnames.qualid -> Names.Constant.t
-end
-
-module Global :
-sig
-  val env : unit -> Environ.env
-  val lookup_mind : Names.MutInd.t -> Declarations.mutual_inductive_body
-  val lookup_constant  : Names.Constant.t -> Declarations.constant_body
-  val lookup_module    : Names.ModPath.t -> Declarations.module_body
-  val lookup_modtype   : Names.ModPath.t -> Declarations.module_type_body
-  val lookup_inductive : Names.inductive -> Declarations.mutual_inductive_body * Declarations.one_inductive_body
-  val constant_of_delta_kn : Names.KerName.t -> Names.Constant.t
-  val register :
-    Retroknowledge.field -> Constr.t -> Constr.t -> unit
-  val env_of_context : Environ.named_context_val -> Environ.env
-  val is_polymorphic : Globnames.global_reference -> bool
-
-  val constr_of_global_in_context : Environ.env ->
-    Globnames.global_reference -> Constr.types * Univ.AUContext.t
-
-  val type_of_global_in_context : Environ.env ->
-    Globnames.global_reference -> Constr.types * Univ.AUContext.t
-
-  val current_dirpath : unit -> Names.DirPath.t
-  val body_of_constant_body : Declarations.constant_body -> (Constr.t * Univ.AUContext.t) option
-  val body_of_constant : Names.Constant.t -> (Constr.t * Univ.AUContext.t) option
-  val add_constraints : Univ.Constraint.t -> unit
-end
-
-module Lib : sig
-  type is_type = bool
-  type export = bool option
-  type node =
-            | Leaf of Libobject.obj (* FIX: horrible hack (wrt. Enrico) *)
-            | CompilingLibrary of Libnames.object_prefix
-            | OpenedModule of is_type * export * Libnames.object_prefix * Summary.frozen
-            | ClosedModule  of library_segment
-            | OpenedSection of Libnames.object_prefix * Summary.frozen
-            | ClosedSection of library_segment
-
-   and library_segment = (Libnames.object_name * node) list
-
-  val current_mp : unit -> Names.ModPath.t
-  val is_modtype : unit -> bool
-  val is_module : unit -> bool
-  val sections_are_opened : unit -> bool
-  val add_anonymous_leaf : ?cache_first:bool -> Libobject.obj -> unit
-  val contents : unit -> library_segment
-  val cwd : unit -> Names.DirPath.t
-  val add_leaf : Names.Id.t -> Libobject.obj -> Libnames.object_name
-  val make_kn : Names.Id.t -> Names.KerName.t
-  val make_path : Names.Id.t -> Libnames.full_path
-  val discharge_con : Names.Constant.t -> Names.Constant.t
-  val discharge_inductive : Names.inductive -> Names.inductive
-end
-
-module Declaremods :
-sig
-
-  val append_end_library_hook : (unit -> unit) -> unit
-
-end
-
-module Library :
-sig
-  val library_is_loaded : Names.DirPath.t -> bool
-  val loaded_libraries : unit -> Names.DirPath.t list
-end
-
-module States :
-sig
-  val with_state_protection_on_exception : ('a -> 'b) -> 'a -> 'b
-  val with_state_protection : ('a -> 'b) -> 'a -> 'b
-end
-
-module Kindops :
-sig
-  val logical_kind_of_goal_kind : Decl_kinds.goal_object_kind -> Decl_kinds.logical_kind
-end
-
-module Goptions :
-sig
-  type option_name = string list
-  type 'a option_sig =
-    {
-      optdepr  : bool;
-      optname  : string;
-      optkey   : option_name;
-      optread  : unit -> 'a;
-      optwrite : 'a -> unit
-    }
-
-  type 'a write_function = 'a -> unit
-
-  val declare_bool_option  : ?preprocess:(bool -> bool) ->
-                             bool option_sig   -> bool write_function
-  val declare_int_option   : ?preprocess:(int option -> int option) ->
-                             int option option_sig -> int option write_function
-  val declare_string_option: ?preprocess:(string -> string) ->
-                             string option_sig -> string write_function
-  val set_bool_option_value : option_name -> bool -> unit
-end
-
-module Keys :
-sig
-  type key
-  val constr_key : ('a -> ('a, 't, 'u, 'i) Constr.kind_of_term) -> 'a -> key option
-  val declare_equiv_keys : key -> key -> unit
-  val pr_keys : (Globnames.global_reference -> Pp.t) -> Pp.t
-end
-
-module Coqlib :
-sig
-
-  type coq_eq_data = { eq   : Globnames.global_reference;
-                       ind  : Globnames.global_reference;
-                       refl : Globnames.global_reference;
-                       sym  : Globnames.global_reference;
-                       trans: Globnames.global_reference;
-                       congr: Globnames.global_reference;
-                     }
-
-  type coq_sigma_data = {
-      proj1 : Globnames.global_reference;
-      proj2 : Globnames.global_reference;
-      elim  : Globnames.global_reference;
-      intro : Globnames.global_reference;
-      typ   : Globnames.global_reference }
-  val gen_reference : string -> string list -> string -> Globnames.global_reference
-  val find_reference : string -> string list -> string -> Globnames.global_reference
-  val check_required_library : string list -> unit
-  val logic_module_name : string list
-  val glob_true : Globnames.global_reference
-  val glob_false : Globnames.global_reference
-  val glob_O : Globnames.global_reference
-  val glob_S : Globnames.global_reference
-  val nat_path : Libnames.full_path
-  val datatypes_module_name : string list
-  val glob_eq : Globnames.global_reference
-  val build_coq_eq_sym : Globnames.global_reference Util.delayed
-  val build_coq_False : Globnames.global_reference Util.delayed
-  val build_coq_not : Globnames.global_reference Util.delayed
-  val build_coq_eq : Globnames.global_reference Util.delayed
-  val build_coq_eq_data : coq_eq_data Util.delayed
-  val path_of_O : Names.constructor
-  val path_of_S : Names.constructor
-  val build_prod : coq_sigma_data Util.delayed
-  val build_coq_True : Globnames.global_reference Util.delayed
-  val coq_iff_ref : Globnames.global_reference lazy_t
-  val build_coq_iff_left_proj : Globnames.global_reference Util.delayed
-  val build_coq_iff_right_proj : Globnames.global_reference Util.delayed
-  val init_modules : string list list
-  val build_coq_eq_refl  : Globnames.global_reference Util.delayed
-  val arith_modules : string list list
-  val zarith_base_modules : string list list
-  val gen_reference_in_modules : string -> string list list-> string -> Globnames.global_reference
-  val jmeq_module_name : string list
-  val coq_eq_ref : Globnames.global_reference lazy_t
-  val coq_not_ref : Globnames.global_reference lazy_t
-  val coq_or_ref : Globnames.global_reference lazy_t
-  val build_coq_and : Globnames.global_reference Util.delayed
-  val build_coq_I : Globnames.global_reference Util.delayed
-  val coq_reference : string -> string list -> string -> Globnames.global_reference
-end
-
-(************************************************************************)
-(* End of modules from library/                                         *)
-(************************************************************************)
-
-(************************************************************************)
-(* Modules from engine/                                                 *)
-(************************************************************************)
-
-module Universes :
-sig
-  type universe_binders
-  type universe_opt_subst
-  val fresh_inductive_instance : Environ.env -> Names.inductive -> Term.pinductive Univ.in_universe_context_set
-  val new_Type : Names.DirPath.t -> Term.types
-  val type_of_global : Globnames.global_reference -> Term.types Univ.in_universe_context_set
-  val constr_of_global : Globnames.global_reference -> Constr.t
-  val new_univ_level : Names.DirPath.t -> Univ.Level.t
-  val new_sort_in_family : Sorts.family -> Sorts.t
-  val pr_with_global_universes : Univ.Level.t -> Pp.t
-  val pr_universe_opt_subst : universe_opt_subst -> Pp.t
-  type universe_constraint
-
-  module Constraints :
-  sig
-    type t
-    val pr : t -> Pp.t
-  end
-
-  type universe_constraints = Constraints.t
-end
-
-module UState :
-sig
-  type t
-  val context : t -> Univ.UContext.t
-  val context_set : t -> Univ.ContextSet.t
-  val of_context_set : Univ.ContextSet.t -> t
-
-  type rigid =
-    | UnivRigid
-    | UnivFlexible of bool
-
-end
-
-(* XXX: Moved from intf *)
-module Evar_kinds :
-sig
-  type obligation_definition_status =
-    | Define of bool
-    | Expand
-
-  type matching_var_kind =
-    | FirstOrderPatVar of Names.Id.t
-    | SecondOrderPatVar of Names.Id.t
-
-  type t =
-         | ImplicitArg of Globnames.global_reference * (int * Names.Id.t option)
-                          * bool (** Force inference *)
-         | BinderType of Names.Name.t
-         | NamedHole of Names.Id.t (* coming from some ?[id] syntax *)
-         | QuestionMark of obligation_definition_status * Names.Name.t
-         | CasesType of bool (* true = a subterm of the type *)
-         | InternalHole
-         | TomatchTypeParameter of Names.inductive * int
-         | GoalEvar
-         | ImpossibleCase
-         | MatchingVar of matching_var_kind
-         | VarInstance of Names.Id.t
-         | SubEvar of Constr.existential_key
-end
-
-module Evd :
-sig
-
-  type evar = Constr.existential_key
-
-  val string_of_existential : Evar.t -> string
-  type evar_constraint = Reduction.conv_pb * Environ.env * Constr.t * Constr.t
-
-  (* --------------------------------- *)
-
-  (* evar info *)
-
-  module Store :
-  sig
-    type t
-    val empty : t
-  end
-
-  module Filter :
-  sig
-    type t
-    val repr : t -> bool list option
-  end
-
-  (** This value defines the refinement of a given {i evar} *)
-  type evar_body =
-              | Evar_empty (** given {i evar} was not yet refined *)
-              | Evar_defined of Constr.t (** given {i var} was refined to the indicated term *)
-
-  (** all the information we have concerning some {i evar} *)
-  type evar_info =
-    {
-      evar_concl : Constr.t;
-      evar_hyps : Environ.named_context_val;
-      evar_body : evar_body;
-      evar_filter : Filter.t;
-      evar_source : Evar_kinds.t Loc.located;
-      evar_candidates : Constr.t list option; (* if not None, list of allowed instances *)
-      evar_extra : Store.t
-    }
-
-  val evar_concl : evar_info -> Constr.t
-  val evar_body : evar_info -> evar_body
-  val evar_context : evar_info -> Context.Named.t
-  val instantiate_evar_array : evar_info -> Constr.t -> Constr.t array -> Constr.t
-  val evar_filtered_env : evar_info -> Environ.env
-  val evar_hyps : evar_info -> Environ.named_context_val
-
-  (* ------------------------------------ *)
-
-  (* evar map *)
-
-  type evar_map
-  type open_constr = evar_map * Constr.t
-
-  open Util
-
-  module Metaset : Set.S with type elt = Constr.metavariable
-
-  type rigid = UState.rigid =
-    | UnivRigid
-    | UnivFlexible of bool
-
-    type 'a freelisted = {
-          rebus : 'a;
-          freemetas : Metaset.t
-        }
-
-    type instance_constraint = IsSuperType | IsSubType | Conv
-
-    type instance_typing_status =
-        CoerceToType | TypeNotProcessed | TypeProcessed
-
-    type instance_status = instance_constraint * instance_typing_status
-
-    type clbinding =
-      | Cltyp of Names.Name.t * Constr.t freelisted
-      | Clval of Names.Name.t * (Constr.t freelisted * instance_status) * Constr.t freelisted
-
-    val empty : evar_map
-    val from_env : Environ.env -> evar_map
-    val find : evar_map -> Evar.t -> evar_info
-    val find_undefined : evar_map -> evar -> evar_info
-    val is_defined : evar_map -> Evar.t -> bool
-    val mem : evar_map -> Evar.t -> bool
-    val add : evar_map -> Evar.t -> evar_info -> evar_map
-    val evar_universe_context : evar_map -> UState.t
-    val set_universe_context : evar_map -> UState.t -> evar_map
-    val universes : evar_map -> UGraph.t
-    val define : Evar.t -> Constr.t -> evar_map -> evar_map
-    val fold : (Evar.t -> evar_info -> 'a -> 'a) -> evar_map -> 'a -> 'a
-    val evar_key : Names.Id.t -> evar_map -> Evar.t
-
-    val create_evar_defs : evar_map -> evar_map
-
-    val meta_declare : Constr.metavariable -> Term.types -> ?name:Names.Name.t -> evar_map -> evar_map
-
-    val clear_metas : evar_map -> evar_map
-
-    (** Allocates a new evar that represents a {i sort}. *)
-    val new_sort_variable : ?loc:Loc.t -> ?name:string -> rigid -> evar_map -> evar_map * Sorts.t
-
-    val remove : evar_map -> Evar.t -> evar_map
-    val fresh_global : ?loc:Loc.t -> ?rigid:rigid -> ?names:Univ.Instance.t -> Environ.env ->
-                       evar_map -> Globnames.global_reference -> evar_map * Constr.t
-    val evar_filtered_context : evar_info -> Context.Named.t
-    val fresh_inductive_instance : ?loc:Loc.t -> Environ.env -> evar_map -> Names.inductive -> evar_map * Term.pinductive
-    val fold_undefined : (Evar.t -> evar_info -> 'a -> 'a) -> evar_map -> 'a -> 'a
-
-    val universe_context_set : evar_map -> Univ.ContextSet.t
-    val evar_ident : evar -> evar_map -> Names.Id.t option
-    val extract_all_conv_pbs : evar_map -> evar_map * evar_constraint list
-    val universe_context : ?names:(Names.Id.t Loc.located) list -> evar_map ->
-                           (Names.Id.t * Univ.Level.t) list * Univ.UContext.t
-    val nf_constraints : evar_map -> evar_map
-    val from_ctx : UState.t -> evar_map
-
-    val meta_list : evar_map -> (Constr.metavariable * clbinding) list
-
-    val meta_defined : evar_map -> Constr.metavariable -> bool
-
-    val meta_name : evar_map -> Constr.metavariable -> Names.Name.t
-
-    module MonadR :
-    sig
-      module List :
-      sig
-        val map_right : ('a -> evar_map -> evar_map * 'b) -> 'a list -> evar_map -> evar_map * 'b list
-      end
-    end
-
-  type 'a sigma = {
-        it : 'a ;
-        sigma : evar_map
-      }
-
-  val sig_sig : 'a sigma -> evar_map
-
-  val sig_it  : 'a sigma -> 'a
-
-  type 'a in_evar_universe_context = 'a * UState.t
-
-  val univ_flexible : rigid
-  val univ_flexible_alg : rigid
-  val empty_evar_universe_context : UState.t
-  val union_evar_universe_context : UState.t -> UState.t -> UState.t
-  val merge_universe_context : evar_map -> UState.t -> evar_map
-
-  type unsolvability_explanation =
-    | SeveralInstancesFound of int
-
-  (** Return {i ids} of all {i evars} that occur in a given term. *)
-  val evars_of_term : Constr.t -> Evar.Set.t
-
-  val evar_universe_context_of : Univ.ContextSet.t -> UState.t
-  [@@ocaml.deprecated "alias of API.UState.of_context_set"]
-
-  val evar_context_universe_context : UState.t -> Univ.UContext.t
-  [@@ocaml.deprecated "alias of API.UState.context"]
-
-  type evar_universe_context = UState.t
-  [@@ocaml.deprecated "alias of API.UState.t"]
-
-  val existential_opt_value : evar_map -> Term.existential -> Constr.t option
-  val existential_value : evar_map -> Term.existential -> Constr.t
-
-  exception NotInstantiatedEvar
-
-  val fresh_sort_in_family : ?loc:Loc.t -> ?rigid:rigid -> Environ.env -> evar_map -> Sorts.family -> evar_map * Sorts.t
-end
-
-(* XXX: moved from intf *)
-module Constrexpr :
-sig
-
-  type binder_kind =
-                   | Default of Decl_kinds.binding_kind
-                   | Generalized of Decl_kinds.binding_kind * Decl_kinds.binding_kind * bool
-
-  type explicitation =
-                     | ExplByPos of int * Names.Id.t option
-                     | ExplByName of Names.Id.t
-  type sign = bool
-  type raw_natural_number = string
-  type prim_token =
-    | Numeral of raw_natural_number * sign
-    | String of string
-
-  type notation = string
-  type instance_expr = Misctypes.glob_level list
-  type proj_flag = int option
-  type abstraction_kind =
-    | AbsLambda
-    | AbsPi
-
-  type cases_pattern_expr_r =
-    | CPatAlias of cases_pattern_expr * Names.Id.t
-    | CPatCstr  of Libnames.reference
-      * cases_pattern_expr list option * cases_pattern_expr list
-    (** [CPatCstr (_, c, Some l1, l2)] represents (@c l1) l2 *)
-    | CPatAtom of Libnames.reference option
-    | CPatOr   of cases_pattern_expr list
-    | CPatNotation of notation * cases_pattern_notation_substitution
-                      * cases_pattern_expr list
-    | CPatPrim   of prim_token
-    | CPatRecord of (Libnames.reference * cases_pattern_expr) list
-    | CPatDelimiters of string * cases_pattern_expr
-    | CPatCast   of cases_pattern_expr * constr_expr
-   and cases_pattern_expr = cases_pattern_expr_r CAst.t
-
-   and cases_pattern_notation_substitution =
-     cases_pattern_expr list * cases_pattern_expr list list
-
-   and constr_expr_r =
-     | CRef     of Libnames.reference * instance_expr option
-     | CFix     of Names.Id.t Loc.located * fix_expr list
-     | CCoFix   of Names.Id.t Loc.located * cofix_expr list
-     | CProdN   of binder_expr list * constr_expr
-     | CLambdaN of binder_expr list * constr_expr
-     | CLetIn   of Names.Name.t Loc.located * constr_expr * constr_expr option * constr_expr
-     | CAppExpl of (proj_flag * Libnames.reference * instance_expr option) * constr_expr list
-     | CApp     of (proj_flag * constr_expr) *
-                   (constr_expr * explicitation Loc.located option) list
-     | CRecord  of (Libnames.reference * constr_expr) list
-     | CCases of Term.case_style
-               * constr_expr option
-               * case_expr list
-               * branch_expr list
-     | CLetTuple of Names.Name.t Loc.located list * (Names.Name.t Loc.located option * constr_expr option) *
-                    constr_expr * constr_expr
-     | CIf of constr_expr * (Names.Name.t Loc.located option * constr_expr option)
-            * constr_expr * constr_expr
-     | CHole   of Evar_kinds.t option * Misctypes.intro_pattern_naming_expr * Genarg.raw_generic_argument option
-     | CPatVar of Names.Id.t
-     | CEvar   of Names.Id.t * (Names.Id.t * constr_expr) list
-     | CSort   of Misctypes.glob_sort
-     | CCast   of constr_expr * constr_expr Misctypes.cast_type
-     | CNotation of notation * constr_notation_substitution
-     | CGeneralization of Decl_kinds.binding_kind * abstraction_kind option * constr_expr
-     | CPrim of prim_token
-     | CDelimiters of string * constr_expr
-   and constr_expr = constr_expr_r CAst.t
-
-   and case_expr = constr_expr * Names.Name.t Loc.located option * cases_pattern_expr option
-
-   and branch_expr =
-     (cases_pattern_expr list Loc.located list * constr_expr) Loc.located
-
-   and binder_expr =
-     Names.Name.t Loc.located list * binder_kind * constr_expr
-
-   and fix_expr =
-     Names.Id.t Loc.located * (Names.Id.t Loc.located option * recursion_order_expr) *
-       local_binder_expr list * constr_expr * constr_expr
-
-   and cofix_expr =
-     Names.Id.t Loc.located * local_binder_expr list * constr_expr * constr_expr
-
-   and recursion_order_expr =
-                            | CStructRec
-                              | CWfRec of constr_expr
-                            | CMeasureRec of constr_expr * constr_expr option
-
-   and local_binder_expr =
-     | CLocalAssum   of Names.Name.t Loc.located list * binder_kind * constr_expr
-     | CLocalDef     of Names.Name.t Loc.located * constr_expr * constr_expr option
-     | CLocalPattern of (cases_pattern_expr * constr_expr option) Loc.located
-
-   and constr_notation_substitution =
-     constr_expr list *
-       constr_expr list list *
-         local_binder_expr list list
-
-  type typeclass_constraint = (Names.Name.t Loc.located * Names.Id.t Loc.located list option) * Decl_kinds.binding_kind * constr_expr
-  type constr_pattern_expr = constr_expr
-end
-
-module Genredexpr :
-sig
-
-  (** The parsing produces initially a list of [red_atom] *)
-  type 'a red_atom =
-    | FBeta
-    | FMatch
-    | FFix
-    | FCofix
-    | FZeta
-    | FConst of 'a list
-    | FDeltaBut of 'a list
-
-  (** This list of atoms is immediately converted to a [glob_red_flag] *)
-  type 'a glob_red_flag = {
-      rBeta : bool;
-      rMatch : bool;
-      rFix : bool;
-      rCofix : bool;
-      rZeta : bool;
-      rDelta : bool; (** true = delta all but rConst; false = delta only on rConst*)
-      rConst : 'a list
-    }
-
-  (** Generic kinds of reductions *)
-  type ('a,'b,'c) red_expr_gen =
-    | Red of bool
-    | Hnf
-    | Simpl of 'b glob_red_flag*('b,'c) Util.union Locus.with_occurrences option
-    | Cbv of 'b glob_red_flag
-    | Cbn of 'b glob_red_flag
-    | Lazy of 'b glob_red_flag
-    | Unfold of 'b Locus.with_occurrences list
-    | Fold of 'a list
-    | Pattern of 'a Locus.with_occurrences list
-    | ExtraRedExpr of string
-    | CbvVm of ('b,'c) Util.union Locus.with_occurrences option
-    | CbvNative of ('b,'c) Util.union Locus.with_occurrences option
-
-  type ('a,'b,'c) may_eval =
-    | ConstrTerm of 'a
-    | ConstrEval of ('a,'b,'c) red_expr_gen * 'a
-    | ConstrContext of Names.Id.t Loc.located * 'a
-    | ConstrTypeOf of 'a
-
-  type r_trm = Constrexpr.constr_expr
-  type r_pat = Constrexpr.constr_pattern_expr
-  type r_cst = Libnames.reference Misctypes.or_by_notation
-  type raw_red_expr = (r_trm, r_cst, r_pat) red_expr_gen
-end
-
-(* XXX: end of moved from intf *)
-
-module EConstr :
-sig
-  type t
-  type constr = t
-  type types = t
-  type unsafe_judgment = (constr, types) Environ.punsafe_judgment
-  type named_declaration = (constr, types) Context.Named.Declaration.pt
-  type named_context = (constr, types) Context.Named.pt
-  type rel_context = (constr, types) Context.Rel.pt
-  type rel_declaration = (constr, types) Context.Rel.Declaration.pt
-  type existential = constr Constr.pexistential
-  module ESorts :
-  sig
-    type t
-    (** Type of sorts up-to universe unification. Essentially a wrapper around
-      Sorts.t so that normalization is ensured statically. *)
-
-    val make : Sorts.t -> t
-    (** Turn a sort into an up-to sort. *)
-
-    val kind : Evd.evar_map -> t -> Sorts.t
-    (** Returns the view into the current sort. Note that the kind of a variable
-        may change if the unification state of the evar map changes. *)
-
-  end
-
-  module EInstance :
-  sig
-    type t
-    (** Type of universe instances up-to universe unification. Similar to
-      {ESorts.t} for {Univ.Instance.t}. *)
-
-    val make : Univ.Instance.t -> t
-    val kind : Evd.evar_map -> t -> Univ.Instance.t
-    val empty : t
-    val is_empty : t -> bool
-  end
-
-  val of_constr : Constr.t -> constr
-
-  val kind : Evd.evar_map -> constr -> (constr, constr, ESorts.t, EInstance.t) Constr.kind_of_term
-
-  val mkArrow : constr -> constr -> constr
-  val mkInd : Names.inductive -> t
-  val mkProp : constr
-  val mkProd : Names.Name.t * constr * constr -> constr
-  val mkRel : int -> constr
-  val mkSort : Sorts.t -> constr
-  val mkVar : Names.Id.t -> constr
-  val mkLambda : Names.Name.t * constr * constr -> constr
-  val mkLambda_or_LetIn : rel_declaration -> constr -> constr
-  val mkApp : constr * constr array -> constr
-  val mkEvar : constr Constr.pexistential -> constr
-
-  val mkMeta : Constr.metavariable -> constr
-
-  val mkConstructU : Names.constructor * EInstance.t -> constr
-  val mkLetIn : Names.Name.t * constr * constr * constr -> constr
-  val mkProd_or_LetIn : rel_declaration -> constr -> constr
-  val mkCast : constr * Constr.cast_kind * constr -> constr
-  val mkNamedLambda : Names.Id.t -> types -> constr -> constr
-  val mkNamedProd : Names.Id.t -> types -> types -> types
-
-  val isCast : Evd.evar_map -> t -> bool
-  val isEvar : Evd.evar_map -> constr -> bool
-  val isInd  : Evd.evar_map -> constr -> bool
-  val isRel : Evd.evar_map -> constr -> bool
-  val isSort : Evd.evar_map -> constr -> bool
-  val isVar : Evd.evar_map -> constr -> bool
-  val isConst : Evd.evar_map -> constr -> bool
-  val isConstruct : Evd.evar_map -> constr -> bool
-
-  val destInd : Evd.evar_map -> constr -> Names.inductive * EInstance.t
-  val destVar : Evd.evar_map -> constr -> Names.Id.t
-  val destEvar : Evd.evar_map -> constr -> constr Constr.pexistential
-  val destRel : Evd.evar_map -> constr -> int
-  val destProd : Evd.evar_map -> constr -> Names.Name.t * types * types
-  val destLambda : Evd.evar_map -> constr -> Names.Name.t * types * constr
-  val destApp : Evd.evar_map -> constr -> constr * constr array
-  val destConst : Evd.evar_map -> constr -> Names.Constant.t * EInstance.t
-  val destConstruct : Evd.evar_map -> constr -> Names.constructor * EInstance.t
-  val destFix : Evd.evar_map -> t -> (t, t) Constr.pfixpoint
-  val destCast : Evd.evar_map -> t -> t * Constr.cast_kind * t
-
-  val mkConstruct : Names.constructor -> constr
-
-  val compose_lam : (Names.Name.t * constr) list -> constr -> constr
-
-  val decompose_lam : Evd.evar_map -> constr -> (Names.Name.t * constr) list * constr
-  val decompose_lam_n_assum : Evd.evar_map -> int -> constr -> rel_context * constr
-  val decompose_app : Evd.evar_map -> constr -> constr * constr list
-  val decompose_prod : Evd.evar_map -> constr -> (Names.Name.t * constr) list * constr
-  val decompose_prod_assum : Evd.evar_map -> constr -> rel_context * constr
-
-  val applist : constr * constr list -> constr
-
-  val to_constr : Evd.evar_map -> constr -> Constr.t
-
-  val push_rel : rel_declaration -> Environ.env -> Environ.env
-
-  module Unsafe :
-  sig
-    val to_constr : constr -> Constr.t
-
-    val to_rel_decl : (constr, types) Context.Rel.Declaration.pt -> (Constr.constr, Constr.types) Context.Rel.Declaration.pt
-
-    (** Physical identity. Does not care for defined evars. *)
-
-    val to_named_decl : (constr, types) Context.Named.Declaration.pt -> (Constr.constr, Constr.types) Context.Named.Declaration.pt
-
-    val to_instance : EInstance.t -> Univ.Instance.t
-  end
-
-  module Vars :
-  sig
-    val substnl : t list -> int -> t -> t
-    val noccurn : Evd.evar_map -> int -> constr -> bool
-    val closed0 : Evd.evar_map -> constr -> bool
-    val subst1 : constr -> constr -> constr
-    val substl : constr list -> constr -> constr
-    val lift : int -> constr -> constr
-    val liftn : int -> int -> t -> t
-    val subst_var : Names.Id.t -> t -> t
-    val subst_vars : Names.Id.t list -> t -> t
-  end
-
-  val fresh_global :
-    ?loc:Loc.t -> ?rigid:UState.rigid -> ?names:Univ.Instance.t -> Environ.env ->
-    Evd.evar_map -> Globnames.global_reference -> Evd.evar_map * t
-
-  val of_named_decl : (Constr.t, Constr.types) Context.Named.Declaration.pt -> (constr, types) Context.Named.Declaration.pt
-  val of_rel_decl : (Constr.t, Constr.types) Context.Rel.Declaration.pt -> (constr, types) Context.Rel.Declaration.pt
-  val kind_of_type : Evd.evar_map -> constr -> (constr, constr) Term.kind_of_type
-  val to_lambda : Evd.evar_map -> int -> constr -> constr
-  val it_mkLambda_or_LetIn : constr -> rel_context -> constr
-  val push_rel_context : rel_context -> Environ.env -> Environ.env
-  val eq_constr : Evd.evar_map -> constr -> constr -> bool
-  val iter_with_binders : Evd.evar_map -> ('a -> 'a) -> ('a -> constr -> unit) -> 'a -> constr -> unit
-  val fold : Evd.evar_map -> ('a -> constr -> 'a) -> 'a -> constr -> 'a
-  val existential_type : Evd.evar_map -> existential -> types
-  val iter : Evd.evar_map -> (constr -> unit) -> constr -> unit
-  val eq_constr_universes : Evd.evar_map -> constr -> constr -> Universes.universe_constraints option
-  val eq_constr_nounivs : Evd.evar_map -> constr -> constr -> bool
-  val compare_constr : Evd.evar_map -> (constr -> constr -> bool) -> constr -> constr -> bool
-  val isApp : Evd.evar_map -> constr -> bool
-  val it_mkProd_or_LetIn : constr -> rel_context -> constr
-  val push_named : named_declaration -> Environ.env -> Environ.env
-  val destCase : Evd.evar_map -> constr -> Constr.case_info * constr * constr * constr array
-  val decompose_lam_assum : Evd.evar_map -> constr -> rel_context * constr
-  val mkConst : Names.Constant.t -> constr
-  val mkCase : Constr.case_info * constr * constr * constr array -> constr
-  val named_context : Environ.env -> named_context
-  val val_of_named_context : named_context -> Environ.named_context_val
-  val mkFix : (t, t) Constr.pfixpoint -> t
-  val decompose_prod_n_assum : Evd.evar_map -> int -> t -> rel_context * t
-  val isMeta : Evd.evar_map -> t -> bool
-
-  val destMeta : Evd.evar_map -> t -> Constr.metavariable
-
-  val map_with_binders : Evd.evar_map -> ('a -> 'a) -> ('a -> t -> t) -> 'a -> t -> t
-  val mkNamedLetIn : Names.Id.t -> constr -> types -> constr -> constr
-  val map : Evd.evar_map -> (t -> t) -> t -> t
-  val mkConstU : Names.Constant.t * EInstance.t -> t
-  val isProd : Evd.evar_map -> t -> bool
-  val mkConstructUi : (Names.inductive * EInstance.t) * int -> t
-  val isLambda : Evd.evar_map -> t -> bool
-end
-
-(* XXX: Located manually from intf *)
-module Pattern :
-sig
-
-  type case_info_pattern =
-    { cip_style : Misctypes.case_style;
-      cip_ind : Names.inductive option;
-      cip_ind_tags : bool list option; (** indicates LetIn/Lambda in arity *)
-      cip_extensible : bool (** does this match end with _ => _ ? *) }
-
-  type constr_pattern =
-    | PRef of Globnames.global_reference
-    | PVar of Names.Id.t
-    | PEvar of Evar.t * constr_pattern array
-    | PRel of int
-    | PApp of constr_pattern * constr_pattern array
-    | PSoApp of Names.Id.t * constr_pattern list
-    | PProj of Names.Projection.t * constr_pattern
-    | PLambda of Names.Name.t * constr_pattern * constr_pattern
-    | PProd of Names.Name.t * constr_pattern * constr_pattern
-    | PLetIn of Names.Name.t * constr_pattern * constr_pattern option * constr_pattern
-    | PSort of Misctypes.glob_sort
-    | PMeta of Names.Id.t option
-    | PIf of constr_pattern * constr_pattern * constr_pattern
-    | PCase of case_info_pattern * constr_pattern * constr_pattern *
-                 (int * bool list * constr_pattern) list (** index of constructor, nb of args *)
-    | PFix of Term.fixpoint
-    | PCoFix of Term.cofixpoint
-
-  type constr_under_binders = Names.Id.t list * EConstr.constr
-
-  (** Types of substitutions with or w/o bound variables *)
-
-  type patvar_map = EConstr.constr Names.Id.Map.t
-  type extended_patvar_map = constr_under_binders Names.Id.Map.t
-
-end
-
-module Namegen :
-sig
-  (** *)
-
-  (** [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 : Names.Id.t -> Names.Id.t list -> Names.Id.t
-
-  val hdchar : Environ.env -> Evd.evar_map -> EConstr.types -> string
-  val id_of_name_using_hdchar : Environ.env -> Evd.evar_map -> EConstr.types -> Names.Name.t -> Names.Id.t
-  val next_ident_away_in_goal : Names.Id.t -> Names.Id.t list -> Names.Id.t
-  val default_dependent_ident : Names.Id.t
-  val next_global_ident_away : Names.Id.t -> Names.Id.t list -> Names.Id.t
-  val rename_bound_vars_as_displayed :
-    Evd.evar_map -> Names.Id.t list -> Names.Name.t list -> EConstr.types -> EConstr.types
-end
-
-module Termops :
-sig
-  val it_mkLambda_or_LetIn : Constr.t -> Context.Rel.t -> Constr.t
-  val local_occur_var : Evd.evar_map -> Names.Id.t -> EConstr.constr -> bool
-  val occur_var : Environ.env -> Evd.evar_map -> Names.Id.t -> EConstr.constr -> bool
-  val pr_evar_info : Evd.evar_info -> Pp.t
-
-  val print_constr : EConstr.constr -> Pp.t
-
-  (** [dependent m t] tests whether [m] is a subterm of [t] *)
-  val dependent : Evd.evar_map -> EConstr.constr -> EConstr.constr -> bool
-
-  (** [pop c] returns a copy of [c] with decremented De Bruijn indexes *)
-  val pop : EConstr.constr -> EConstr.constr
-
-  (** Does a given term contain an existential variable? *)
-  val occur_existential : Evd.evar_map -> EConstr.constr -> bool
-
-  (** [map_constr_with_binders_left_to_right g f acc c] maps [f updated_acc] on all the immediate subterms of [c].
-      {ul {- if a given immediate subterm of [c] is not below a binder, then [updated_acc] is the same as [acc].}
-          {- if a given immediate subterm of [c] is below a binder [b], then [updated_acc] is computed as [g b acc].}} *)
-  val map_constr_with_binders_left_to_right :
-    Evd.evar_map -> (EConstr.rel_declaration -> 'a -> 'a) -> ('a -> EConstr.constr -> EConstr.constr) -> 'a -> EConstr.constr -> EConstr.constr
-
-  (** Remove the outer-most {!Term.kind_of_term.Cast} from a given term. *)
-  val strip_outer_cast : Evd.evar_map -> EConstr.constr -> EConstr.constr
-
-  (** [nb_lam] ⟦[fun (x1:t1)...(xn:tn) => c]⟧ where [c] is not an abstraction gives [n].
-      Casts are ignored. *)
-  val nb_lam : Evd.evar_map -> EConstr.constr -> int
-
-  (** [push_rel_assum env_assumtion env] adds a given {i env assumption} to the {i env context} of a given {i environment}. *)
-  val push_rel_assum : Names.Name.t * EConstr.types -> Environ.env -> Environ.env
-
-  (** [push_rels_assum env_assumptions env] adds given {i env assumptions} to the {i env context} of a given {i environment}. *)
-  val push_rels_assum : (Names.Name.t * Term.types) list -> Environ.env -> Environ.env
-
-  type meta_value_map = (Constr.metavariable * Constr.t) list
-
-  val last_arg : Evd.evar_map -> EConstr.constr -> EConstr.constr
-  val assums_of_rel_context : ('c, 't) Context.Rel.pt -> (Names.Name.t * 't) list
-  val prod_applist : Evd.evar_map -> EConstr.constr -> EConstr.constr list -> EConstr.constr
-  val nb_prod : Evd.evar_map -> EConstr.constr -> int
-  val is_section_variable : Names.Id.t -> bool
-  val ids_of_rel_context : ('c, 't) Context.Rel.pt -> Names.Id.t list
-  val subst_term : Evd.evar_map -> EConstr.constr -> EConstr.constr -> EConstr.constr
-  val global_vars_set_of_decl : Environ.env -> Evd.evar_map -> EConstr.named_declaration -> Names.Id.Set.t
-  val vars_of_env: Environ.env -> Names.Id.Set.t
-  val ids_of_named_context : ('c, 't) Context.Named.pt -> Names.Id.t list
-  val ids_of_context : Environ.env -> Names.Id.t list
-  val global_of_constr : Evd.evar_map -> EConstr.constr -> Globnames.global_reference * EConstr.EInstance.t
-  val print_named_context : Environ.env -> Pp.t
-  val print_constr_env : Environ.env -> Evd.evar_map -> EConstr.constr -> Pp.t
-  val clear_named_body : Names.Id.t -> Environ.env -> Environ.env
-  val is_Prop : Evd.evar_map -> EConstr.constr -> bool
-  val is_global : Evd.evar_map -> Globnames.global_reference -> EConstr.constr -> bool
-
-  val eq_constr : Evd.evar_map -> EConstr.constr -> EConstr.constr -> bool
-
-  val occur_var_in_decl :
-    Environ.env -> Evd.evar_map ->
-    Names.Id.t -> EConstr.named_declaration -> bool
-
-  val subst_meta : meta_value_map -> Constr.t -> Constr.t
-
-  val free_rels : Evd.evar_map -> EConstr.constr -> Int.Set.t
-
-  val occur_term : Evd.evar_map -> EConstr.constr -> EConstr.constr -> bool
-  [@@ocaml.deprecated "alias of API.Termops.dependent"]
-
-  val replace_term : Evd.evar_map -> EConstr.constr -> EConstr.constr -> EConstr.constr -> EConstr.constr
-  val map_named_decl : ('a -> 'b) -> ('a, 'a) Context.Named.Declaration.pt -> ('b, 'b) Context.Named.Declaration.pt
-  val map_rel_decl : ('a -> 'b) -> ('a, 'a) Context.Rel.Declaration.pt -> ('b, 'b) Context.Rel.Declaration.pt
-  val pr_metaset : Evd.Metaset.t -> Pp.t
-  val pr_evar_map : ?with_univs:bool -> int option -> Evd.evar_map -> Pp.t
-  val pr_evar_universe_context : UState.t -> Pp.t
-end
-
-module Proofview_monad :
-sig
-  type lazy_msg = unit -> Pp.t
-  module Info :
-  sig
-    type tree
-  end
-end
-
-module Evarutil :
-sig
-  val e_new_global : Evd.evar_map ref -> Globnames.global_reference -> EConstr.constr
-
-  val nf_evars_and_universes : Evd.evar_map -> Evd.evar_map * (Constr.t -> Constr.t)
-  val nf_evar : Evd.evar_map -> EConstr.constr -> EConstr.constr
-  val nf_evar_info : Evd.evar_map -> Evd.evar_info -> Evd.evar_info
-
-  val mk_new_meta : unit -> EConstr.constr
-
-  (** [new_meta] is a generator of unique meta variables *)
-  val new_meta : unit -> Constr.metavariable
-
-  val new_Type : ?rigid:Evd.rigid -> Environ.env -> Evd.evar_map -> Evd.evar_map * EConstr.constr
-  val new_global : Evd.evar_map -> Globnames.global_reference -> Evd.evar_map * EConstr.constr
-
-  val new_evar :
-    Environ.env -> Evd.evar_map -> ?src:Evar_kinds.t Loc.located -> ?filter:Evd.Filter.t ->
-    ?candidates:EConstr.constr list -> ?store:Evd.Store.t ->
-    ?naming:Misctypes.intro_pattern_naming_expr ->
-    ?principal:bool -> EConstr.types -> Evd.evar_map * EConstr.constr
-
-  val new_evar_instance :
-    Environ.named_context_val -> Evd.evar_map -> EConstr.types ->
-    ?src:Evar_kinds.t Loc.located -> ?filter:Evd.Filter.t -> ?candidates:EConstr.constr list ->
-    ?store:Evd.Store.t -> ?naming:Misctypes.intro_pattern_naming_expr ->
-    ?principal:bool ->
-    EConstr.constr list -> Evd.evar_map * EConstr.constr
-
-  val clear_hyps_in_evi : Environ.env -> Evd.evar_map ref -> Environ.named_context_val ->
-                          EConstr.types -> Names.Id.Set.t -> Environ.named_context_val * EConstr.types
-
-  type clear_dependency_error =
-    | OccurHypInSimpleClause of Names.Id.t option
-    | EvarTypingBreak of Constr.existential
-
-  exception ClearDependencyError of Names.Id.t * clear_dependency_error
-  val undefined_evars_of_term : Evd.evar_map -> EConstr.constr -> Evar.Set.t
-  val e_new_evar :
-      Environ.env -> Evd.evar_map ref -> ?src:Evar_kinds.t Loc.located -> ?filter:Evd.Filter.t ->
-      ?candidates:EConstr.constr list -> ?store:Evd.Store.t ->
-      ?naming:Misctypes.intro_pattern_naming_expr ->
-      ?principal:bool -> EConstr.types -> EConstr.constr
-  val new_type_evar :
-    Environ.env -> Evd.evar_map -> ?src:Evar_kinds.t Loc.located -> ?filter:Evd.Filter.t ->
-    ?naming:Misctypes.intro_pattern_naming_expr -> ?principal:bool -> Evd.rigid ->
-    Evd.evar_map * (EConstr.constr * Sorts.t)
-  val nf_evars_universes : Evd.evar_map -> Constr.t -> Constr.t
-  val safe_evar_value : Evd.evar_map -> Term.existential -> Constr.t option
-  val evd_comb1 : (Evd.evar_map -> 'b -> Evd.evar_map * 'a) -> Evd.evar_map ref -> 'b -> 'a
-end
-
-module Proofview :
-sig
-  type proofview
-  type entry
-  type +'a tactic
-  type telescope =
-    | TNil of Evd.evar_map
-    | TCons of Environ.env * Evd.evar_map * EConstr.types * (Evd.evar_map -> EConstr.constr -> telescope)
-
-  module NonLogical :
-  sig
-    type +'a t
-    val make : (unit -> 'a) -> 'a t
-    val return : 'a -> 'a t
-    val ( >> ) : unit t -> 'a t -> 'a t
-    val ( >>= ) : 'a t -> ('a -> 'b t) -> 'b t
-    val print_char : char -> unit t
-    val print_debug : Pp.t -> unit t
-    val print_warning : Pp.t -> unit t
-    val print_notice : Pp.t -> unit t
-    val print_info : Pp.t -> unit t
-    val run : 'a t -> 'a
-    type 'a ref
-    val ref : 'a -> 'a ref t
-    val ( := ) : 'a ref -> 'a -> unit t
-    val ( ! ) : 'a ref -> 'a t
-    val raise : ?info:Exninfo.info -> exn -> 'a t
-    val catch : 'a t -> (Exninfo.iexn -> 'a t) -> 'a t
-    val read_line : string t
-  end
-  val proofview : proofview -> Evd.evar list * Evd.evar_map
-  val cycle : int -> unit tactic
-  val swap : int -> int -> unit tactic
-  val revgoals : unit tactic
-  val give_up : unit tactic
-  val init : Evd.evar_map -> (Environ.env * EConstr.types) list -> entry * proofview
-  val shelve : unit tactic
-  val tclZERO : ?info:Exninfo.info -> exn -> 'a tactic
-  val tclUNIT : 'a -> 'a tactic
-  val tclBIND : 'a tactic -> ('a -> 'b tactic) -> 'b tactic
-  val tclORELSE : 'a tactic -> (Util.iexn -> 'a tactic) -> 'a tactic
-  val tclFOCUS : int -> int -> 'a tactic -> 'a tactic
-  val tclEVARMAP : Evd.evar_map tactic
-  val tclTHEN : unit tactic -> 'a tactic -> 'a tactic
-  val tclLIFT : 'a NonLogical.t -> 'a tactic
-  val tclOR : 'a tactic -> (Exninfo.iexn -> 'a tactic) -> 'a tactic
-  val tclIFCATCH : 'a tactic -> ('a -> 'b tactic) -> (Exninfo.iexn -> 'b tactic) -> 'b tactic
-  val tclINDEPENDENT : unit tactic -> unit tactic
-  val tclDISPATCH : unit tactic list -> unit tactic
-  val tclEXTEND : unit tactic list -> unit tactic -> unit tactic list -> unit tactic
-  val tclBREAK : (Exninfo.iexn -> Exninfo.iexn option) -> 'a tactic -> 'a tactic
-  val tclENV : Environ.env tactic
-  val tclONCE : 'a tactic -> 'a tactic
-  val tclPROGRESS : 'a tactic -> 'a tactic
-  val shelve_unifiable : unit tactic
-  val apply : Environ.env -> 'a tactic -> proofview -> 'a
-                                                     * proofview
-                                                     * (bool * Evd.evar list * Evd.evar list)
-                                                     * Proofview_monad.Info.tree
-  val numgoals : int tactic
-  val with_shelf : 'a tactic -> (Evd.evar list * 'a) tactic
-
-  module Unsafe :
-  sig
-    val tclEVARS : Evd.evar_map -> unit tactic
-
-    val tclGETGOALS : Evd.evar list tactic
-
-    val tclSETGOALS : Evd.evar list -> unit tactic
-
-    val tclNEWGOALS : Evd.evar list -> unit tactic
-  end
-
-  module Goal :
-  sig
-    type 'a t
-    val enter : ([ `LZ ] t -> unit tactic) -> unit tactic
-    val hyps : 'a t -> EConstr.named_context
-    val nf_enter : ([ `NF ] t -> unit tactic) -> unit tactic
-    val enter_one : ([ `LZ ] t -> 'a tactic) -> 'a tactic
-    val concl : 'a t -> EConstr.constr
-    val sigma : 'a t -> Evd.evar_map
-    val goal : [ `NF ] t -> Evar.t
-    val env : 'a t -> Environ.env
-    val assume : 'a t -> [ `NF ] t
-  end
-
-  module Notations :
-  sig
-    val (>>=) : 'a tactic -> ('a -> 'b tactic) -> 'b tactic
-    val (<*>) : unit tactic -> 'a tactic -> 'a tactic
-    val (<+>) : 'a tactic -> 'a tactic -> 'a tactic
-  end
-  module V82 :
-  sig
-    type tac = Evar.t Evd.sigma -> Evar.t list Evd.sigma
-
-    val tactic : tac -> unit tactic
-
-    val of_tactic : 'a tactic -> tac
-
-    val nf_evar_goals : unit tactic
-
-    val wrap_exceptions : (unit -> 'a tactic) -> 'a tactic
-
-    val catchable_exception : exn -> bool
-  end
-  module Trace :
-  sig
-    val name_tactic : Proofview_monad.lazy_msg -> 'a tactic -> 'a tactic
-    val log : Proofview_monad.lazy_msg -> unit tactic
-  end
-end
-
-module Ftactic :
-sig
-  type +'a focus
-  type +'a t = 'a focus Proofview.tactic
-  val return : 'a -> 'a t
-  val run : 'a t -> ('a -> unit Proofview.tactic) -> unit Proofview.tactic
-  val enter : ([ `LZ ] Proofview.Goal.t -> 'a t) -> 'a t
-  val nf_enter : ([ `NF ] Proofview.Goal.t -> 'a t) -> 'a t
-  val bind : 'a t -> ('a -> 'b t) -> 'b t
-  val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
-  val lift : 'a Proofview.tactic -> 'a t
-  val with_env : 'a t -> (Environ.env * 'a) t
-  module List :
-  sig
-    val map : ('a -> 'b t) -> 'a list -> 'b list t
-    val map_right : ('a -> 'b t) -> 'a list -> 'b list t
-  end
-  module Notations :
-  sig
-    val (>>=) : 'a t -> ('a -> 'b t) -> 'b t
-    val (<*>) : unit t -> 'a t -> 'a t
-  end
-end
-
-module Geninterp :
-sig
-  module Val :
-  sig
-    type 'a typ
-    type t = Dyn : 'a typ * 'a -> t
-    type 'a tag =
-                | Base : 'a typ -> 'a tag
-                | List : 'a tag -> 'a list tag
-                | Opt : 'a tag -> 'a option tag
-                | Pair : 'a tag * 'b tag -> ('a * 'b) tag
-    val create : string -> 'a typ
-    val pr : 'a typ -> Pp.t
-    val eq : 'a typ -> 'b typ -> ('a, 'b) CSig.eq option
-    val typ_list : t list typ
-    val typ_opt : t option typ
-    val typ_pair : (t * t) typ
-    val repr : 'a typ -> string
-    val inject : 'a tag -> 'a -> t
-  end
-  module TacStore :
-  sig
-    type t
-    type 'a field
-    val empty : t
-    val field : unit -> 'a field
-    val get : t -> 'a field -> 'a option
-    val set : t -> 'a field -> 'a -> t
-    val remove : t -> 'a field -> t
-    val merge : t -> t -> t
-  end
-  type interp_sign = {
-    lfun : Val.t Names.Id.Map.t;
-    extra : TacStore.t
-  }
-  type ('glb, 'top) interp_fun = interp_sign -> 'glb -> 'top Ftactic.t
-  val register_interp0 :
-    ('raw, 'glb, 'top) Genarg.genarg_type -> ('glb, Val.t) interp_fun -> unit
-  val register_val0 : ('raw, 'glb, 'top) Genarg.genarg_type -> 'top Val.tag option -> unit
-  val val_tag : 'a Genarg.typed_abstract_argument_type -> 'a Val.tag
-  val interp : ('raw, 'glb, 'top) Genarg.genarg_type -> ('glb, Val.t) interp_fun
-end
-
-(* XXX: Located manually from intf *)
-module Glob_term :
-sig
-  type cases_pattern_r =
-    | PatVar  of Names.Name.t
-    | PatCstr of Names.constructor * cases_pattern list * Names.Name.t
-  and cases_pattern = cases_pattern_r CAst.t
-  type existential_name = Names.Id.t
-  type glob_constr_r =
-    | GRef of Globnames.global_reference * Misctypes.glob_level list option
-        (** An identifier that represents a reference to an object defined
-            either in the (global) environment or in the (local) context. *)
-    | GVar of Names.Id.t
-        (** An identifier that cannot be regarded as "GRef".
-            Bound variables are typically represented this way. *)
-    | GEvar   of existential_name * (Names.Id.t * glob_constr) list
-    | GPatVar of Evar_kinds.matching_var_kind
-    | GApp    of glob_constr * glob_constr list
-    | GLambda of Names.Name.t * Decl_kinds.binding_kind *  glob_constr * glob_constr
-    | GProd   of Names.Name.t * Decl_kinds.binding_kind * glob_constr * glob_constr
-    | GLetIn  of Names.Name.t * glob_constr * glob_constr option * glob_constr
-    | GCases  of Term.case_style * glob_constr option * tomatch_tuples * cases_clauses
-    | GLetTuple of Names.Name.t list * (Names.Name.t * glob_constr option) * glob_constr * glob_constr
-    | GIf   of glob_constr * (Names.Name.t * glob_constr option) * glob_constr * glob_constr
-    | GRec  of fix_kind * Names.Id.t array * glob_decl list array *
-               glob_constr array * glob_constr array
-    | GSort of Misctypes.glob_sort
-    | GHole of Evar_kinds.t * Misctypes.intro_pattern_naming_expr * Genarg.glob_generic_argument option
-    | GCast of glob_constr * glob_constr Misctypes.cast_type
-
-   and glob_constr = glob_constr_r CAst.t
-
-   and glob_decl = Names.Name.t * Decl_kinds.binding_kind * glob_constr option * glob_constr
-
-   and fix_recursion_order =
-     | GStructRec
-     | GWfRec of glob_constr
-     | GMeasureRec of glob_constr * glob_constr option
-
-   and fix_kind =
-     | GFix of ((int option * fix_recursion_order) array * int)
-     | GCoFix of int
-
-   and predicate_pattern =
-     Names.Name.t * (Names.inductive * Names.Name.t list) Loc.located option
-
-   and tomatch_tuple = (glob_constr * predicate_pattern)
-
-   and tomatch_tuples = tomatch_tuple list
-
-   and cases_clause = (Names.Id.t list * cases_pattern list * glob_constr) Loc.located
-   and cases_clauses = cases_clause list
-
-   (** A globalised term together with a closure representing the value
-       of its free variables. Intended for use when these variables are taken
-       from the Ltac environment. *)
-
-   type closure = {
-     idents : Names.Id.t Names.Id.Map.t;
-     typed  : Pattern.constr_under_binders Names.Id.Map.t ;
-     untyped: closed_glob_constr Names.Id.Map.t }
-   and closed_glob_constr = {
-     closure: closure;
-     term: glob_constr }
-
-   (** Ltac variable maps *)
-   type var_map = Pattern.constr_under_binders Names.Id.Map.t
-   type uconstr_var_map = closed_glob_constr Names.Id.Map.t
-   type unbound_ltac_var_map = Geninterp.Val.t Names.Id.Map.t
-
-   type ltac_var_map = {
-     ltac_constrs : var_map;
-     (** Ltac variables bound to constrs *)
-     ltac_uconstrs : uconstr_var_map;
-     (** Ltac variables bound to untyped constrs *)
-     ltac_idents: Names.Id.t Names.Id.Map.t;
-     (** Ltac variables bound to identifiers *)
-     ltac_genargs : unbound_ltac_var_map;
-     (** Ltac variables bound to other kinds of arguments *)
-   }
-
-end
-
-module Notation_term :
-sig
-  type scope_name = string
-  type notation_var_instance_type =
-                                  | NtnTypeConstr | NtnTypeOnlyBinder | NtnTypeConstrList | NtnTypeBinderList
-  type tmp_scope_name = scope_name
-
-  type subscopes = tmp_scope_name option * scope_name list
-  type notation_constr =
-                       | NRef of Globnames.global_reference
-                       | NVar of Names.Id.t
-                       | NApp of notation_constr * notation_constr list
-                       | NHole of Evar_kinds.t * Misctypes.intro_pattern_naming_expr * Genarg.glob_generic_argument option
-                       | NList of Names.Id.t * Names.Id.t * notation_constr * notation_constr * bool
-                       | NLambda of Names.Name.t * notation_constr * notation_constr
-                       | NProd of Names.Name.t * notation_constr * notation_constr
-                       | NBinderList of Names.Id.t * Names.Id.t * notation_constr * notation_constr
-                       | NLetIn of Names.Name.t * notation_constr * notation_constr option * notation_constr
-                       | NCases of Term.case_style * notation_constr option *
-                                     (notation_constr * (Names.Name.t * (Names.inductive * Names.Name.t list) option)) list *
-                                       (Glob_term.cases_pattern list * notation_constr) list
-                       | NLetTuple of Names.Name.t list * (Names.Name.t * notation_constr option) *
-                                        notation_constr * notation_constr
-                       | NIf of notation_constr * (Names.Name.t * notation_constr option) *
-                                  notation_constr * notation_constr
-                       | NRec of Glob_term.fix_kind * Names.Id.t array *
-                                   (Names.Name.t * notation_constr option * notation_constr) list array *
-                                     notation_constr array * notation_constr array
-                       | NSort of Misctypes.glob_sort
-                       | NCast of notation_constr * notation_constr Misctypes.cast_type
-  type interpretation = (Names.Id.t * (subscopes * notation_var_instance_type)) list *
-    notation_constr
-  type precedence = int
-  type parenRelation =
-    | L | E | Any | Prec of precedence
-  type tolerability = precedence * parenRelation
-end
-
-module Tactypes :
-sig
-  type glob_constr_and_expr = Glob_term.glob_constr * Constrexpr.constr_expr option
-  type glob_constr_pattern_and_expr = Names.Id.Set.t * glob_constr_and_expr * Pattern.constr_pattern
-  type 'a delayed_open = Environ.env -> Evd.evar_map -> Evd.evar_map * 'a
-  type delayed_open_constr = EConstr.constr delayed_open
-  type delayed_open_constr_with_bindings = EConstr.constr Misctypes.with_bindings delayed_open
-  type intro_pattern = delayed_open_constr Misctypes.intro_pattern_expr Loc.located
-  type intro_patterns = delayed_open_constr Misctypes.intro_pattern_expr Loc.located list
-  type intro_pattern_naming = Misctypes.intro_pattern_naming_expr Loc.located
-  type or_and_intro_pattern = delayed_open_constr Misctypes.or_and_intro_pattern_expr Loc.located
-end
-
-(* XXX: end of moved from intf *)
-
-(************************************************************************)
-(* End of modules from engine/                                          *)
-(************************************************************************)
-
-(************************************************************************)
-(* Modules from pretyping/                                              *)
-(************************************************************************)
-
-module Locusops :
-sig
-  val clause_with_generic_occurrences : 'a Locus.clause_expr -> bool
-  val nowhere : 'a Locus.clause_expr
-  val allHypsAndConcl : 'a Locus.clause_expr
-  val is_nowhere : 'a Locus.clause_expr -> bool
-  val occurrences_map :
-    ('a list -> 'b list) -> 'a Locus.occurrences_gen -> 'b Locus.occurrences_gen
-  val convert_occs : Locus.occurrences -> bool * int list
-  val onConcl : 'a Locus.clause_expr
-  val onHyp : 'a -> 'a Locus.clause_expr
-end
-
-module Pretype_errors :
-sig
-  type unification_error
-  type subterm_unification_error
-
-  type type_error = (EConstr.t, EConstr.types) Type_errors.ptype_error
-
-  type pretype_error =
-    | CantFindCaseType of EConstr.constr
-    | ActualTypeNotCoercible of EConstr.unsafe_judgment * EConstr.types * unification_error
-    | UnifOccurCheck of Evar.t * EConstr.constr
-    | UnsolvableImplicit of Evar.t * Evd.unsolvability_explanation option
-    | CannotUnify of EConstr.constr * EConstr.constr * unification_error option
-    | CannotUnifyLocal of EConstr.constr * EConstr.constr * EConstr.constr
-    | CannotUnifyBindingType of EConstr.constr * EConstr.constr
-    | CannotGeneralize of EConstr.constr
-    | NoOccurrenceFound of EConstr.constr * Names.Id.t option
-    | CannotFindWellTypedAbstraction of EConstr.constr * EConstr.constr list * (Environ.env * type_error) option
-    | WrongAbstractionType of Names.Name.t * EConstr.constr * EConstr.types * EConstr.types
-    | AbstractionOverMeta of Names.Name.t * Names.Name.t
-    | NonLinearUnification of Names.Name.t * EConstr.constr
-    | VarNotFound of Names.Id.t
-    | UnexpectedType of EConstr.constr * EConstr.constr
-    | NotProduct of EConstr.constr
-    | TypingError of type_error
-    | CannotUnifyOccurrences of subterm_unification_error
-    | UnsatisfiableConstraints of
-        (Evar.t * Evar_kinds.t) option * Evar.Set.t option
-
-  exception PretypeError of Environ.env * Evd.evar_map * pretype_error
-  val error_var_not_found : ?loc:Loc.t -> Names.Id.t -> 'b
-  val precatchable_exception : exn -> bool
-end
-
-module Reductionops :
-sig
-  type local_reduction_function = Evd.evar_map -> EConstr.constr -> EConstr.constr
-
-  type reduction_function = Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.constr
-
-  type local_stack_reduction_function =
-    Evd.evar_map -> EConstr.constr -> EConstr.constr * EConstr.constr list
-
-  type e_reduction_function = Environ.env -> Evd.evar_map -> EConstr.constr -> Evd.evar_map * EConstr.constr
-  type state
-
-  val clos_whd_flags : CClosure.RedFlags.reds -> reduction_function
-  val nf_beta : local_reduction_function
-  val nf_betaiota : local_reduction_function
-  val splay_prod : Environ.env ->  Evd.evar_map -> EConstr.constr ->
-                   (Names.Name.t * EConstr.constr) list * EConstr.constr
-  val splay_prod_n : Environ.env ->  Evd.evar_map -> int -> EConstr.constr -> EConstr.rel_context * EConstr.constr
-  val whd_all :  reduction_function
-  val whd_beta : local_reduction_function
-
-  val whd_betaiotazeta : local_reduction_function
-
-  val whd_betaiota_stack : local_stack_reduction_function
-
-  val clos_norm_flags : CClosure.RedFlags.reds -> reduction_function
-  val is_conv : ?reds:Names.transparent_state -> Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.constr -> bool
-  val beta_applist : Evd.evar_map -> EConstr.constr * EConstr.constr list -> EConstr.constr
-  val sort_of_arity : Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.ESorts.t
-  val is_conv_leq : ?reds:Names.transparent_state -> Environ.env ->  Evd.evar_map -> EConstr.constr -> EConstr.constr -> bool
-  val whd_betaiota : local_reduction_function
-  val is_arity : Environ.env ->  Evd.evar_map -> EConstr.constr -> bool
-  val nf_evar : Evd.evar_map -> EConstr.constr -> EConstr.constr
-  val nf_meta : Evd.evar_map -> EConstr.constr -> EConstr.constr
-  val hnf_prod_appvect : Environ.env ->  Evd.evar_map -> EConstr.constr -> EConstr.constr array -> EConstr.constr
-  val pr_state : state -> Pp.t
-  module Stack :
-  sig
-    type 'a t
-    val pr : ('a -> Pp.t) -> 'a t -> Pp.t
-  end
-  module Cst_stack :
-  sig
-    type t
-    val pr : t -> Pp.t
-  end
-end
-
-module Inductiveops :
-sig
-  type inductive_family
-  type inductive_type =
-    | IndType of inductive_family * EConstr.constr list
-  type constructor_summary =
-    {
-      cs_cstr : Term.pconstructor;
-      cs_params : Constr.t list;
-      cs_nargs : int;
-      cs_args : Context.Rel.t;
-      cs_concl_realargs : Constr.t array;
-    }
-
-  val arities_of_constructors : Environ.env -> Term.pinductive -> Term.types array
-  val constructors_nrealargs_env : Environ.env -> Names.inductive -> int array
-  val constructor_nallargs_env : Environ.env -> Names.constructor -> int
-
-  val inductive_nparams : Names.inductive -> int
-
-  val inductive_nparamdecls : Names.inductive -> int
-
-  val type_of_constructors : Environ.env -> Term.pinductive -> Term.types array
-  val find_mrectype : Environ.env -> Evd.evar_map -> EConstr.types -> (Names.inductive * EConstr.EInstance.t) * EConstr.constr list
-  val mis_is_recursive :
-    Names.inductive * Declarations.mutual_inductive_body * Declarations.one_inductive_body -> bool
-  val nconstructors : Names.inductive -> int
-  val find_rectype : Environ.env -> Evd.evar_map -> EConstr.types -> inductive_type
-  val get_constructors : Environ.env -> inductive_family -> constructor_summary array
-  val dest_ind_family : inductive_family -> Names.inductive Term.puniverses * Constr.t list
-  val find_inductive   : Environ.env -> Evd.evar_map -> EConstr.types -> (Names.inductive * EConstr.EInstance.t) * Constr.t list
-  val type_of_inductive : Environ.env -> Term.pinductive -> Term.types
-end
-
-module Impargs :
-sig
-  type implicit_status
-  type implicit_side_condition
-  type implicits_list = implicit_side_condition * implicit_status list
-  type manual_explicitation = Constrexpr.explicitation * (bool * bool * bool)
-  type manual_implicits = manual_explicitation list
-  val is_status_implicit : implicit_status -> bool
-  val name_of_implicit : implicit_status -> Names.Id.t
-  val implicits_of_global : Globnames.global_reference -> implicits_list list
-  val declare_manual_implicits : bool -> Globnames.global_reference -> ?enriching:bool ->
-                                 manual_implicits list -> unit
-  val is_implicit_args : unit -> bool
-  val is_strict_implicit_args : unit -> bool
-  val is_contextual_implicit_args : unit -> bool
-  val make_implicit_args : bool -> unit
-  val make_strict_implicit_args : bool -> unit
-  val make_contextual_implicit_args : bool -> unit
-end
-
-module Retyping :  (* reconstruct the type of a term knowing that it was already typechecked *)
-sig
-  val get_type_of : ?polyprop:bool -> ?lax:bool -> Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.types
-  val get_sort_family_of : ?polyprop:bool -> Environ.env -> Evd.evar_map -> EConstr.types -> Sorts.family
-  val expand_projection : Environ.env -> Evd.evar_map -> Names.Projection.t -> EConstr.constr -> EConstr.constr list -> EConstr.constr
-  val get_sort_of :
-    ?polyprop:bool -> Environ.env -> Evd.evar_map -> EConstr.types -> Sorts.t
-end
-
-module Find_subterm :
-sig
-  val error_invalid_occurrence : int list -> 'a
-end
-
-module Evarsolve :
-sig
-  val refresh_universes :
-    ?status:Evd.rigid -> ?onlyalg:bool -> ?refreshset:bool -> bool option ->
-    Environ.env -> Evd.evar_map -> EConstr.types -> Evd.evar_map * EConstr.types
-end
-
-module Recordops :
-sig
-
-  type cs_pattern =
-                  | Const_cs of Globnames.global_reference
-                  | Prod_cs
-                  | Sort_cs of Sorts.family
-                  | Default_cs
-
-  type obj_typ = {
-        o_DEF : Constr.t;
-        o_CTX : Univ.AUContext.t;
-        o_INJ : int option;      (** position of trivial argument *)
-        o_TABS : Constr.t list;    (** ordered *)
-        o_TPARAMS : Constr.t list; (** ordered *)
-        o_NPARAMS : int;
-        o_TCOMPS : Constr.t list }
-
-  val lookup_projections : Names.inductive -> Names.Constant.t option list
-  val lookup_canonical_conversion : (Globnames.global_reference * cs_pattern) -> Constr.t * obj_typ
-  val find_projection_nparams : Globnames.global_reference -> int
-end
-
-module Evarconv :
-sig
-  val e_conv : Environ.env -> ?ts:Names.transparent_state -> Evd.evar_map ref -> EConstr.constr -> EConstr.constr -> bool
-  val the_conv_x : Environ.env -> ?ts:Names.transparent_state -> EConstr.constr -> EConstr.constr -> Evd.evar_map -> Evd.evar_map
-  val the_conv_x_leq : Environ.env -> ?ts:Names.transparent_state -> EConstr.constr -> EConstr.constr -> Evd.evar_map -> Evd.evar_map
-  val solve_unif_constraints_with_heuristics : Environ.env -> ?ts:Names.transparent_state -> Evd.evar_map -> Evd.evar_map
-end
-
-module Typing :
-sig
-  val e_sort_of : Environ.env -> Evd.evar_map ref -> EConstr.types -> Sorts.t
-
-  val type_of : ?refresh:bool -> Environ.env -> Evd.evar_map -> EConstr.constr -> Evd.evar_map * EConstr.types
-  val e_solve_evars : Environ.env -> Evd.evar_map ref -> EConstr.constr -> EConstr.constr
-
-  val unsafe_type_of : Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.types
-
-  val e_check : Environ.env -> Evd.evar_map ref -> EConstr.constr -> EConstr.types -> unit
-
-  val e_type_of : ?refresh:bool -> Environ.env -> Evd.evar_map ref -> EConstr.constr -> EConstr.types
-end
-
-module Miscops :
-sig
-  val map_red_expr_gen : ('a -> 'd) -> ('b -> 'e) -> ('c -> 'f) ->
-                         ('a,'b,'c) Genredexpr.red_expr_gen -> ('d,'e,'f) Genredexpr.red_expr_gen
-  val map_cast_type : ('a -> 'b) -> 'a Misctypes.cast_type -> 'b Misctypes.cast_type
-end
-
-module Glob_ops :
-sig
-  val map_glob_constr_left_to_right : (Glob_term.glob_constr -> Glob_term.glob_constr) -> Glob_term.glob_constr -> Glob_term.glob_constr
-  val loc_of_glob_constr : Glob_term.glob_constr -> Loc.t option
-  val glob_constr_eq : Glob_term.glob_constr -> Glob_term.glob_constr -> bool
-  val bound_glob_vars : Glob_term.glob_constr -> Names.Id.Set.t
-
-  (** Conversion from glob_constr to cases pattern, if possible
-
-    Take the current alias as parameter,
-    @raise Not_found if translation is impossible *)
-  val cases_pattern_of_glob_constr : Names.Name.t -> Glob_term.glob_constr -> Glob_term.cases_pattern
-  val map_glob_constr :
-    (Glob_term.glob_constr -> Glob_term.glob_constr) -> Glob_term.glob_constr -> Glob_term.glob_constr
-
-  val empty_lvar : Glob_term.ltac_var_map
-
-end
-
-module Redops :
-sig
-  val all_flags : 'a Genredexpr.glob_red_flag
-  val make_red_flag : 'a Genredexpr.red_atom list -> 'a Genredexpr.glob_red_flag
-end
-
-module Patternops :
-sig
-  val pattern_of_glob_constr : Glob_term.glob_constr -> Names.Id.t list * Pattern.constr_pattern
-  val subst_pattern : Mod_subst.substitution -> Pattern.constr_pattern -> Pattern.constr_pattern
-  val pattern_of_constr : Environ.env -> Evd.evar_map -> Constr.t -> Pattern.constr_pattern
-  val instantiate_pattern : Environ.env ->
-    Evd.evar_map -> Pattern.extended_patvar_map ->
-    Pattern.constr_pattern -> Pattern.constr_pattern
-end
-
-module Constr_matching :
-sig
-  val special_meta : Constr.metavariable
-
-  type binding_bound_vars = Names.Id.Set.t
-  type bound_ident_map = Names.Id.t Names.Id.Map.t
-  val is_matching : Environ.env -> Evd.evar_map -> Pattern.constr_pattern -> EConstr.constr -> bool
-  val extended_matches :
-    Environ.env -> Evd.evar_map -> binding_bound_vars * Pattern.constr_pattern ->
-    EConstr.constr -> bound_ident_map * Pattern.extended_patvar_map
-  exception PatternMatchingFailure
-  type matching_result =
-    { m_sub : bound_ident_map * Pattern.patvar_map;
-      m_ctx : EConstr.constr }
-  val match_subterm_gen : Environ.env -> Evd.evar_map ->
-                          bool ->
-                          binding_bound_vars * Pattern.constr_pattern -> EConstr.constr ->
-                          matching_result IStream.t
-  val matches : Environ.env -> Evd.evar_map -> Pattern.constr_pattern -> EConstr.constr -> Pattern.patvar_map
-end
-
-module Tacred :
-sig
-  val try_red_product : Reductionops.reduction_function
-  val simpl : Reductionops.reduction_function
-  val unfoldn :
-    (Locus.occurrences * Names.evaluable_global_reference) list ->  Reductionops.reduction_function
-  val hnf_constr : Reductionops.reduction_function
-  val red_product : Reductionops.reduction_function
-  val is_evaluable : Environ.env -> Names.evaluable_global_reference -> bool
-  val evaluable_of_global_reference :
-    Environ.env -> Globnames.global_reference -> Names.evaluable_global_reference
-  val error_not_evaluable : Globnames.global_reference -> 'a
-  val reduce_to_quantified_ref :
-    Environ.env ->  Evd.evar_map -> Globnames.global_reference -> EConstr.types -> EConstr.types
-  val pattern_occs : (Locus.occurrences * EConstr.constr) list -> Reductionops.e_reduction_function
-  val cbv_norm_flags : CClosure.RedFlags.reds -> Reductionops.reduction_function
-end
-
-(* XXX: Located manually from intf *)
-module Tok :
-sig
-
-  type t =
-  | KEYWORD of string
-  | PATTERNIDENT of string
-  | IDENT of string
-  | FIELD of string
-  | INT of string
-  | STRING of string
-  | LEFTQMARK
-  | BULLET of string
-  | EOI
-
-end
-
-module CLexer :
-sig
-  val add_keyword : string -> unit
-  val remove_keyword : string -> unit
-  val is_keyword : string -> bool
-  val keywords : unit -> CString.Set.t
-
-  type keyword_state
-  val set_keyword_state : keyword_state -> unit
-  val get_keyword_state : unit -> keyword_state
-
-  val check_ident : string -> unit
-  val terminal : string -> Tok.t
-
-  include Grammar.GLexerType with type te = Tok.t
-end
-
-module Extend :
-sig
-
-  type gram_assoc = NonA | RightA | LeftA
-
-  type gram_position =
-    | First
-    | Last
-    | Before of string
-    | After of string
-    | Level of string
-
-  type production_level =
-    | NextLevel
-    | NumLevel of int
-
-  type 'a entry = 'a Grammar.GMake(CLexer).Entry.e
-
-  type 'a user_symbol =
-    | Ulist1 of 'a user_symbol
-    | Ulist1sep of 'a user_symbol * string
-    | Ulist0 of 'a user_symbol
-    | Ulist0sep of 'a user_symbol * string
-    | Uopt of 'a user_symbol
-    | Uentry of 'a
-    | Uentryl of 'a * int
-
-  type ('self, 'a) symbol =
-    | Atoken : Tok.t -> ('self, string) symbol
-    | Alist1 : ('self, 'a) symbol -> ('self, 'a list) symbol
-    | Alist1sep : ('self, 'a) symbol * ('self, _) symbol -> ('self, 'a list) symbol
-    | Alist0 : ('self, 'a) symbol -> ('self, 'a list) symbol
-    | Alist0sep : ('self, 'a) symbol * ('self, _) symbol -> ('self, 'a list) symbol
-    | Aopt : ('self, 'a) symbol -> ('self, 'a option) symbol
-    | Aself : ('self, 'self) symbol
-    | Anext : ('self, 'self) symbol
-    | Aentry : 'a entry -> ('self, 'a) symbol
-    | Aentryl : 'a entry * int -> ('self, 'a) symbol
-    | Arules : 'a rules list -> ('self, 'a) symbol
-
-  and ('self, _, 'r) rule =
-    | Stop : ('self, 'r, 'r) rule
-    | Next : ('self, 'a, 'r) rule * ('self, 'b) symbol -> ('self, 'b -> 'a, 'r) rule
-
-  and ('a, 'r) norec_rule = { norec_rule : 's. ('s, 'a, 'r) rule }
-
-  and 'a rules =
-    | Rules : ('act, Loc.t -> 'a) norec_rule * 'act -> 'a rules
-
-  type ('lev,'pos) constr_entry_key_gen =
-    | ETName | ETReference | ETBigint
-    | ETBinder of bool
-    | ETConstr of ('lev * 'pos)
-    | ETPattern
-    | ETOther of string * string
-    | ETConstrList of ('lev * 'pos) * Tok.t list
-    | ETBinderList of bool * Tok.t list
-
-  type side = Left | Right
-
-  type production_position =
-    | BorderProd of side * gram_assoc option
-    | InternalProd
-
-  type constr_prod_entry_key =
-    (production_level,production_position) constr_entry_key_gen
-
-  type simple_constr_prod_entry_key =
-    (production_level,unit) constr_entry_key_gen
-
-  type 'a production_rule =
-    | Rule : ('a, 'act, Loc.t -> 'a) rule * 'act -> 'a production_rule
-
-  type 'a single_extend_statment =
-    string option *
-    (** Level *)
-    gram_assoc option *
-    (** Associativity *)
-    'a production_rule list
-  (** Symbol list with the interpretation function *)
-
-  type 'a extend_statment =
-    gram_position option *
-    'a single_extend_statment list
-end
-
-(* XXX: Located manually from intf *)
-module Vernacexpr :
-sig
-  open Misctypes
-  open Constrexpr
-  open Libnames
-
-  type instance_flag  = bool option
-  type coercion_flag = bool
-  type inductive_flag = Decl_kinds.recursivity_kind
-  type lname = Names.Name.t Loc.located
-  type lident = Names.Id.t Loc.located
-  type opacity_flag =
-                    | Opaque of lident list option
-                    | Transparent
-  type locality_flag = bool
-  type inductive_kind =
-    | Inductive_kw | CoInductive | Variant | Record | Structure | Class of bool
-
-  type vernac_type =
-                   | VtStartProof of vernac_start
-                   | VtSideff of vernac_sideff_type
-                   | VtQed of vernac_qed_type
-                   | VtProofStep of proof_step
-                   | VtProofMode of string
-                   | VtQuery of vernac_part_of_script * Feedback.route_id
-                   | VtStm of vernac_control * vernac_part_of_script
-                   | VtUnknown
-   and vernac_qed_type =
-     | VtKeep
-     | VtKeepAsAxiom
-     | VtDrop
-   and vernac_start = string * opacity_guarantee * Names.Id.t list
-   and vernac_sideff_type = Names.Id.t list
-   and vernac_part_of_script = bool
-   and vernac_control =
-     | VtWait
-     | VtJoinDocument
-     | VtBack of Stateid.t
-   and opacity_guarantee =
-     | GuaranteesOpacity
-     | Doesn'tGuaranteeOpacity
-   and proof_step = {
-     parallel : [ `Yes of solving_tac * anon_abstracting_tac | `No ];
-     proof_block_detection : proof_block_name option
-   }
-   and solving_tac = bool
-   and anon_abstracting_tac = bool
-   and proof_block_name = string
-
-  type vernac_when =
-    | VtNow
-    | VtLater
-
-  type verbose_flag = bool
-
-  type obsolete_locality = bool
-
-  type lstring
-  type 'a with_coercion = coercion_flag * 'a
-  type scope_name = string
-  type decl_notation = lstring * Constrexpr.constr_expr * scope_name option
-  type constructor_expr = (lident * Constrexpr.constr_expr) with_coercion
-  type 'a with_notation = 'a * decl_notation list
-
-  type local_decl_expr =
-    | AssumExpr of lname * Constrexpr.constr_expr
-    | DefExpr of lname * Constrexpr.constr_expr * Constrexpr.constr_expr option
-
-  type 'a with_priority = 'a * int option
-  type 'a with_instance = instance_flag * 'a
-  type constructor_list_or_record_decl_expr =
-    | Constructors of constructor_expr list
-    | RecordDecl of lident option * local_decl_expr with_instance with_priority with_notation list
-
-  type plident = lident * lident list option
-
-  type inductive_expr = plident with_coercion * Constrexpr.local_binder_expr list * Constrexpr.constr_expr option * inductive_kind * constructor_list_or_record_decl_expr
-
-  type syntax_modifier =
-    | SetItemLevel of string list * Extend.production_level
-    | SetLevel of int
-    | SetAssoc of Extend.gram_assoc
-    | SetEntryType of string * Extend.simple_constr_prod_entry_key
-    | SetOnlyParsing
-    | SetOnlyPrinting
-    | SetCompatVersion of Flags.compat_version
-    | SetFormat of string * string Loc.located
-
-  type class_rawexpr = FunClass | SortClass | RefClass of reference or_by_notation
-
-  type definition_expr =
-    | ProveBody of local_binder_expr list * constr_expr
-    | DefineBody of local_binder_expr list * Genredexpr.raw_red_expr option * constr_expr
-                    * constr_expr option
-  type proof_expr =
-    plident option * (local_binder_expr list * constr_expr)
-
-  type proof_end =
-    | Admitted
-    | Proved of opacity_flag * lident option
-
-  type fixpoint_expr = plident * (Names.Id.t Loc.located option * Constrexpr.recursion_order_expr) * Constrexpr.local_binder_expr list * Constrexpr.constr_expr * Constrexpr.constr_expr option
-
-  type cofixpoint_expr
-
-  type scheme
-
-  type section_subset_expr
-
-  type module_binder
-
-  type vernac_argument_status
-  type vernac_implicit_status
-  type module_ast_inl
-  type extend_name = string * int
-  type simple_binder
-  type option_value
-  type showable
-  type bullet
-  type stm_vernac
-  type comment
-  type register_kind
-  type locatable
-  type search_restriction
-  type searchable
-  type printable
-  type option_ref_value
-  type onlyparsing_flag
-  type reference_or_constr
-
-  type hint_mode
-
-  type 'a hint_info_gen =
-    { hint_priority : int option;
-      hint_pattern : 'a option }
-
-  type hint_info_expr = Constrexpr.constr_pattern_expr hint_info_gen
-
-  type hints_expr =
-    | HintsResolve of (hint_info_expr * bool * reference_or_constr) list
-    | HintsImmediate of reference_or_constr list
-    | HintsUnfold of Libnames.reference list
-    | HintsTransparency of Libnames.reference list * bool
-    | HintsMode of Libnames.reference * hint_mode list
-    | HintsConstructors of Libnames.reference list
-    | HintsExtern of int * Constrexpr.constr_expr option * Genarg.raw_generic_argument
-
-  type 'a module_signature =
-    | Enforce of 'a (** ... : T *)
-    | Check of 'a list (** ... <: T1 <: T2, possibly empty *)
-
-  type inline =
-    | NoInline
-    | DefaultInline
-    | InlineAt of int
-
-  type cumulative_inductive_parsing_flag =
-    | GlobalCumulativity
-    | GlobalNonCumulativity
-    | LocalCumulativity
-    | LocalNonCumulativity
-
-  type vernac_expr =
-  | VernacLoad of verbose_flag * string
-  | VernacTime of vernac_expr Loc.located
-  | VernacRedirect of string * vernac_expr Loc.located
-  | VernacTimeout of int * vernac_expr
-  | VernacFail of vernac_expr
-  | VernacSyntaxExtension of
-      obsolete_locality * (lstring * syntax_modifier list)
-  | VernacOpenCloseScope of obsolete_locality * (bool * scope_name)
-  | VernacDelimiters of scope_name * string option
-  | VernacBindScope of scope_name * class_rawexpr list
-  | VernacInfix of obsolete_locality * (lstring * syntax_modifier list) *
-      Constrexpr.constr_expr * scope_name option
-  | VernacNotation of
-      obsolete_locality * Constrexpr.constr_expr * (lstring * syntax_modifier list) *
-      scope_name option
-  | VernacNotationAddFormat of string * string * string
-  | VernacDefinition of
-      (Decl_kinds.locality option * Decl_kinds.definition_object_kind) * plident * definition_expr
-  | VernacStartTheoremProof of Decl_kinds.theorem_kind * proof_expr list
-  | VernacEndProof of proof_end
-  | VernacExactProof of Constrexpr.constr_expr
-  | VernacAssumption of (Decl_kinds.locality option * Decl_kinds.assumption_object_kind) *
-      inline * (plident list * Constrexpr.constr_expr) with_coercion list
-  | VernacInductive of cumulative_inductive_parsing_flag * Decl_kinds.private_flag * inductive_flag * (inductive_expr * decl_notation list) list
-  | VernacFixpoint of
-      Decl_kinds.locality option * (fixpoint_expr * decl_notation list) list
-  | VernacCoFixpoint of
-      Decl_kinds.locality option * (cofixpoint_expr * decl_notation list) list
-  | VernacScheme of (lident option * scheme) list
-  | VernacCombinedScheme of lident * lident list
-  | VernacUniverse of lident list
-  | VernacConstraint of (Misctypes.glob_level * Univ.constraint_type * Misctypes.glob_level) list
-  | VernacBeginSection of lident
-  | VernacEndSegment of lident
-  | VernacRequire of
-      Libnames.reference option * bool option * Libnames.reference list
-  | VernacImport of bool * Libnames.reference list
-  | VernacCanonical of Libnames.reference Misctypes.or_by_notation
-  | VernacCoercion of obsolete_locality * Libnames.reference Misctypes.or_by_notation *
-      class_rawexpr * class_rawexpr
-  | VernacIdentityCoercion of obsolete_locality * lident *
-      class_rawexpr * class_rawexpr
-  | VernacNameSectionHypSet of lident * section_subset_expr
-  | VernacInstance of
-      bool *
-      Constrexpr.local_binder_expr list *
-        Constrexpr.typeclass_constraint *
-          (bool * Constrexpr.constr_expr) option *
-      hint_info_expr
-  | VernacContext of Constrexpr.local_binder_expr list
-  | VernacDeclareInstances of
-    (Libnames.reference * hint_info_expr) list
-  | VernacDeclareClass of Libnames.reference
-  | VernacDeclareModule of bool option * lident *
-      module_binder list * module_ast_inl
-  | VernacDefineModule of bool option * lident * module_binder list *
-      module_ast_inl module_signature * module_ast_inl list
-  | VernacDeclareModuleType of lident *
-      module_binder list * module_ast_inl list * module_ast_inl list
-  | VernacInclude of module_ast_inl list
-  | VernacSolveExistential of int * Constrexpr.constr_expr
-  | VernacAddLoadPath of bool * string * Names.DirPath.t option
-  | VernacRemoveLoadPath of string
-  | VernacAddMLPath of bool * string
-  | VernacDeclareMLModule of string list
-  | VernacChdir of string option
-  | VernacWriteState of string
-  | VernacRestoreState of string
-  | VernacResetName of lident
-  | VernacResetInitial
-  | VernacBack of int
-  | VernacBackTo of int
-  | VernacCreateHintDb of string * bool
-  | VernacRemoveHints of string list * Libnames.reference list
-  | VernacHints of obsolete_locality * string list * hints_expr
-  | VernacSyntacticDefinition of Names.Id.t Loc.located * (Names.Id.t list * Constrexpr.constr_expr) *
-      obsolete_locality * onlyparsing_flag
-  | VernacDeclareImplicits of Libnames.reference Misctypes.or_by_notation *
-                                (Constrexpr.explicitation * bool * bool) list list
-  | VernacArguments of Libnames.reference Misctypes.or_by_notation *
-      vernac_argument_status list *
-        (Names.Name.t * vernac_implicit_status) list list *
-      int option *
-        [ `ReductionDontExposeCase | `ReductionNeverUnfold | `Rename |
-          `ExtraScopes | `Assert | `ClearImplicits | `ClearScopes |
-          `DefaultImplicits ] list
-  | VernacArgumentsScope of Libnames.reference Misctypes.or_by_notation *
-      scope_name option list
-  | VernacReserve of simple_binder list
-  | VernacGeneralizable of (lident list) option
-  | VernacSetOpacity of (Conv_oracle.level * Libnames.reference Misctypes.or_by_notation list)
-  | VernacSetStrategy of
-      (Conv_oracle.level * Libnames.reference Misctypes.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 Genredexpr.raw_red_expr option * goal_selector option * Constrexpr.constr_expr
-  | VernacGlobalCheck of Constrexpr.constr_expr
-  | VernacDeclareReduction of string * Genredexpr.raw_red_expr
-  | VernacPrint of printable
-  | VernacSearch of searchable * goal_selector option * search_restriction
-  | VernacLocate of locatable
-  | VernacRegister of lident * register_kind
-  | VernacComments of comment list
-  | VernacStm of stm_vernac
-  | VernacGoal of Constrexpr.constr_expr
-  | VernacAbort of lident option
-  | VernacAbortAll
-  | VernacRestart
-  | VernacUndo of int
-  | VernacUndoTo of int
-  | VernacBacktrack of int*int*int
-  | VernacFocus of int option
-  | VernacUnfocus
-  | VernacUnfocused
-  | VernacBullet of bullet
-  | VernacSubproof of int option
-  | VernacEndSubproof
-  | VernacShow of showable
-  | VernacCheckGuard
-  | VernacProof of Genarg.raw_generic_argument option * section_subset_expr option
-  | VernacProofMode of string
-  | VernacToplevelControl of exn
-  | VernacExtend of extend_name * Genarg.raw_generic_argument list
-  | VernacProgram of vernac_expr
-  | VernacPolymorphic of bool * vernac_expr
-  | VernacLocal of bool * vernac_expr
-  and goal_selector =
-    | SelectNth of int
-    | SelectList of (int * int) list
-    | SelectId of Names.Id.t
-    | SelectAll
-  and vernac_classification = vernac_type * vernac_when
-  and one_inductive_expr =
-    plident * Constrexpr.local_binder_expr list * Constrexpr.constr_expr option * constructor_expr list
-end
-
-(* XXX: end manual intf move *)
-
-module Typeclasses :
-sig
-  type typeclass = {
-    cl_univs : Univ.AUContext.t;
-    cl_impl : Globnames.global_reference;
-    cl_context : (Globnames.global_reference * bool) option list * Context.Rel.t;
-    cl_props : Context.Rel.t;
-    cl_projs : (Names.Name.t * (direction * Vernacexpr.hint_info_expr) option
-                * Names.Constant.t option) list;
-    cl_strict : bool;
-    cl_unique : bool;
-  }
-  and direction
-
-  type instance
-  type evar_filter = Evar.t -> Evar_kinds.t -> bool
-
-  val resolve_typeclasses : ?fast_path:bool -> ?filter:evar_filter -> ?unique:bool ->
-                            ?split:bool -> ?fail:bool -> Environ.env -> Evd.evar_map -> Evd.evar_map
-  val set_resolvable : Evd.Store.t -> bool -> Evd.Store.t
-  val resolve_one_typeclass : ?unique:bool -> Environ.env -> Evd.evar_map -> EConstr.types -> Evd.evar_map * EConstr.constr
-  val class_info : Globnames.global_reference -> typeclass
-  val mark_resolvables : ?filter:evar_filter -> Evd.evar_map -> Evd.evar_map
-  val add_instance : instance -> unit
-  val new_instance : typeclass -> Vernacexpr.hint_info_expr -> bool -> Decl_kinds.polymorphic ->
-                     Globnames.global_reference -> instance
-end
-
-module Classops :
-sig
-  type coe_index
-  type inheritance_path = coe_index list
-  type cl_index
-
-  val hide_coercion : Globnames.global_reference -> int option
-  val lookup_path_to_sort_from : Environ.env -> Evd.evar_map -> EConstr.types ->
-                                 EConstr.types * inheritance_path
-  val get_coercion_value : coe_index -> Constr.t
-  val coercions : unit -> coe_index list
-  val pr_cl_index : cl_index -> Pp.t
-end
-
-module Detyping :
-sig
-  val print_universes : bool ref
-  val print_evar_arguments : bool ref
-  val detype : ?lax:bool -> bool -> Names.Id.t list -> Environ.env -> Evd.evar_map -> EConstr.constr -> Glob_term.glob_constr
-  val subst_glob_constr : Mod_subst.substitution -> Glob_term.glob_constr -> Glob_term.glob_constr
-  val set_detype_anonymous : (?loc:Loc.t -> int -> Glob_term.glob_constr) -> unit
-end
-
-module Indrec :
-sig
-  type dep_flag = bool
-  val lookup_eliminator : Names.inductive -> Sorts.family -> Globnames.global_reference
-  val build_case_analysis_scheme : Environ.env -> Evd.evar_map -> Term.pinductive ->
-                                   dep_flag -> Sorts.family -> Evd.evar_map * Constr.t
-  val make_elimination_ident : Names.Id.t -> Sorts.family -> Names.Id.t
-  val build_mutual_induction_scheme :
-    Environ.env -> Evd.evar_map -> (Term.pinductive * dep_flag * Sorts.family) list -> Evd.evar_map * Constr.t list
-  val build_case_analysis_scheme_default : Environ.env -> Evd.evar_map -> Term.pinductive ->
-      Sorts.family -> Evd.evar_map * Constr.t
-end
-
-module Pretyping :
-sig
-  type typing_constraint =
-    | OfType of EConstr.types
-    | IsType
-    | WithoutTypeConstraint
-
-  type inference_hook = Environ.env -> Evd.evar_map -> Evar.t -> Evd.evar_map * EConstr.constr
-
-  type inference_flags = {
-      use_typeclasses : bool;
-      solve_unification_constraints : bool;
-      use_hook : inference_hook option;
-      fail_evar : bool;
-      expand_evars : bool
-    }
-
-  val understand_ltac : inference_flags ->
-                        Environ.env -> Evd.evar_map -> Glob_term.ltac_var_map ->
-                        typing_constraint -> Glob_term.glob_constr -> Evd.evar_map * EConstr.t
-  val understand_tcc : ?flags:inference_flags -> Environ.env -> Evd.evar_map ->
-                       ?expected_type:typing_constraint -> Glob_term.glob_constr -> Evd.evar_map * EConstr.constr
-  val understand : ?flags:inference_flags -> ?expected_type:typing_constraint ->
-                   Environ.env -> Evd.evar_map -> Glob_term.glob_constr -> Constr.t Evd.in_evar_universe_context
-  val check_evars : Environ.env -> Evd.evar_map -> Evd.evar_map -> EConstr.constr -> unit
-  val interp_elimination_sort : Misctypes.glob_sort -> Sorts.family
-  val register_constr_interp0 :
-    ('r, 'g, 't) Genarg.genarg_type ->
-    (Glob_term.unbound_ltac_var_map -> Environ.env -> Evd.evar_map -> EConstr.types -> 'g -> EConstr.constr * Evd.evar_map) -> unit
-  val all_and_fail_flags : inference_flags
-  val ise_pretype_gen :
-    inference_flags -> Environ.env -> Evd.evar_map ->
-    Glob_term.ltac_var_map -> typing_constraint -> Glob_term.glob_constr -> Evd.evar_map * EConstr.constr
-end
-
-module Unification :
-sig
-  type core_unify_flags = {
-    modulo_conv_on_closed_terms : Names.transparent_state option;
-    use_metas_eagerly_in_conv_on_closed_terms : bool;
-    use_evars_eagerly_in_conv_on_closed_terms : bool;
-    modulo_delta : Names.transparent_state;
-    modulo_delta_types : Names.transparent_state;
-    check_applied_meta_types : bool;
-    use_pattern_unification : bool;
-    use_meta_bound_pattern_unification : bool;
-    frozen_evars : Evar.Set.t;
-    restrict_conv_on_strict_subterms : bool;
-    modulo_betaiota : bool;
-    modulo_eta : bool;
-  }
-  type unify_flags =
-    {
-      core_unify_flags : core_unify_flags;
-      merge_unify_flags : core_unify_flags;
-      subterm_unify_flags : core_unify_flags;
-      allow_K_in_toplevel_higher_order_unification : bool;
-      resolve_evars : bool
-    }
-  val default_no_delta_unify_flags : unit -> unify_flags
-  val w_unify : Environ.env -> Evd.evar_map -> Reduction.conv_pb -> ?flags:unify_flags -> EConstr.constr -> EConstr.constr -> Evd.evar_map
-  val elim_flags : unit -> unify_flags
-  val w_unify_to_subterm :
-    Environ.env -> Evd.evar_map -> ?flags:unify_flags -> EConstr.constr * EConstr.constr -> Evd.evar_map * EConstr.constr
-end
-
-(************************************************************************)
-(* End of modules from pretyping/                                       *)
-(************************************************************************)
-
-(************************************************************************)
-(* Modules from interp/                                              *)
-(************************************************************************)
-
-module Genintern :
-sig
-  open Genarg
-
-  module Store : Store.S
-
-  type glob_sign = {
-    ltacvars : Names.Id.Set.t;
-    genv : Environ.env;
-    extra : Store.t;
-  }
-
-  val empty_glob_sign : Environ.env -> glob_sign
-
-  type ('raw, 'glb) intern_fun = glob_sign -> 'raw -> glob_sign * 'glb
-
-
-  val generic_intern : (raw_generic_argument, glob_generic_argument) intern_fun
-
-  type 'glb subst_fun = Mod_subst.substitution -> 'glb -> 'glb
-  val generic_substitute : Genarg.glob_generic_argument subst_fun
-
-  type 'glb ntn_subst_fun = Tactypes.glob_constr_and_expr Names.Id.Map.t -> 'glb -> 'glb
-
-  val register_intern0 : ('raw, 'glb, 'top) genarg_type ->
-    ('raw, 'glb) intern_fun -> unit
-
-  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
-
-end
-
-module Stdarg :
-sig
-  val loc_of_or_by_notation : ('a -> Loc.t option) -> 'a Misctypes.or_by_notation -> Loc.t option
-  val wit_unit : unit Genarg.uniform_genarg_type
-  val wit_int : int Genarg.uniform_genarg_type
-  val wit_var : (Names.Id.t Loc.located, Names.Id.t Loc.located, Names.Id.t) Genarg.genarg_type
-  val wit_bool : bool Genarg.uniform_genarg_type
-  val wit_string : string Genarg.uniform_genarg_type
-  val wit_pre_ident : string Genarg.uniform_genarg_type
-  val wit_global : (Libnames.reference, Globnames.global_reference Loc.located Misctypes.or_var, Globnames.global_reference) Genarg.genarg_type
-  val wit_ident : Names.Id.t Genarg.uniform_genarg_type
-  val wit_integer : int Genarg.uniform_genarg_type
-  val wit_constr : (Constrexpr.constr_expr, Tactypes.glob_constr_and_expr, EConstr.constr) Genarg.genarg_type
-  val wit_open_constr : (Constrexpr.constr_expr, Tactypes.glob_constr_and_expr, EConstr.constr) Genarg.genarg_type
-  val wit_intro_pattern : (Constrexpr.constr_expr Misctypes.intro_pattern_expr Loc.located, Tactypes.glob_constr_and_expr Misctypes.intro_pattern_expr Loc.located, Tactypes.intro_pattern) Genarg.genarg_type
-  val wit_int_or_var : (int Misctypes.or_var, int Misctypes.or_var, int) Genarg.genarg_type
-  val wit_ref : (Libnames.reference, Globnames.global_reference Loc.located Misctypes.or_var, Globnames.global_reference) Genarg.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.genarg_type
-  val wit_uconstr : (Constrexpr.constr_expr , Tactypes.glob_constr_and_expr, Glob_term.closed_glob_constr) Genarg.genarg_type
-  val wit_red_expr :
-    ((Constrexpr.constr_expr,Libnames.reference Misctypes.or_by_notation,Constrexpr.constr_expr) Genredexpr.red_expr_gen,
-     (Tactypes.glob_constr_and_expr,Names.evaluable_global_reference Misctypes.and_short_name Misctypes.or_var,Tactypes.glob_constr_pattern_and_expr) Genredexpr.red_expr_gen,
-     (EConstr.constr,Names.evaluable_global_reference,Pattern.constr_pattern) Genredexpr.red_expr_gen) Genarg.genarg_type
-  val wit_quant_hyp : Misctypes.quantified_hypothesis Genarg.uniform_genarg_type
-  val wit_bindings :
-    (Constrexpr.constr_expr Misctypes.bindings,
-     Tactypes.glob_constr_and_expr Misctypes.bindings,
-     EConstr.constr Misctypes.bindings Tactypes.delayed_open) Genarg.genarg_type
-  val wit_constr_with_bindings :
-    (Constrexpr.constr_expr Misctypes.with_bindings,
-     Tactypes.glob_constr_and_expr Misctypes.with_bindings,
-     EConstr.constr Misctypes.with_bindings Tactypes.delayed_open) Genarg.genarg_type
-  val wit_intropattern : (Constrexpr.constr_expr Misctypes.intro_pattern_expr Loc.located, Tactypes.glob_constr_and_expr Misctypes.intro_pattern_expr Loc.located, Tactypes.intro_pattern) Genarg.genarg_type
-  val wit_quantified_hypothesis : Misctypes.quantified_hypothesis Genarg.uniform_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.genarg_type
-  val wit_preident : string Genarg.uniform_genarg_type
-  val wit_reference : (Libnames.reference, Globnames.global_reference Loc.located Misctypes.or_var, Globnames.global_reference) Genarg.genarg_type
-  val wit_open_constr_with_bindings :
-    (Constrexpr.constr_expr Misctypes.with_bindings,
-     Tactypes.glob_constr_and_expr Misctypes.with_bindings,
-     EConstr.constr Misctypes.with_bindings Tactypes.delayed_open) Genarg.genarg_type
-end
-
-module Constrexpr_ops :
-sig
-  val mkIdentC : Names.Id.t -> Constrexpr.constr_expr
-  val mkAppC : Constrexpr.constr_expr * Constrexpr.constr_expr list -> Constrexpr.constr_expr
-  val names_of_local_assums : Constrexpr.local_binder_expr list -> Names.Name.t Loc.located list
-  val coerce_reference_to_id : Libnames.reference -> Names.Id.t
-  val coerce_to_id : Constrexpr.constr_expr -> Names.Id.t Loc.located
-  val constr_loc : Constrexpr.constr_expr -> Loc.t option
-  val mkRefC : Libnames.reference -> Constrexpr.constr_expr
-  val mkLambdaC : Names.Name.t Loc.located list * Constrexpr.binder_kind * Constrexpr.constr_expr * Constrexpr.constr_expr -> Constrexpr.constr_expr
-  val default_binder_kind : Constrexpr.binder_kind
-  val mkLetInC : Names.Name.t Loc.located * Constrexpr.constr_expr * Constrexpr.constr_expr option * Constrexpr.constr_expr -> Constrexpr.constr_expr
-  val mkCProdN : ?loc:Loc.t -> Constrexpr.local_binder_expr list -> Constrexpr.constr_expr -> Constrexpr.constr_expr
-end
-
-module Notation_ops :
-sig
-  val glob_constr_of_notation_constr : ?loc:Loc.t -> Notation_term.notation_constr -> Glob_term.glob_constr
-  val glob_constr_of_notation_constr_with_binders : ?loc:Loc.t ->
-                                                    ('a -> Names.Name.t -> 'a * Names.Name.t) ->
-                                                    ('a -> Notation_term.notation_constr -> Glob_term.glob_constr) ->
-                                                    'a -> Notation_term.notation_constr -> Glob_term.glob_constr
-end
-
-module Notation :
-sig
-  type cases_pattern_status = bool
-  type required_module = Libnames.full_path * string list
-  type 'a prim_token_interpreter = ?loc:Loc.t -> 'a -> Glob_term.glob_constr
-  type 'a prim_token_uninterpreter = Glob_term.glob_constr list * (Glob_term.glob_constr -> 'a option) * cases_pattern_status
-  type delimiters = string
-  type local_scopes = Notation_term.tmp_scope_name option * Notation_term.scope_name list
-  type notation_location = (Names.DirPath.t * Names.DirPath.t) * string
-  val declare_string_interpreter : Notation_term.scope_name -> required_module ->
-                                   string prim_token_interpreter -> string prim_token_uninterpreter -> unit
-  val declare_numeral_interpreter : Notation_term.scope_name -> required_module ->
-                                    Bigint.bigint prim_token_interpreter -> Bigint.bigint prim_token_uninterpreter -> unit
-  val interp_notation_as_global_reference : ?loc:Loc.t -> (Globnames.global_reference -> bool) ->
-                                            Constrexpr.notation -> delimiters option -> Globnames.global_reference
-  val locate_notation : (Glob_term.glob_constr -> Pp.t) -> Constrexpr.notation ->
-                        Notation_term.scope_name option -> Pp.t
-  val find_delimiters_scope : ?loc:Loc.t -> delimiters -> Notation_term.scope_name
-  val pr_scope : (Glob_term.glob_constr -> Pp.t) -> Notation_term.scope_name -> Pp.t
-  val pr_scopes : (Glob_term.glob_constr -> Pp.t) -> Pp.t
-  val interp_notation : ?loc:Loc.t -> Constrexpr.notation -> local_scopes ->
-                        Notation_term.interpretation * (notation_location * Notation_term.scope_name option)
-  val uninterp_prim_token : Glob_term.glob_constr -> Notation_term.scope_name * Constrexpr.prim_token
-end
-
-module Dumpglob :
-sig
-  val add_glob : ?loc:Loc.t -> Globnames.global_reference -> unit
-  val pause : unit -> unit
-  val continue : unit -> unit
-end
-
-module Smartlocate :
-sig
-  val locate_global_with_alias : ?head:bool -> Libnames.qualid Loc.located -> Globnames.global_reference
-  val global_with_alias : ?head:bool -> Libnames.reference -> Globnames.global_reference
-  val global_of_extended_global : Globnames.extended_global_reference -> Globnames.global_reference
-  val loc_of_smart_reference : Libnames.reference Misctypes.or_by_notation -> Loc.t option
-  val smart_global : ?head:bool -> Libnames.reference Misctypes.or_by_notation -> Globnames.global_reference
-end
-
-module Topconstr :
-sig
-  val replace_vars_constr_expr :
-  Names.Id.t Names.Id.Map.t -> Constrexpr.constr_expr -> Constrexpr.constr_expr
-end
-
-module Constrintern :
-sig
-  type ltac_sign = {
-    ltac_vars : Names.Id.Set.t;
-    ltac_bound : Names.Id.Set.t;
-    ltac_extra : Genintern.Store.t;
-  }
-
-  type var_internalization_data
-
-  type var_internalization_type =
-    | Inductive of Names.Id.t list * bool
-    | Recursive
-    | Method
-    | Variable
-  type internalization_env = var_internalization_data Names.Id.Map.t
-
-  val interp_constr_evars : Environ.env -> Evd.evar_map ref ->
-                            ?impls:internalization_env -> Constrexpr.constr_expr -> EConstr.constr
-
-  val interp_type_evars : Environ.env -> Evd.evar_map ref ->
-                          ?impls:internalization_env -> Constrexpr.constr_expr -> EConstr.types
-
-  val empty_ltac_sign : ltac_sign
-  val intern_gen : Pretyping.typing_constraint -> Environ.env ->
-                   ?impls:internalization_env -> ?pattern_mode:bool -> ?ltacvars:ltac_sign ->
-                   Constrexpr.constr_expr -> Glob_term.glob_constr
-  val intern_constr_pattern :
-    Environ.env -> ?as_type:bool -> ?ltacvars:ltac_sign ->
-    Constrexpr.constr_pattern_expr -> Names.Id.t list * Pattern.constr_pattern
-  val intern_constr : Environ.env -> Constrexpr.constr_expr -> Glob_term.glob_constr
-  val for_grammar : ('a -> 'b) -> 'a -> 'b
-  val interp_reference : ltac_sign -> Libnames.reference -> Glob_term.glob_constr
-  val interp_constr : Environ.env -> Evd.evar_map -> ?impls:internalization_env ->
-                      Constrexpr.constr_expr -> Constr.t Evd.in_evar_universe_context
-  val interp_open_constr : Environ.env -> Evd.evar_map -> Constrexpr.constr_expr -> Evd.evar_map * EConstr.constr
-  val locate_reference :  Libnames.qualid -> Globnames.global_reference
-  val interp_type : Environ.env -> Evd.evar_map -> ?impls:internalization_env ->
-                    Constrexpr.constr_expr -> Term.types Evd.in_evar_universe_context
-  val interp_context_evars :
-    ?global_level:bool -> ?impl_env:internalization_env -> ?shift:int ->
-    Environ.env -> Evd.evar_map ref -> Constrexpr.local_binder_expr list ->
-    internalization_env * ((Environ.env * EConstr.rel_context) * Impargs.manual_implicits)
-  val compute_internalization_data : Environ.env -> var_internalization_type ->
-                                     Term.types -> Impargs.manual_explicitation list -> var_internalization_data
-  val empty_internalization_env : internalization_env
-  val global_reference : Names.Id.t -> Globnames.global_reference
-end
-
-module Constrextern :
-sig
-  val extern_glob_constr : Names.Id.Set.t -> Glob_term.glob_constr -> Constrexpr.constr_expr
-  val extern_glob_type : Names.Id.Set.t -> Glob_term.glob_constr -> Constrexpr.constr_expr
-  val extern_constr : ?lax:bool -> bool -> Environ.env -> Evd.evar_map -> EConstr.t -> Constrexpr.constr_expr
-  val without_symbols : ('a -> 'b) -> 'a -> 'b
-  val print_universes : bool ref
-  val extern_type : bool -> Environ.env -> Evd.evar_map -> EConstr.t -> Constrexpr.constr_expr
-  val with_universes : ('a -> 'b) -> 'a -> 'b
-  val set_extern_reference :
-    (?loc:Loc.t -> Names.Id.Set.t -> Globnames.global_reference -> Libnames.reference) -> unit
-end
-
-module Declare :
-sig
-  type internal_flag =
-    | UserAutomaticRequest
-    | InternalTacticRequest
-    | UserIndividualRequest
-
-  type constant_declaration = Safe_typing.private_constants Entries.constant_entry * Decl_kinds.logical_kind
-
-  type section_variable_entry =
-    | SectionLocalDef of Safe_typing.private_constants Entries.definition_entry
-    | SectionLocalAssum of Term.types Univ.in_universe_context_set * Decl_kinds.polymorphic * bool
-
-  type variable_declaration = Names.DirPath.t * section_variable_entry * Decl_kinds.logical_kind
-
-  val declare_constant :
-    ?internal:internal_flag -> ?local:bool -> Names.Id.t -> ?export_seff:bool -> constant_declaration -> Names.Constant.t
-
-  val declare_universe_context : Decl_kinds.polymorphic -> Univ.ContextSet.t -> unit
-
-  val declare_definition :
-    ?internal:internal_flag -> ?opaque:bool -> ?kind:Decl_kinds.definition_object_kind ->
-    ?local:bool -> ?poly:Decl_kinds.polymorphic -> Names.Id.t -> ?types:Constr.t ->
-    Constr.t Univ.in_universe_context_set -> Names.Constant.t
-  val definition_entry : ?fix_exn:Future.fix_exn ->
-    ?opaque:bool -> ?inline:bool -> ?types:Term.types ->
-    ?poly:Decl_kinds.polymorphic -> ?univs:Univ.UContext.t ->
-    ?eff:Safe_typing.private_constants -> Constr.t -> Safe_typing.private_constants Entries.definition_entry
-  val definition_message : Names.Id.t -> unit
-  val declare_variable : Names.Id.t -> variable_declaration -> Libnames.object_name
-end
-
-(************************************************************************)
-(* End of modules from interp/                                       *)
-(************************************************************************)
-
-(************************************************************************)
-(* Modules from proofs/                                                 *)
-(************************************************************************)
-
-module Miscprint :
-sig
-  val pr_or_and_intro_pattern :
-    ('a -> Pp.t) -> 'a Misctypes.or_and_intro_pattern_expr -> Pp.t
-  val pr_intro_pattern_naming : Misctypes.intro_pattern_naming_expr -> Pp.t
-  val pr_intro_pattern :
-    ('a -> Pp.t) -> 'a Misctypes.intro_pattern_expr Loc.located -> Pp.t
-  val pr_bindings :
-    ('a -> Pp.t) ->
-    ('a -> Pp.t) -> 'a Misctypes.bindings -> Pp.t
-  val pr_bindings_no_with :
-    ('a -> Pp.t) ->
-    ('a -> Pp.t) -> 'a Misctypes.bindings -> Pp.t
-  val pr_with_bindings :
-    ('a -> Pp.t) ->
-    ('a -> Pp.t) -> 'a * 'a Misctypes.bindings -> Pp.t
-end
-
-(* All items in the Goal modules are deprecated. *)
-module Goal :
-sig
-  type goal = Evar.t
-
-  val pr_goal : goal -> Pp.t
-
-  module V82 :
-  sig
-    val new_goal_with : Evd.evar_map -> goal -> Context.Named.t -> goal Evd.sigma
-
-    val nf_hyps : Evd.evar_map -> goal -> Environ.named_context_val
-
-    val env : Evd.evar_map -> goal -> Environ.env
-
-    val concl : Evd.evar_map -> goal -> EConstr.constr
-
-    val mk_goal : Evd.evar_map ->
-                  Environ.named_context_val ->
-                  EConstr.constr ->
-                  Evd.Store.t ->
-                  goal * EConstr.constr * Evd.evar_map
-
-    val extra : Evd.evar_map -> goal -> Evd.Store.t
-
-    val partial_solution_to : Evd.evar_map -> goal -> goal -> EConstr.constr -> Evd.evar_map
-
-    val partial_solution : Evd.evar_map -> goal -> EConstr.constr -> Evd.evar_map
-
-    val hyps : Evd.evar_map -> goal -> Environ.named_context_val
-
-    val abstract_type : Evd.evar_map -> goal -> EConstr.types
-  end
-end
-
-module Evar_refiner :
-sig
-  type glob_constr_ltac_closure = Glob_term.ltac_var_map * Glob_term.glob_constr
-
-  val w_refine : Evar.t * Evd.evar_info ->
-                 glob_constr_ltac_closure -> Evd.evar_map -> Evd.evar_map
-end
-
-
-module Proof_type :
-sig
-  type prim_rule = Refine of Constr.t
-
-  type tactic = Goal.goal Evd.sigma -> Goal.goal list Evd.sigma
-end
-
-module Logic :
-sig
-  type refiner_error =
-  | BadType of Constr.t * Constr.t * Constr.t
-  | UnresolvedBindings of Names.Name.t list
-  | CannotApply of Constr.t * Constr.t
-  | NotWellTyped of Constr.t
-  | NonLinearProof of Constr.t
-  | MetaInType of EConstr.constr
-  | IntroNeedsProduct
-  | DoesNotOccurIn of Constr.t * Names.Id.t
-  | NoSuchHyp of Names.Id.t
-  exception RefinerError of refiner_error
-  val catchable_exception : exn -> bool
-end
-
-module Refine :
-sig
-  val refine : typecheck:bool -> (Evd.evar_map -> Evd.evar_map * EConstr.t) -> unit Proofview.tactic
-  val solve_constraints : unit Proofview.tactic
-end
-
-module Proof :
-sig
-  type proof
-  type 'a focus_kind
-
-  val run_tactic : Environ.env ->
-                   unit Proofview.tactic -> proof -> proof * (bool * Proofview_monad.Info.tree)
-  val unshelve : proof -> proof
-  val maximal_unfocus : 'a focus_kind -> proof -> proof
-  val pr_proof : proof -> Pp.t
-  module V82 :
-  sig
-    val grab_evars : proof -> proof
-
-    val subgoals : proof -> Goal.goal list Evd.sigma
-  end
-end
-
-module Proof_bullet :
-sig
-  val get_default_goal_selector : unit -> Vernacexpr.goal_selector
-end
-
-module Proof_global :
-sig
-  type proof_mode = {
-      name : string;
-      set : unit -> unit ;
-      reset : unit -> unit
-    }
-  type proof_universes = UState.t * Universes.universe_binders option
-  type proof_object = {
-    id : Names.Id.t;
-    entries : Safe_typing.private_constants Entries.definition_entry list;
-    persistence : Decl_kinds.goal_kind;
-    universes: proof_universes;
-  }
-
-  type proof_ending =
-  | Admitted of Names.Id.t * Decl_kinds.goal_kind * Entries.parameter_entry *
-                  proof_universes
-  | Proved of Vernacexpr.opacity_flag *
-              Vernacexpr.lident option *
-              proof_object
-
-  type proof_terminator
-  type lemma_possible_guards
-  type universe_binders
-  type closed_proof = proof_object * proof_terminator
-
-  val make_terminator : (proof_ending -> unit) -> proof_terminator
-  val start_dependent_proof :
-    Names.Id.t -> ?pl:universe_binders -> Decl_kinds.goal_kind ->
-    Proofview.telescope -> proof_terminator -> unit
-  val with_current_proof :
-    (unit Proofview.tactic -> Proof.proof -> Proof.proof * 'a) -> 'a
-  val simple_with_current_proof :
-    (unit Proofview.tactic -> Proof.proof -> Proof.proof) -> unit
-  val compact_the_proof : unit -> unit
-  val register_proof_mode : proof_mode -> unit
-
-  exception NoCurrentProof
-  val give_me_the_proof : unit -> Proof.proof
-  (** @raise NoCurrentProof when outside proof mode. *)
-
-  val discard_all : unit -> unit
-  val discard_current : unit -> unit
-  val get_current_proof_name : unit -> Names.Id.t
-end
-
-module Redexpr :
-sig
-  type red_expr =
-    (EConstr.constr, Names.evaluable_global_reference, Pattern.constr_pattern) Genredexpr.red_expr_gen
-  val reduction_of_red_expr :
-    Environ.env -> red_expr -> Reductionops.e_reduction_function * Constr.cast_kind
-  val declare_reduction : string -> Reductionops.reduction_function -> unit
-end
-
-module Refiner :
-sig
-  val project : 'a Evd.sigma -> Evd.evar_map
-
-  val unpackage : 'a Evd.sigma -> Evd.evar_map ref * 'a
-
-  val repackage : Evd.evar_map ref -> 'a -> 'a Evd.sigma
-
-  val tclSHOWHYPS : Proof_type.tactic -> Proof_type.tactic
-  exception FailError of int * Pp.t Lazy.t
-
-  val tclEVARS : Evd.evar_map -> Proof_type.tactic
-  val tclMAP : ('a -> Proof_type.tactic) -> 'a list -> Proof_type.tactic
-  val tclREPEAT : Proof_type.tactic -> Proof_type.tactic
-  val tclORELSE        : Proof_type.tactic -> Proof_type.tactic -> Proof_type.tactic
-  val tclFAIL : int -> Pp.t -> Proof_type.tactic
-  val tclIDTAC : Proof_type.tactic
-  val tclTHEN : Proof_type.tactic -> Proof_type.tactic -> Proof_type.tactic
-  val tclTHENLIST : Proof_type.tactic list -> Proof_type.tactic
-  val tclTRY : Proof_type.tactic -> Proof_type.tactic
-  val tclAT_LEAST_ONCE : Proof_type.tactic -> Proof_type.tactic
-end
-
-module Tacmach :
-sig
-
-  type tactic = Proof_type.tactic
-
-  type 'a sigma = 'a Evd.sigma
-  [@@ocaml.deprecated "alias of API.Evd.sigma"]
-
-  val re_sig : 'a -> Evd.evar_map -> 'a Evd.sigma
-
-  val pf_reduction_of_red_expr : Goal.goal Evd.sigma -> Redexpr.red_expr -> EConstr.constr -> Evd.evar_map * EConstr.constr
-
-  val pf_unsafe_type_of : Goal.goal Evd.sigma -> EConstr.constr -> EConstr.types
-
-  val pf_get_new_id  : Names.Id.t -> Goal.goal Evd.sigma -> Names.Id.t
-
-  val pf_env : Goal.goal Evd.sigma -> Environ.env
-
-  val pf_concl : Goal.goal Evd.sigma -> EConstr.types
-
-  val pf_apply : (Environ.env -> Evd.evar_map -> 'a) -> Goal.goal Evd.sigma -> 'a
-
-  val pf_get_hyp            : Goal.goal Evd.sigma -> Names.Id.t -> EConstr.named_declaration
-  val pf_get_hyp_typ        : Goal.goal Evd.sigma -> Names.Id.t -> EConstr.types
-  val project : Goal.goal Evd.sigma -> Evd.evar_map
-  val refine : EConstr.constr -> Proof_type.tactic
-  val refine_no_check : EConstr.constr -> Proof_type.tactic
-  val pf_type_of : Goal.goal Evd.sigma -> EConstr.constr -> Evd.evar_map * EConstr.types
-
-  val pf_hyps : Goal.goal Evd.sigma -> EConstr.named_context
-
-  val pf_ids_of_hyps : Goal.goal Evd.sigma -> Names.Id.t list
-
-  val pf_reduce_to_atomic_ind : Goal.goal Evd.sigma -> EConstr.types -> (Names.inductive * EConstr.EInstance.t) * EConstr.types
-
-  val pf_reduce_to_quantified_ind : Goal.goal Evd.sigma -> EConstr.types -> (Names.inductive * EConstr.EInstance.t) * EConstr.types
-
-  val pf_eapply : (Environ.env -> Evd.evar_map -> 'a -> Evd.evar_map * 'b) ->
-                  Evar.t Evd.sigma -> 'a -> Evar.t Evd.sigma * 'b
-
-  val pf_unfoldn : (Locus.occurrences * Names.evaluable_global_reference) list
-                   -> Goal.goal Evd.sigma -> EConstr.constr -> EConstr.constr
-
-  val pf_reduce : (Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.constr) -> Goal.goal Evd.sigma -> EConstr.constr -> EConstr.constr
-
-  val pf_conv_x : Goal.goal Evd.sigma -> EConstr.constr -> EConstr.constr -> bool
-
-  val pf_is_matching : Goal.goal Evd.sigma -> Pattern.constr_pattern -> EConstr.constr -> bool
-
-  val pf_hyps_types : Goal.goal Evd.sigma -> (Names.Id.t * EConstr.types) list
-
-  val pr_gls    : Goal.goal Evd.sigma -> Pp.t
-
-  val pf_nf_betaiota : Goal.goal Evd.sigma -> EConstr.constr -> EConstr.constr
-
-  val pf_last_hyp : Goal.goal Evd.sigma -> EConstr.named_declaration
-
-  val pf_nth_hyp_id : Goal.goal Evd.sigma -> int -> Names.Id.t
-
-  val sig_it : 'a Evd.sigma -> 'a
-
-  module New :
-  sig
-    val pf_apply : (Environ.env -> Evd.evar_map -> 'a) -> 'b Proofview.Goal.t -> 'a
-    val project : 'a Proofview.Goal.t -> Evd.evar_map
-    val pf_unsafe_type_of : 'a Proofview.Goal.t -> EConstr.constr -> EConstr.types
-    val of_old : (Goal.goal Evd.sigma -> 'a) -> [ `NF ] Proofview.Goal.t -> 'a
-
-    val pf_env : 'a Proofview.Goal.t -> Environ.env
-    val pf_ids_of_hyps : 'a Proofview.Goal.t -> Names.Id.t list
-    val pf_concl : 'a Proofview.Goal.t -> EConstr.types
-    val pf_get_new_id  : Names.Id.t -> 'a Proofview.Goal.t -> Names.Id.t
-    val pf_get_hyp_typ : Names.Id.t -> 'a Proofview.Goal.t -> EConstr.types
-    val pf_get_type_of : 'a Proofview.Goal.t -> EConstr.constr -> EConstr.types
-    val pf_global : Names.Id.t -> 'a Proofview.Goal.t -> Globnames.global_reference
-    val pf_hyps_types : 'a Proofview.Goal.t -> (Names.Id.t * EConstr.types) list
-  end
-end
-
-module Pfedit :
-sig
-  val solve_by_implicit_tactic : unit -> Pretyping.inference_hook option
-  val refine_by_tactic : Environ.env -> Evd.evar_map -> EConstr.types -> unit Proofview.tactic ->
-                         Constr.t * Evd.evar_map
-  val declare_implicit_tactic : unit Proofview.tactic -> unit
-  val clear_implicit_tactic : unit -> unit
-  val by : unit Proofview.tactic -> bool
-  val solve : ?with_end_tac:unit Proofview.tactic ->
-      Vernacexpr.goal_selector -> int option -> unit Proofview.tactic ->
-      Proof.proof -> Proof.proof * bool
-  val cook_proof :
-    unit -> (Names.Id.t * (Safe_typing.private_constants Entries.definition_entry * Proof_global.proof_universes * Decl_kinds.goal_kind))
-
-  val get_current_context : unit -> Evd.evar_map * Environ.env
-
-  (* Deprecated *)
-  val delete_current_proof : unit -> unit
-  [@@ocaml.deprecated "use Proof_global.discard_current"]
-
-  val get_current_proof_name : unit -> Names.Id.t
-  [@@ocaml.deprecated "use Proof_global.get_current_proof_name"]
-
-  val current_proof_statement : unit -> Names.Id.t * Decl_kinds.goal_kind * EConstr.types
-end
-
-module Clenv :
-sig
-
-  type hole = {
-    hole_evar : EConstr.constr;
-    hole_type : EConstr.types;
-    hole_deps  : bool;
-    hole_name : Names.Name.t;
-  }
-
-  type clause = {
-    cl_holes : hole list;
-    cl_concl : EConstr.types;
-  }
-
-  val make_evar_clause : Environ.env -> Evd.evar_map -> ?len:int -> EConstr.types ->
-                         (Evd.evar_map * clause)
-  val solve_evar_clause : Environ.env -> Evd.evar_map -> bool -> clause -> EConstr.constr Misctypes.bindings ->
-                          Evd.evar_map
-  type clausenv
-  val pr_clenv : clausenv -> Pp.t
-end
-
-(************************************************************************)
-(* End of modules from proofs/                                          *)
-(************************************************************************)
-
-(************************************************************************)
-(* Modules from parsing/                                                *)
-(************************************************************************)
-
-module Pcoq :
-sig
-
-  open Loc
-  open Names
-  open Extend
-  open Vernacexpr
-  open Genarg
-  open Constrexpr
-  open Libnames
-  open Misctypes
-  open Genredexpr
-
-  module Gram : sig
-    include Grammar.S with type te = Tok.t
-
-    type 'a entry = 'a Entry.e
-    type internal_entry = Tok.t Gramext.g_entry
-    type symbol = Tok.t Gramext.g_symbol
-    type action = Gramext.g_action
-    type production_rule = symbol list * action
-    type single_extend_statment =
-      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 -> coq_parsable -> 'a
-    val entry_print : Format.formatter -> 'a entry -> unit
-    val with_parsable : coq_parsable -> ('a -> 'b) -> 'a -> 'b
-
-    (* Apparently not used *)
-    val srules' : production_rule list -> symbol
-    val parse_tokens_after_filter : 'a entry -> Tok.t Stream.t -> 'a
-
-  end with type 'a Entry.e = 'a Grammar.GMake(CLexer).Entry.e
-
-  val parse_string : 'a Gram.entry -> string -> 'a
-  val eoi_entry : 'a Gram.entry -> 'a Gram.entry
-  val map_entry : ('a -> 'b) -> 'a Gram.entry -> 'b Gram.entry
-
-  type gram_universe
-
-  val uprim   : gram_universe
-  val uconstr : gram_universe
-  val utactic : gram_universe
-  val uvernac : gram_universe
-
-  val register_grammar : ('raw, 'glb, 'top) genarg_type -> 'raw Gram.entry -> unit
-
-  val genarg_grammar : ('raw, 'glb, 'top) genarg_type -> 'raw Gram.entry
-
-  val create_generic_entry : gram_universe -> string ->
-    ('a, rlevel) abstract_argument_type -> 'a Gram.entry
-
-  module Prim :
-  sig
-    open Names
-    open Libnames
-    val preident : string Gram.entry
-    val ident : Id.t Gram.entry
-    val name : Name.t located Gram.entry
-    val identref : Id.t located Gram.entry
-    val pidentref : (Id.t located * (Id.t located list) option) Gram.entry
-    val pattern_ident : Id.t Gram.entry
-    val pattern_identref : Id.t located Gram.entry
-    val base_ident : Id.t Gram.entry
-    val natural : int Gram.entry
-    val bigint : Constrexpr.raw_natural_number Gram.entry
-    val integer : int Gram.entry
-    val string : string Gram.entry
-    val lstring : string located Gram.entry
-    val qualid : qualid located Gram.entry
-    val fullyqualid : Id.t list located Gram.entry
-    val reference : reference Gram.entry
-    val by_notation : (string * string option) Loc.located Gram.entry
-    val smart_global : reference or_by_notation Gram.entry
-    val dirpath : DirPath.t Gram.entry
-    val ne_string : string Gram.entry
-    val ne_lstring : string located Gram.entry
-    val var : Id.t located Gram.entry
-  end
-
-  module Constr :
-  sig
-    val constr : constr_expr Gram.entry
-    val constr_eoi : constr_expr Gram.entry
-    val lconstr : constr_expr Gram.entry
-    val binder_constr : constr_expr Gram.entry
-    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
-    val lconstr_pattern : constr_expr Gram.entry
-    val closed_binder : local_binder_expr list Gram.entry
-    val binder : local_binder_expr list Gram.entry (* closed_binder or variable *)
-    val binders : local_binder_expr list Gram.entry (* list of binder *)
-    val open_binders : local_binder_expr list Gram.entry
-    val binders_fixannot : (local_binder_expr list * (Id.t located option * recursion_order_expr)) Gram.entry
-    val typeclass_constraint : (Name.t located * bool * constr_expr) Gram.entry
-    val record_declaration : constr_expr Gram.entry
-    val appl_arg : (constr_expr * explicitation located option) Gram.entry
-  end
-
-  module Vernac_ :
-  sig
-    val gallina : vernac_expr Gram.entry
-    val gallina_ext : vernac_expr Gram.entry
-    val command : vernac_expr Gram.entry
-    val syntax : vernac_expr Gram.entry
-    val vernac : vernac_expr Gram.entry
-    val rec_definition : (fixpoint_expr * decl_notation list) Gram.entry
-    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
-
-  val epsilon_value : ('a -> 'self) -> ('self, 'a) Extend.symbol -> 'self option
-
-  val get_command_entry : unit -> vernac_expr Gram.entry
-  val set_command_entry : vernac_expr Gram.entry -> unit
-
-  type gram_reinit = gram_assoc * gram_position
-  val grammar_extend : 'a Gram.entry -> gram_reinit option ->
-    'a Extend.extend_statment -> unit
-
-  module GramState : Store.S
-
-  type 'a grammar_command
-
-  type extend_rule =
-    | ExtendRule : 'a Gram.entry * gram_reinit option * 'a extend_statment -> extend_rule
-
-  type 'a grammar_extension = 'a -> GramState.t -> extend_rule list * GramState.t
-
-  val create_grammar_command : string -> 'a grammar_extension -> 'a grammar_command
-
-  val extend_grammar_command : 'a grammar_command -> 'a -> unit
-  val recover_grammar_command : 'a grammar_command -> 'a list
-  val with_grammar_rule_protection : ('a -> 'b) -> 'a -> 'b
-
-  val to_coqloc : Ploc.t -> Loc.t
-  val (!@) : Ploc.t -> Loc.t
-
-end
-
-module Egramml :
-sig
-  open Vernacexpr
-
-  type 's grammar_prod_item =
-    | GramTerminal of string
-    | GramNonTerminal : ('a Genarg.raw_abstract_argument_type option *
-                         ('s, 'a) Extend.symbol) Loc.located -> 's grammar_prod_item
-
-  val extend_vernac_command_grammar :
-    extend_name -> vernac_expr Pcoq.Gram.entry option ->
-    vernac_expr grammar_prod_item list -> unit
-
-  val make_rule :
-    (Loc.t -> Genarg.raw_generic_argument list -> 'a) ->
-    'a grammar_prod_item list -> 'a Extend.production_rule
-
-end
-
-(************************************************************************)
-(* End of modules from parsing/                                         *)
-(************************************************************************)
-
-(************************************************************************)
-(* Modules from printing/                                               *)
-(************************************************************************)
-
-module Genprint :
-sig
-  type 'a printer = 'a -> Pp.t
-  val generic_top_print : Genarg.tlevel Genarg.generic_argument printer
-  val register_print0 : ('raw, 'glb, 'top) Genarg.genarg_type ->
-                        'raw printer -> 'glb printer -> 'top printer -> unit
-end
-
-module Pputils :
-sig
-  val pr_with_occurrences : ('a -> Pp.t) -> (string -> Pp.t) -> 'a Locus.with_occurrences -> Pp.t
-  val pr_red_expr :
-    ('a -> Pp.t) * ('a -> Pp.t) * ('b -> Pp.t) * ('c -> Pp.t) ->
-    (string -> Pp.t) ->
-    ('a,'b,'c) Genredexpr.red_expr_gen -> Pp.t
-  val pr_raw_generic : Environ.env -> Genarg.rlevel Genarg.generic_argument -> Pp.t
-  val pr_glb_generic : Environ.env -> Genarg.glevel Genarg.generic_argument -> Pp.t
-  val pr_or_var : ('a -> Pp.t) -> 'a Misctypes.or_var -> Pp.t
-  val pr_or_by_notation : ('a -> Pp.t) -> 'a Misctypes.or_by_notation -> Pp.t
-end
-
-module Ppconstr :
-sig
-  val pr_name : Names.Name.t -> Pp.t
-  [@@ocaml.deprecated "alias of API.Names.Name.print"]
-
-  val pr_id : Names.Id.t -> Pp.t
-  val pr_or_var : ('a -> Pp.t) -> 'a Misctypes.or_var -> Pp.t
-  val pr_with_comments : ?loc:Loc.t -> Pp.t -> Pp.t
-  val pr_lident : Names.Id.t Loc.located -> Pp.t
-  val pr_lname : Names.Name.t Loc.located -> Pp.t
-  val prec_less : int -> int * Notation_term.parenRelation -> bool
-  val pr_constr_expr : Constrexpr.constr_expr -> Pp.t
-  val pr_lconstr_expr : Constrexpr.constr_expr -> Pp.t
-  val pr_constr_pattern_expr : Constrexpr.constr_pattern_expr -> Pp.t
-  val pr_lconstr_pattern_expr : Constrexpr.constr_pattern_expr -> Pp.t
-  val pr_binders : Constrexpr.local_binder_expr list -> Pp.t
-  val pr_glob_sort : Misctypes.glob_sort -> Pp.t
-end
-
-module Printer :
-sig
-  val pr_named_context : Environ.env -> Evd.evar_map -> Context.Named.t -> Pp.t
-  val pr_rel_context : Environ.env -> Evd.evar_map -> Context.Rel.t -> Pp.t
-  val pr_goal : Goal.goal Evd.sigma -> Pp.t
-
-  val pr_constr_env : Environ.env -> Evd.evar_map -> Constr.t -> Pp.t
-  val pr_lconstr_env : Environ.env -> Evd.evar_map -> Constr.t -> Pp.t
-
-  val pr_constr : Constr.t -> Pp.t
-
-  val pr_lconstr : Constr.t -> Pp.t
-
-  val pr_econstr : EConstr.constr -> Pp.t
-  val pr_glob_constr : Glob_term.glob_constr -> Pp.t
-  val pr_constr_pattern : Pattern.constr_pattern -> Pp.t
-  val pr_glob_constr_env : Environ.env -> Glob_term.glob_constr -> Pp.t
-  val pr_lglob_constr_env : Environ.env -> Glob_term.glob_constr -> Pp.t
-  val pr_econstr_env : Environ.env -> Evd.evar_map -> EConstr.constr -> Pp.t
-  val pr_constr_pattern_env : Environ.env -> Evd.evar_map -> Pattern.constr_pattern -> Pp.t
-  val pr_lconstr_pattern_env : Environ.env -> Evd.evar_map -> Pattern.constr_pattern -> Pp.t
-  val pr_closed_glob : Glob_term.closed_glob_constr -> Pp.t
-  val pr_lglob_constr : Glob_term.glob_constr -> Pp.t
-  val pr_leconstr_env : Environ.env -> Evd.evar_map -> EConstr.constr -> Pp.t
-  val pr_leconstr : EConstr.constr -> Pp.t
-  val pr_global : Globnames.global_reference -> Pp.t
-  val pr_lconstr_under_binders : Pattern.constr_under_binders -> Pp.t
-  val pr_lconstr_under_binders_env : Environ.env -> Evd.evar_map -> Pattern.constr_under_binders -> Pp.t
-
-  val pr_constr_under_binders_env : Environ.env -> Evd.evar_map -> Pattern.constr_under_binders -> Pp.t
-  val pr_closed_glob_env : Environ.env -> Evd.evar_map -> Glob_term.closed_glob_constr -> Pp.t
-  val pr_rel_context_of : Environ.env -> Evd.evar_map -> Pp.t
-  val pr_named_context_of : Environ.env -> Evd.evar_map -> Pp.t
-  val pr_ltype : Term.types -> Pp.t
-  val pr_ljudge : EConstr.unsafe_judgment -> Pp.t * Pp.t
-  val pr_idpred : Names.Id.Pred.t -> Pp.t
-  val pr_cpred : Names.Cpred.t -> Pp.t
-  val pr_transparent_state : Names.transparent_state -> Pp.t
-end
-
-(************************************************************************)
-(* End of modules from printing/                                        *)
-(************************************************************************)
-
-(************************************************************************)
-(* Modules from tactics/                                                *)
-(************************************************************************)
-
-module Tacticals :
-sig
-  open Proof_type
-
-  val tclORELSE        : tactic -> tactic -> tactic
-  val tclDO : int -> tactic -> tactic
-  val tclIDTAC : tactic
-  val tclFAIL : int -> Pp.t -> tactic
-  val tclTHEN : tactic -> tactic -> tactic
-  val tclTHENLIST      : tactic list -> tactic
-  val pf_constr_of_global :
-    Globnames.global_reference -> (EConstr.constr -> Proof_type.tactic) -> Proof_type.tactic
-  val tclMAP : ('a -> tactic) -> 'a list -> tactic
-  val tclTRY           : tactic -> tactic
-  val tclCOMPLETE      : tactic -> tactic
-  val tclTHENS : tactic -> tactic list -> tactic
-  val tclFIRST         : tactic list -> tactic
-  val tclTHENFIRST     : tactic -> tactic -> tactic
-  val tclTHENLAST      : tactic -> tactic -> tactic
-  val tclTHENSFIRSTn   : tactic -> tactic array -> tactic -> tactic
-  val tclTHENSLASTn    : tactic -> tactic -> tactic array -> tactic
-  val tclSOLVE         : tactic list -> tactic
-
-  val onClause   : (Names.Id.t option -> tactic) -> Locus.clause -> tactic
-  val onAllHypsAndConcl : (Names.Id.t option -> tactic) -> tactic
-  val onLastHypId : (Names.Id.t -> tactic) -> tactic
-  val onNthHypId : int -> (Names.Id.t -> tactic) -> tactic
-  val onNLastHypsId : int -> (Names.Id.t list -> tactic) -> tactic
-
-  val tclTHENSEQ : tactic list -> tactic
-  [@@ocaml.deprecated "alias of API.Tacticals.tclTHENLIST"]
-
-  val nLastDecls : int -> Goal.goal Evd.sigma -> EConstr.named_context
-
-  val tclTHEN_i : tactic -> (int -> tactic) -> tactic
-
-  val tclPROGRESS : tactic -> tactic
-
-  val elimination_sort_of_goal : Goal.goal Evd.sigma -> Sorts.family
-
-  module New :
-  sig
-    open Proofview
-    val tclORELSE0 : unit tactic -> unit tactic -> unit tactic
-    val tclFAIL : int -> Pp.t -> 'a tactic
-    val pf_constr_of_global : Globnames.global_reference -> EConstr.constr tactic
-    val tclTHEN : unit tactic -> unit tactic -> unit tactic
-    val tclTHENS : unit tactic -> unit tactic list -> unit tactic
-    val tclFIRST : unit tactic list -> unit tactic
-    val tclZEROMSG : ?loc:Loc.t -> Pp.t -> 'a tactic
-    val tclORELSE  : unit tactic -> unit tactic -> unit tactic
-    val tclREPEAT : unit tactic -> unit tactic
-    val tclTRY : unit tactic -> unit tactic
-    val tclTHENFIRST : unit tactic -> unit tactic -> unit tactic
-    val tclPROGRESS :  unit Proofview.tactic -> unit Proofview.tactic
-    val tclTHENS3PARTS : unit tactic -> unit tactic array -> unit tactic -> unit tactic array -> unit tactic
-    val tclDO : int -> unit tactic -> unit tactic
-    val tclTIMEOUT : int -> unit tactic -> unit tactic
-    val tclTIME : string option -> 'a tactic -> 'a tactic
-    val tclOR : unit tactic -> unit tactic -> unit tactic
-    val tclONCE : unit tactic -> unit tactic
-    val tclEXACTLY_ONCE : unit tactic -> unit tactic
-    val tclIFCATCH :
-      unit tactic  ->
-      (unit -> unit tactic) ->
-      (unit -> unit tactic) -> unit tactic
-    val tclSOLVE : unit tactic list -> unit tactic
-    val tclCOMPLETE : 'a tactic -> 'a tactic
-    val tclSELECT : Vernacexpr.goal_selector -> 'a tactic -> 'a tactic
-    val tclWITHHOLES : bool -> 'a tactic -> Evd.evar_map -> 'a tactic
-    val tclDELAYEDWITHHOLES : bool -> 'a Tactypes.delayed_open -> ('a -> unit tactic) -> unit tactic
-    val tclTHENLIST : unit tactic list -> unit tactic
-    val tclTHENLAST  : unit tactic -> unit tactic -> unit tactic
-    val tclMAP : ('a -> unit tactic) -> 'a list -> unit tactic
-    val tclIDTAC : unit tactic
-    val tclIFTHENELSE : unit tactic -> unit tactic -> unit tactic -> unit tactic
-    val tclIFTHENSVELSE : unit tactic -> unit tactic array -> unit tactic -> unit tactic
-  end
-end
-
-module Hipattern :
-sig
-  exception NoEquationFound
-  type 'a matching_function = Evd.evar_map -> EConstr.constr -> 'a option
-  type testing_function = Evd.evar_map -> EConstr.constr -> bool
-  val is_disjunction : ?strict:bool -> ?onlybinary:bool -> testing_function
-  val match_with_disjunction : ?strict:bool -> ?onlybinary:bool -> (EConstr.constr * EConstr.constr list) matching_function
-  val match_with_equality_type : (EConstr.constr * EConstr.constr list) matching_function
-  val is_empty_type : testing_function
-  val is_unit_type : testing_function
-  val is_unit_or_eq_type : testing_function
-  val is_conjunction : ?strict:bool -> ?onlybinary:bool -> testing_function
-  val match_with_conjunction : ?strict:bool -> ?onlybinary:bool -> (EConstr.constr * EConstr.constr list) matching_function
-  val match_with_imp_term : (EConstr.constr * EConstr.constr) matching_function
-  val match_with_forall_term : (Names.Name.t * EConstr.constr * EConstr.constr) matching_function
-  val match_with_nodep_ind : (EConstr.constr * EConstr.constr list * int) matching_function
-  val match_with_sigma_type : (EConstr.constr * EConstr.constr list) matching_function
-end
-
-module Ind_tables :
-sig
-  type individual
-  type 'a scheme_kind
-
-  val check_scheme : 'a scheme_kind -> Names.inductive -> bool
-  val find_scheme : ?mode:Declare.internal_flag -> 'a scheme_kind -> Names.inductive -> Names.Constant.t * Safe_typing.private_constants
-  val pr_scheme_kind : 'a scheme_kind -> Pp.t
-end
-
-module Elimschemes :
-sig
-  val case_scheme_kind_from_prop : Ind_tables.individual Ind_tables.scheme_kind
-  val case_dep_scheme_kind_from_type_in_prop : Ind_tables.individual Ind_tables.scheme_kind
-  val case_scheme_kind_from_type : Ind_tables.individual Ind_tables.scheme_kind
-  val case_dep_scheme_kind_from_type : Ind_tables.individual Ind_tables.scheme_kind
-  val case_dep_scheme_kind_from_prop : Ind_tables.individual Ind_tables.scheme_kind
-end
-
-module Tactics :
-sig
-  open Proofview
-
-  type change_arg = Pattern.patvar_map -> Evd.evar_map -> Evd.evar_map * EConstr.constr
-  type tactic_reduction = Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.constr
-
-  type elim_scheme =
-    {
-      elimc: EConstr.constr Misctypes.with_bindings option;
-      elimt: EConstr.types;
-      indref: Globnames.global_reference option;
-      params: EConstr.rel_context;
-      nparams: int;
-      predicates: EConstr.rel_context;
-      npredicates: int;
-      branches: EConstr.rel_context;
-      nbranches: int;
-      args: EConstr.rel_context;
-      nargs: int;
-      indarg: EConstr.rel_declaration option;
-      concl: EConstr.types;
-      indarg_in_concl: bool;
-      farg_in_concl: bool;
-    }
-
-  val unify : ?state:Names.transparent_state -> EConstr.constr -> EConstr.constr -> unit Proofview.tactic
-  val intro_then : (Names.Id.t -> unit Proofview.tactic) -> unit Proofview.tactic
-  val reflexivity : unit tactic
-  val change_concl : EConstr.constr -> unit tactic
-  val apply : EConstr.constr -> unit tactic
-  val normalise_vm_in_concl : unit tactic
-  val assert_before : Names.Name.t -> EConstr.types -> unit tactic
-  val exact_check : EConstr.constr -> unit tactic
-  val simplest_elim : EConstr.constr -> unit tactic
-  val introf : unit tactic
-  val cut : EConstr.types -> unit tactic
-  val convert_concl : ?check:bool -> EConstr.types -> Constr.cast_kind -> unit tactic
-  val intro_using : Names.Id.t -> unit tactic
-  val intro : unit tactic
-  val fresh_id_in_env : Names.Id.t list -> Names.Id.t -> Environ.env -> Names.Id.t
-  val is_quantified_hypothesis : Names.Id.t -> 'a Goal.t -> bool
-  val tclABSTRACT : ?opaque:bool -> Names.Id.t option -> unit Proofview.tactic -> unit Proofview.tactic
-  val intro_patterns : bool -> Tactypes.intro_patterns -> unit Proofview.tactic
-  val apply_with_delayed_bindings_gen :
-    Misctypes.advanced_flag -> Misctypes.evars_flag -> (Misctypes.clear_flag * Tactypes.delayed_open_constr_with_bindings Loc.located) list -> unit Proofview.tactic
-  val apply_delayed_in :
-    Misctypes.advanced_flag -> Misctypes.evars_flag -> Names.Id.t ->
-    (Misctypes.clear_flag * Tactypes.delayed_open_constr_with_bindings Loc.located) list ->
-    Tactypes.intro_pattern option -> unit Proofview.tactic
-  val elim :
-    Misctypes.evars_flag -> Misctypes.clear_flag -> EConstr.constr Misctypes.with_bindings -> EConstr.constr Misctypes.with_bindings option -> unit Proofview.tactic
-  val general_case_analysis : Misctypes.evars_flag -> Misctypes.clear_flag -> EConstr.constr Misctypes.with_bindings ->  unit Proofview.tactic
-  val mutual_fix :
-    Names.Id.t -> int -> (Names.Id.t * int * EConstr.constr) list -> int -> unit Proofview.tactic
-  val mutual_cofix : Names.Id.t -> (Names.Id.t * EConstr.constr) list -> int -> unit Proofview.tactic
-  val forward   : bool -> unit Proofview.tactic option option ->
-                  Tactypes.intro_pattern option -> EConstr.constr -> unit Proofview.tactic
-  val generalize_gen : (EConstr.constr Locus.with_occurrences * Names.Name.t) list -> unit Proofview.tactic
-  val letin_tac : (bool * Tactypes.intro_pattern_naming) option ->
-                  Names.Name.t -> EConstr.constr -> EConstr.types option -> Locus.clause -> unit Proofview.tactic
-  val letin_pat_tac : Misctypes.evars_flag ->
-                      (bool * Tactypes.intro_pattern_naming) option ->
-                      Names.Name.t ->
-                      Evd.evar_map * EConstr.constr ->
-                      Locus.clause -> unit Proofview.tactic
-  val induction_destruct : Misctypes.rec_flag -> Misctypes.evars_flag ->
-                           (Tactypes.delayed_open_constr_with_bindings Misctypes.destruction_arg
-                            * (Tactypes.intro_pattern_naming option * Tactypes.or_and_intro_pattern option)
-                            * Locus.clause option) list *
-                             EConstr.constr Misctypes.with_bindings option -> unit Proofview.tactic
-  val reduce : Redexpr.red_expr -> Locus.clause -> unit Proofview.tactic
-  val change : Pattern.constr_pattern option -> change_arg -> Locus.clause -> unit Proofview.tactic
-  val intros_reflexivity : unit Proofview.tactic
-  val exact_no_check : EConstr.constr -> unit Proofview.tactic
-  val assumption : unit Proofview.tactic
-  val intros_transitivity : EConstr.constr option -> unit Proofview.tactic
-  val vm_cast_no_check : EConstr.constr -> unit Proofview.tactic
-  val native_cast_no_check : EConstr.constr -> unit Proofview.tactic
-  val case_type : EConstr.types -> unit Proofview.tactic
-  val elim_type : EConstr.types -> unit Proofview.tactic
-  val cut_and_apply : EConstr.constr -> unit Proofview.tactic
-  val left_with_bindings  : Misctypes.evars_flag -> EConstr.constr Misctypes.bindings -> unit Proofview.tactic
-  val right_with_bindings : Misctypes.evars_flag -> EConstr.constr Misctypes.bindings -> unit Proofview.tactic
-  val any_constructor : Misctypes.evars_flag -> unit Proofview.tactic option -> unit Proofview.tactic
-  val constructor_tac : Misctypes.evars_flag -> int option -> int ->
-                        EConstr.constr Misctypes.bindings -> unit Proofview.tactic
-  val specialize : EConstr.constr Misctypes.with_bindings -> Tactypes.intro_pattern option -> unit Proofview.tactic
-  val intros_symmetry : Locus.clause -> unit Proofview.tactic
-  val split_with_bindings : Misctypes.evars_flag -> EConstr.constr Misctypes.bindings list -> unit Proofview.tactic
-  val intros_until : Misctypes.quantified_hypothesis -> unit Proofview.tactic
-  val intro_move : Names.Id.t option -> Names.Id.t Misctypes.move_location -> unit Proofview.tactic
-  val move_hyp : Names.Id.t -> Names.Id.t Misctypes.move_location -> unit Proofview.tactic
-  val rename_hyp : (Names.Id.t * Names.Id.t) list -> unit Proofview.tactic
-  val revert : Names.Id.t list -> unit Proofview.tactic
-  val simple_induct : Misctypes.quantified_hypothesis -> unit Proofview.tactic
-  val simple_destruct : Misctypes.quantified_hypothesis -> unit Proofview.tactic
-  val fix : Names.Id.t option -> int -> unit Proofview.tactic
-  val cofix : Names.Id.t option -> unit Proofview.tactic
-  val keep : Names.Id.t list -> unit Proofview.tactic
-  val clear : Names.Id.t list -> unit Proofview.tactic
-  val clear_body : Names.Id.t list -> unit Proofview.tactic
-  val generalize_dep  : ?with_let:bool (** Don't lose let bindings *) -> EConstr.constr  -> unit Proofview.tactic
-  val force_destruction_arg : Misctypes.evars_flag -> Environ.env -> Evd.evar_map ->
-    Tactypes.delayed_open_constr_with_bindings Misctypes.destruction_arg ->
-    Evd.evar_map * EConstr.constr Misctypes.with_bindings Misctypes.destruction_arg
-  val apply_with_bindings   : EConstr.constr Misctypes.with_bindings -> unit Proofview.tactic
-  val abstract_generalize : ?generalize_vars:bool -> ?force_dep:bool -> Names.Id.t -> unit Proofview.tactic
-  val specialize_eqs : Names.Id.t -> unit Proofview.tactic
-  val generalize : EConstr.constr list -> unit Proofview.tactic
-  val simplest_case : EConstr.constr -> unit Proofview.tactic
-  val introduction : ?check:bool -> Names.Id.t -> unit Proofview.tactic
-  val convert_concl_no_check : EConstr.types -> Constr.cast_kind -> unit Proofview.tactic
-  val reduct_in_concl : tactic_reduction * Constr.cast_kind -> unit Proofview.tactic
-  val reduct_in_hyp : ?check:bool -> tactic_reduction -> Locus.hyp_location -> unit Proofview.tactic
-  val convert_hyp_no_check : EConstr.named_declaration -> unit Proofview.tactic
-  val reflexivity_red : bool -> unit Proofview.tactic
-  val symmetry_red : bool -> unit Proofview.tactic
-  val eapply : EConstr.constr -> unit Proofview.tactic
-  val transitivity_red : bool -> EConstr.constr option -> unit Proofview.tactic
-  val assert_after_replacing : Names.Id.t -> EConstr.types -> unit Proofview.tactic
-  val intros : unit Proofview.tactic
-  val setoid_reflexivity : unit Proofview.tactic Hook.t
-  val setoid_symmetry : unit Proofview.tactic Hook.t
-  val setoid_symmetry_in : (Names.Id.t -> unit Proofview.tactic) Hook.t
-  val setoid_transitivity : (EConstr.constr option -> unit Proofview.tactic) Hook.t
-  val unfold_in_concl :
-    (Locus.occurrences * Names.evaluable_global_reference) list -> unit Proofview.tactic
-  val intros_using : Names.Id.t list -> unit Proofview.tactic
-  val simpl_in_concl : unit Proofview.tactic
-  val reduct_option : ?check:bool -> tactic_reduction * Constr.cast_kind -> Locus.goal_location -> unit Proofview.tactic
-  val simplest_split : unit Proofview.tactic
-  val unfold_in_hyp :
-    (Locus.occurrences * Names.evaluable_global_reference) list -> Locus.hyp_location -> unit Proofview.tactic
-  val split : EConstr.constr Misctypes.bindings -> unit Proofview.tactic
-  val red_in_concl : unit Proofview.tactic
-  val change_in_concl   : (Locus.occurrences * Pattern.constr_pattern) option -> change_arg -> unit Proofview.tactic
-  val eapply_with_bindings  : EConstr.constr Misctypes.with_bindings -> unit Proofview.tactic
-  val assert_by  : Names.Name.t -> EConstr.types -> unit Proofview.tactic ->
-                   unit Proofview.tactic
-  val intro_avoiding : Names.Id.t list -> unit Proofview.tactic
-  val pose_proof : Names.Name.t -> EConstr.constr -> unit Proofview.tactic
-  val pattern_option :  (Locus.occurrences * EConstr.constr) list -> Locus.goal_location -> unit Proofview.tactic
-  val compute_elim_sig : Evd.evar_map -> ?elimc:EConstr.constr Misctypes.with_bindings -> EConstr.types -> elim_scheme
-  val try_intros_until :
-    (Names.Id.t -> unit Proofview.tactic) -> Misctypes.quantified_hypothesis -> unit Proofview.tactic
-  val cache_term_by_tactic_then :
-    opaque:bool -> ?goal_type:(EConstr.constr option) -> Names.Id.t ->
-    Decl_kinds.goal_kind -> unit Proofview.tactic -> (EConstr.constr -> EConstr.constr list -> unit Proofview.tactic) -> unit Proofview.tactic
-  val apply_type : EConstr.constr -> EConstr.constr list -> unit Proofview.tactic
-  val hnf_in_concl : unit Proofview.tactic
-  val intro_mustbe_force : Names.Id.t -> unit Proofview.tactic
-
-  module New :
-  sig
-    val refine : typecheck:bool -> (Evd.evar_map -> Evd.evar_map * EConstr.constr) -> unit Proofview.tactic
-    val reduce_after_refine : unit Proofview.tactic
-  end
-  module Simple :
-  sig
-    val intro : Names.Id.t -> unit Proofview.tactic
-    val apply  : EConstr.constr -> unit Proofview.tactic
-    val case : EConstr.constr -> unit Proofview.tactic
-  end
-end
-
-module Elim :
-sig
-  val h_decompose : Names.inductive list -> EConstr.constr -> unit Proofview.tactic
-  val h_double_induction : Misctypes.quantified_hypothesis -> Misctypes.quantified_hypothesis-> unit Proofview.tactic
-  val h_decompose_or : EConstr.constr -> unit Proofview.tactic
-  val h_decompose_and : EConstr.constr -> unit Proofview.tactic
-end
-
-module Equality :
-sig
-  type orientation = bool
-  type freeze_evars_flag = bool
-  type dep_proof_flag = bool
-  type conditions =
-    | Naive
-    | FirstSolved
-    | AllMatches
-
-  val build_selector :
-    Environ.env -> Evd.evar_map -> int -> EConstr.constr -> EConstr.types ->
-    EConstr.constr -> EConstr.constr -> EConstr.constr
-  val replace : EConstr.constr -> EConstr.constr -> unit Proofview.tactic
-  val general_rewrite :
-    orientation -> Locus.occurrences -> freeze_evars_flag -> dep_proof_flag ->
-    ?tac:(unit Proofview.tactic * conditions) -> EConstr.constr -> unit Proofview.tactic
-  val inj : Tactypes.intro_patterns option -> Misctypes.evars_flag ->
-            Misctypes.clear_flag -> EConstr.constr Misctypes.with_bindings -> unit Proofview.tactic
-  val general_multi_rewrite :
-    Misctypes.evars_flag -> (bool * Misctypes.multi * Misctypes.clear_flag * Tactypes.delayed_open_constr_with_bindings) list ->
-    Locus.clause -> (unit Proofview.tactic * conditions) option -> unit Proofview.tactic
-  val replace_in_clause_maybe_by : EConstr.constr -> EConstr.constr -> Locus.clause -> unit Proofview.tactic option -> unit Proofview.tactic
-  val replace_term : bool option -> EConstr.constr -> Locus.clause -> unit Proofview.tactic
-  val dEq : Misctypes.evars_flag -> EConstr.constr Misctypes.with_bindings Misctypes.destruction_arg option -> unit Proofview.tactic
-  val discr_tac : Misctypes.evars_flag ->
-                  EConstr.constr Misctypes.with_bindings Misctypes.destruction_arg option -> unit Proofview.tactic
-  val injClause    : Tactypes.intro_patterns option -> Misctypes.evars_flag ->
-                     EConstr.constr Misctypes.with_bindings Misctypes.destruction_arg option -> unit Proofview.tactic
-
-  val simpleInjClause : Misctypes.evars_flag ->
-                        EConstr.constr Misctypes.with_bindings Misctypes.destruction_arg option ->
-                        unit Proofview.tactic
-  val rewriteInConcl : bool -> EConstr.constr -> unit Proofview.tactic
-  val rewriteInHyp : bool -> EConstr.constr -> Names.Id.t -> unit Proofview.tactic
-  val cutRewriteInConcl : bool -> EConstr.constr -> unit Proofview.tactic
-  val cutRewriteInHyp : bool -> EConstr.types -> Names.Id.t -> unit Proofview.tactic
-  val general_rewrite_ebindings_clause : Names.Id.t option ->
-                                         orientation -> Locus.occurrences -> freeze_evars_flag -> dep_proof_flag ->
-                                         ?tac:(unit Proofview.tactic * conditions) -> EConstr.constr Misctypes.with_bindings -> Misctypes.evars_flag -> unit Proofview.tactic
-  val subst : Names.Id.t list -> unit Proofview.tactic
-
-  type subst_tactic_flags = {
-    only_leibniz : bool;
-    rewrite_dependent_proof : bool
-  }
-  val subst_all : ?flags:subst_tactic_flags -> unit -> unit Proofview.tactic
-
-  val general_rewrite_in :
-    orientation -> Locus.occurrences -> freeze_evars_flag -> dep_proof_flag ->
-    ?tac:(unit Proofview.tactic * conditions) -> Names.Id.t -> EConstr.constr -> Misctypes.evars_flag -> unit Proofview.tactic
-
-  val general_setoid_rewrite_clause :
-  (Names.Id.t option -> orientation -> Locus.occurrences -> EConstr.constr Misctypes.with_bindings ->
-   new_goals:EConstr.constr list -> unit Proofview.tactic) Hook.t
-
-  val discrConcl   : unit Proofview.tactic
-  val rewriteLR : ?tac:(unit Proofview.tactic * conditions) -> EConstr.constr -> unit Proofview.tactic
-  val rewriteRL : ?tac:(unit Proofview.tactic * conditions) -> EConstr.constr  -> unit Proofview.tactic
-  val general_rewrite_bindings :
-    orientation -> Locus.occurrences -> freeze_evars_flag -> dep_proof_flag ->
-    ?tac:(unit Proofview.tactic * conditions) -> EConstr.constr Misctypes.with_bindings -> Misctypes.evars_flag -> unit Proofview.tactic
-  val discriminable : Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.constr -> bool
-  val discrHyp : Names.Id.t -> unit Proofview.tactic
-  val injectable : Environ.env -> Evd.evar_map -> EConstr.constr -> EConstr.constr -> bool
-  val injHyp : Misctypes.clear_flag -> Names.Id.t -> unit Proofview.tactic
-  val subst_gen : bool -> Names.Id.t list -> unit Proofview.tactic
-end
-
-module Contradiction :
-sig
-  val contradiction : EConstr.constr Misctypes.with_bindings option -> unit Proofview.tactic
-  val absurd : EConstr.constr -> unit Proofview.tactic
-end
-
-module Inv :
-sig
-  val dinv :
-    Misctypes.inversion_kind -> EConstr.constr option ->
-    Tactypes.or_and_intro_pattern option -> Misctypes.quantified_hypothesis -> unit Proofview.tactic
-  val inv_clause :
-    Misctypes.inversion_kind -> Tactypes.or_and_intro_pattern option -> Names.Id.t list ->
-    Misctypes.quantified_hypothesis -> unit Proofview.tactic
-  val inv_clear_tac : Names.Id.t -> unit Proofview.tactic
-  val inv_tac : Names.Id.t -> unit Proofview.tactic
-  val dinv_tac : Names.Id.t -> unit Proofview.tactic
-  val dinv_clear_tac : Names.Id.t -> unit Proofview.tactic
-  val inv : Misctypes.inversion_kind -> Tactypes.or_and_intro_pattern option ->
-            Misctypes.quantified_hypothesis -> unit Proofview.tactic
-end
-
-module Leminv :
-sig
-  val lemInv_clause :
-    Misctypes.quantified_hypothesis -> EConstr.constr -> Names.Id.t list -> unit Proofview.tactic
-  val add_inversion_lemma_exn :
-    Names.Id.t -> Constrexpr.constr_expr -> Misctypes.glob_sort -> bool -> (Names.Id.t -> unit Proofview.tactic) ->
-    unit
-end
-
-module Hints :
-sig
-
-  type raw_hint = EConstr.t * EConstr.types * Univ.universe_context_set
-
-  type 'a hint_ast =
-    | Res_pf     of 'a (* Hint Apply *)
-    | ERes_pf    of 'a (* Hint EApply *)
-    | Give_exact of 'a
-    | Res_pf_THEN_trivial_fail of 'a (* Hint Immediate *)
-    | Unfold_nth of Names.evaluable_global_reference       (* Hint Unfold *)
-    | Extern     of Genarg.glob_generic_argument (* Hint Extern *)
-
-  type hint
-
-  type debug =
-    | Debug | Info | Off
-
-  type 'a hints_path_atom_gen =
-    | PathHints of 'a list
-    | PathAny
-
-  type hint_term =
-    | IsGlobRef of Globnames.global_reference
-    | IsConstr of EConstr.constr * Univ.ContextSet.t
-
-  type hint_db_name = string
-  type hint_info = (Names.Id.t list * Pattern.constr_pattern) Vernacexpr.hint_info_gen
-  type hnf = bool
-  type hints_path_atom = Globnames.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 hints_path = Globnames.global_reference hints_path_gen
-
-  type hints_entry =
-    | HintsResolveEntry of (hint_info * Decl_kinds.polymorphic * hnf * hints_path_atom * hint_term) list
-    | HintsImmediateEntry of (hints_path_atom * Decl_kinds.polymorphic * hint_term) list
-    | HintsCutEntry of hints_path
-    | HintsUnfoldEntry of Names.evaluable_global_reference list
-    | HintsTransparencyEntry of Names.evaluable_global_reference list * bool
-    | HintsModeEntry of Globnames.global_reference * Vernacexpr.hint_mode list
-    | HintsExternEntry of hint_info * Genarg.glob_generic_argument
-
-  type 'a with_metadata = private {
-      pri     : int;
-      poly    : Decl_kinds.polymorphic;
-      pat     : Pattern.constr_pattern option;
-      name    : hints_path_atom;
-      db : string option;
-      secvars : Names.Id.Pred.t;
-      code    : 'a;
-    }
-  type full_hint = hint with_metadata
-
-  module Hint_db :
-  sig
-    type t
-    val empty : ?name:hint_db_name -> Names.transparent_state -> bool -> t
-    val transparent_state : t -> Names.transparent_state
-    val iter : (Globnames.global_reference option ->
-                Vernacexpr.hint_mode array list -> full_hint list -> unit) -> t -> unit
-  end
-  type hint_db = Hint_db.t
-
-  val add_hints : bool -> hint_db_name list -> hints_entry -> unit
-  val searchtable_map : hint_db_name -> hint_db
-  val pp_hints_path_atom : ('a -> Pp.t) -> 'a hints_path_atom_gen -> Pp.t
-  val pp_hints_path_gen : ('a -> Pp.t) -> 'a hints_path_gen -> Pp.t
-  val glob_hints_path_atom :
-    Libnames.reference hints_path_atom_gen -> Globnames.global_reference hints_path_atom_gen
-  val pp_hints_path : hints_path -> Pp.t
-  val glob_hints_path :
-    Libnames.reference hints_path_gen -> Globnames.global_reference hints_path_gen
-  val run_hint : hint ->
-    ((raw_hint * Clenv.clausenv) hint_ast -> 'r Proofview.tactic) -> 'r Proofview.tactic
-  val typeclasses_db : hint_db_name
-  val add_hints_init : (unit -> unit) -> unit
-  val create_hint_db : bool -> hint_db_name -> Names.transparent_state -> bool -> unit
-  val empty_hint_info : 'a Vernacexpr.hint_info_gen
-  val repr_hint : hint -> (raw_hint * Clenv.clausenv) hint_ast
-  val pr_hint_db : Hint_db.t -> Pp.t
-end
-
-module Auto :
-sig
-  val default_auto : unit Proofview.tactic
-  val full_trivial : ?debug:Hints.debug ->
-                     Tactypes.delayed_open_constr list -> unit Proofview.tactic
-  val h_auto   : ?debug:Hints.debug ->
-                 int option -> Tactypes.delayed_open_constr list -> Hints.hint_db_name list option -> unit Proofview.tactic
-  val h_trivial : ?debug:Hints.debug ->
-                  Tactypes.delayed_open_constr list -> Hints.hint_db_name list option -> unit Proofview.tactic
-  val new_full_auto : ?debug:Hints.debug ->
-                      int -> Tactypes.delayed_open_constr list -> unit Proofview.tactic
-  val full_auto : ?debug:Hints.debug ->
-                  int -> Tactypes.delayed_open_constr list -> unit Proofview.tactic
-  val new_auto : ?debug:Hints.debug ->
-                 int -> Tactypes.delayed_open_constr list -> Hints.hint_db_name list -> unit Proofview.tactic
-  val default_full_auto : unit Proofview.tactic
-end
-
-module Eauto :
-sig
-  val e_assumption : unit Proofview.tactic
-  val e_give_exact : ?flags:Unification.unify_flags -> EConstr.constr -> unit Proofview.tactic
-  val prolog_tac : Tactypes.delayed_open_constr list -> int -> unit Proofview.tactic
-  val make_dimension : int option -> int option -> bool * int
-  val gen_eauto : ?debug:Hints.debug -> bool * int -> Tactypes.delayed_open_constr list ->
-                  Hints.hint_db_name list option -> unit Proofview.tactic
-  val autounfold_tac : Hints.hint_db_name list option -> Locus.clause -> unit Proofview.tactic
-  val autounfold_one : Hints.hint_db_name list -> Locus.hyp_location option -> unit Proofview.tactic
-  val eauto_with_bases :
-    ?debug:Hints.debug -> bool * int -> Tactypes.delayed_open_constr list -> Hints.hint_db list -> Proof_type.tactic
-end
-
-module Class_tactics :
-sig
-
-  type search_strategy =
-    | Dfs
-    | Bfs
-
-  val set_typeclasses_debug : bool -> unit
-  val set_typeclasses_strategy : search_strategy -> unit
-  val set_typeclasses_depth : int option -> unit
-  val typeclasses_eauto : ?only_classes:bool -> ?st:Names.transparent_state -> ?strategy:search_strategy ->
-                        depth:(Int.t option) ->
-                        Hints.hint_db_name list -> unit Proofview.tactic
-  val head_of_constr : Names.Id.t -> EConstr.constr -> unit Proofview.tactic
-  val not_evar : EConstr.constr -> unit Proofview.tactic
-  val is_ground : EConstr.constr -> unit Proofview.tactic
-  val autoapply : EConstr.constr -> Hints.hint_db_name -> unit Proofview.tactic
-  val catchable : exn -> bool
-end
-
-module Eqdecide :
-sig
-  val compare : EConstr.constr -> EConstr.constr -> unit Proofview.tactic
-  val decideEqualityGoal : unit Proofview.tactic
-end
-
-module Autorewrite :
-sig
-  type rew_rule = { rew_lemma: Constr.t;
-                    rew_type: Term.types;
-                    rew_pat: Constr.t;
-                    rew_ctx: Univ.ContextSet.t;
-                    rew_l2r: bool;
-                    rew_tac: Genarg.glob_generic_argument option }
-  type raw_rew_rule = (Constr.t Univ.in_universe_context_set * bool *
-                         Genarg.raw_generic_argument option)
-                        Loc.located
-  val auto_multi_rewrite : ?conds:Equality.conditions -> string list -> Locus.clause -> unit Proofview.tactic
-  val auto_multi_rewrite_with : ?conds:Equality.conditions -> unit Proofview.tactic -> string list -> Locus.clause -> unit Proofview.tactic
-  val add_rew_rules : string -> raw_rew_rule list -> unit
-  val find_rewrites : string -> rew_rule list
-  val find_matches : string -> Constr.t -> rew_rule list
-  val print_rewrite_hintdb : string -> Pp.t
-end
-
-(************************************************************************)
-(* End of modules from tactics/                                         *)
-(************************************************************************)
-
-(************************************************************************)
-(* Modules from vernac/                                                 *)
-(************************************************************************)
-
-module Ppvernac :
-sig
-  val pr_vernac : Vernacexpr.vernac_expr -> Pp.t
-  val pr_rec_definition : (Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list) -> Pp.t
-end
-
-module Lemmas :
-sig
-
-  type 'a declaration_hook
-
-  val mk_hook :
-    (Decl_kinds.locality -> Globnames.global_reference -> 'a) -> 'a declaration_hook
-  val start_proof : Names.Id.t -> ?pl:Proof_global.universe_binders -> Decl_kinds.goal_kind -> Evd.evar_map ->
-    ?terminator:(Proof_global.lemma_possible_guards -> unit declaration_hook -> Proof_global.proof_terminator) ->
-    ?sign:Environ.named_context_val -> EConstr.types ->
-    ?init_tac:unit Proofview.tactic -> ?compute_guard:Proof_global.lemma_possible_guards ->
-    unit declaration_hook -> unit
-  val call_hook :
-    Future.fix_exn -> 'a declaration_hook -> Decl_kinds.locality -> Globnames.global_reference -> 'a
-  val save_proof : ?proof:Proof_global.closed_proof -> Vernacexpr.proof_end -> unit
-  val get_current_context : unit -> Evd.evar_map * Environ.env
-end
-
-module Himsg :
-sig
-  val explain_refiner_error : Logic.refiner_error -> Pp.t
-  val explain_pretype_error : Environ.env -> Evd.evar_map -> Pretype_errors.pretype_error -> Pp.t
-end
-
-module ExplainErr :
-sig
-  val process_vernac_interp_error : ?allow_uncaught:bool -> Util.iexn -> Util.iexn
-  val register_additional_error_info : (Util.iexn -> Pp.t option Loc.located option) -> unit
-end
-
-module Locality :
-sig
-  val make_section_locality : bool option -> bool
-  module LocalityFixme : sig
-    val consume : unit -> bool option
-  end
-  val make_module_locality : bool option -> bool
-end
-
-module Metasyntax :
-sig
-
-  val add_token_obj : string -> unit
-
-  type any_entry = AnyEntry : 'a Pcoq.Gram.entry -> any_entry
-  val register_grammar : string -> any_entry list -> unit
-
-end
-
-module Search :
-sig
-  type glob_search_about_item =
-                              | GlobSearchSubPattern of Pattern.constr_pattern
-                              | GlobSearchString of string
-  type filter_function = Globnames.global_reference -> Environ.env -> Constr.t -> bool
-  type display_function = Globnames.global_reference -> Environ.env -> Constr.t -> unit
-  val search_about_filter : glob_search_about_item -> filter_function
-  val module_filter : Names.DirPath.t list * bool -> filter_function
-  val generic_search : int option -> display_function -> unit
-end
-
-module Obligations :
-sig
-  val default_tactic : unit Proofview.tactic ref
-  val obligation : int * Names.Id.t option * Constrexpr.constr_expr option ->
-                   Genarg.glob_generic_argument option -> unit
-  val next_obligation : Names.Id.t option -> Genarg.glob_generic_argument option -> unit
-  val try_solve_obligation : int -> Names.Id.t option -> unit Proofview.tactic option -> unit
-  val try_solve_obligations : Names.Id.t option -> unit Proofview.tactic option -> unit
-  val solve_all_obligations : unit Proofview.tactic option -> unit
-  val admit_obligations : Names.Id.t option -> unit
-  val show_obligations : ?msg:bool -> Names.Id.t option -> unit
-  val show_term : Names.Id.t option -> Pp.t
-end
-
-module Command :
-sig
-  open Names
-  open Constrexpr
-  open Vernacexpr
-
-  type structured_fixpoint_expr = {
-    fix_name : Id.t;
-    fix_univs : lident list option;
-    fix_annot : Id.t Loc.located option;
-    fix_binders : local_binder_expr list;
-    fix_body : constr_expr option;
-    fix_type : constr_expr
-  }
-
-  type structured_one_inductive_expr = {
-    ind_name : Id.t;
-    ind_univs : lident list option;
-    ind_arity : constr_expr;
-    ind_lc : (Id.t * constr_expr) list
-  }
-
-  type structured_inductive_expr =
-    local_binder_expr list * structured_one_inductive_expr list
-
-  type recursive_preentry = Names.Id.t list * Constr.t option list * Constr.types list
-
-  type one_inductive_impls
-
-  val do_mutual_inductive :
-    (Vernacexpr.one_inductive_expr * Vernacexpr.decl_notation list) list -> Decl_kinds.cumulative_inductive_flag -> Decl_kinds.polymorphic ->
-    Decl_kinds.private_flag -> Decl_kinds.recursivity_kind -> unit
-
-  val do_definition : Names.Id.t -> Decl_kinds.definition_kind -> Vernacexpr.lident list option ->
-    Constrexpr.local_binder_expr list -> Redexpr.red_expr option -> Constrexpr.constr_expr ->
-    Constrexpr.constr_expr option -> unit Lemmas.declaration_hook -> unit
-
-  val do_fixpoint :
-    Decl_kinds.locality -> Decl_kinds.polymorphic -> (Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list) list -> unit
-
-  val extract_fixpoint_components : bool ->
-    (Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list) list ->
-    structured_fixpoint_expr list * Vernacexpr.decl_notation list
-
-  val interp_fixpoint :
-    structured_fixpoint_expr list -> Vernacexpr.decl_notation list ->
-    recursive_preentry * Vernacexpr.lident list option * UState.t *
-      (EConstr.rel_context * Impargs.manual_implicits * int option) list
-
-  val extract_mutual_inductive_declaration_components :
-    (Vernacexpr.one_inductive_expr * Vernacexpr.decl_notation list) list ->
-    structured_inductive_expr * Libnames.qualid list * Vernacexpr.decl_notation list
-
-  val interp_mutual_inductive :
-    structured_inductive_expr -> Vernacexpr.decl_notation list ->
-    Decl_kinds.cumulative_inductive_flag ->
-    Decl_kinds.polymorphic ->
-    Decl_kinds.private_flag -> Decl_kinds.recursivity_kind ->
-    Entries.mutual_inductive_entry * Universes.universe_binders * one_inductive_impls list
-
-  val declare_mutual_inductive_with_eliminations :
-    Entries.mutual_inductive_entry -> Universes.universe_binders -> one_inductive_impls list ->
-    Names.MutInd.t
-end
-
-module Classes :
-sig
-  val set_typeclass_transparency : Names.evaluable_global_reference -> bool -> bool -> unit
-  val new_instance :
-    ?abstract:bool ->
-    ?global:bool ->
-    ?refine:bool ->
-    Decl_kinds.polymorphic ->
-    Constrexpr.local_binder_expr list ->
-    Constrexpr.typeclass_constraint ->
-    (bool * Constrexpr.constr_expr) option ->
-    ?generalize:bool ->
-    ?tac:unit Proofview.tactic  ->
-    ?hook:(Globnames.global_reference -> unit) ->
-    Vernacexpr.hint_info_expr ->
-    Names.Id.t
-end
-
-module Vernacinterp :
-sig
-  type deprecation = bool
-
-  type vernac_command = Genarg.raw_generic_argument list -> unit -> unit
-
-  val vinterp_add : deprecation -> Vernacexpr.extend_name ->
-    vernac_command -> unit
-
-end
-
-module Mltop :
-sig
-  val declare_cache_obj : (unit -> unit) -> string -> unit
-  val add_known_plugin : (unit -> unit) -> string -> unit
-  val add_known_module : string -> unit
-  val module_is_known : string -> bool
-end
-
-module Topfmt :
-sig
-  val std_ft : Format.formatter ref
-  val with_output_to : out_channel -> Format.formatter
-  val get_margin : unit -> int option
-end
-
-module Vernacentries :
-sig
-  val dump_global : Libnames.reference Misctypes.or_by_notation -> unit
-  val interp_redexp_hook : (Environ.env -> Evd.evar_map -> Genredexpr.raw_red_expr ->
-                            Evd.evar_map * Redexpr.red_expr) Hook.t
-  val command_focus : unit Proof.focus_kind
-end
-
-(************************************************************************)
-(* End of modules from vernac/                                          *)
-(************************************************************************)
-
-(************************************************************************)
-(* Modules from stm/                                                    *)
-(************************************************************************)
-
-module Vernac_classifier :
-sig
-  val declare_vernac_classifier :
-    Vernacexpr.extend_name -> (Genarg.raw_generic_argument list -> unit -> Vernacexpr.vernac_classification) -> unit
-  val classify_as_proofstep : Vernacexpr.vernac_classification
-  val classify_as_query : Vernacexpr.vernac_classification
-  val classify_as_sideeff : Vernacexpr.vernac_classification
-  val classify_vernac : Vernacexpr.vernac_expr -> Vernacexpr.vernac_classification
-end
-
-module Stm :
-sig
-  type state
-  val state_of_id :
-    Stateid.t -> [ `Valid of state option | `Expired | `Error of exn ]
-end
-
-(************************************************************************)
-(* End of modules from stm/                                             *)
-(************************************************************************)
-
-(************************************************************************)
-(* Modules from highparsing/                                            *)
-(************************************************************************)
-
-module G_vernac :
-sig
-
-  val def_body : Vernacexpr.definition_expr Pcoq.Gram.entry
-  val section_subset_expr : Vernacexpr.section_subset_expr Pcoq.Gram.entry
-  val query_command : (Vernacexpr.goal_selector option -> Vernacexpr.vernac_expr) Pcoq.Gram.entry
-
-end
-
-module G_proofs :
-sig
-
-  val hint : Vernacexpr.hints_expr Pcoq.Gram.entry
-  val hint_proof_using : 'a Pcoq.Gram.entry -> 'a option -> 'a option
-
-end
-
-(************************************************************************)
-(* End of modules from highparsing/                                     *)
-(************************************************************************)
diff --git a/API/API.mllib b/API/API.mllib
deleted file mode 100644
index 25275c704..000000000
--- a/API/API.mllib
+++ /dev/null
@@ -1 +0,0 @@
-API
diff --git a/API/PROPERTIES b/API/PROPERTIES
deleted file mode 100644
index cd942e202..000000000
--- a/API/PROPERTIES
+++ /dev/null
@@ -1,8 +0,0 @@
-0 : All API elements, i.e.:
-    - modules
-    - module types
-    - functions & values
-    - types
-    are present if and only if are needed for implementing Coq plugins.
-
-1 : Individual API elements are not aliased.
diff --git a/CHANGES b/CHANGES
index 4e40122d4..2040c1b57 100644
--- a/CHANGES
+++ b/CHANGES
@@ -5,6 +5,31 @@ Notations
 
 - Recursive notations with the recursive pattern repeating on the
   right (e.g. "( x ; .. ; y ; z )") now supported.
+- Notations with a specific level for the leftmost nonterminal,
+  when printing-only, are supported.
+- When several notations are available for the same expression,
+  priority is given to latest notations defined in the scopes being
+  opened rather than to the latest notations defined independently of
+  whether they are in an opened scope or not.
+- Notations can now refer to the syntactic category of patterns (as in
+  "fun 'pat =>" or "match p with pat => ... end"). Two variants are
+  available, depending on whether a single variable is considered as a
+  pattern or not.
+- Recursive notations now support ".." patterns with several
+  occurrences of the recursive term or binder, possibly mixing terms
+  and binders, possibly in reverse left-to-right order.
+- "Locate" now working also on notations of the form "x + y" (rather
+  than "_ + _").
+
+Specification language
+
+- When printing clauses of a "match", clauses with same right-hand
+  side are factorized and the last most factorized clause with no
+  variables, if it exists, is turned into a default clause.
+  Use "Unset Printing Allow Default Clause" do deactivate printing
+  of a default clause.
+  Use "Unset Printing Factorizable Match Patterns" to deactivate
+  factorization of clauses with same right-hand side.
 
 Tactics
 
@@ -12,9 +37,127 @@ Tactics
   utility. The command "Set NativeCompute Profiling" enables
   profiling, and "Set NativeCompute Profile Filename" customizes
   the profile filename.
+- The tactic "omega" is now aware of the bodies of context variables
+  such as "x := 5 : Z" (see BZ#148). This could be disabled via
+  Unset Omega UseLocalDefs.
+- The tactic "romega" is also aware now of the bodies of context variables.
+- The tactic "zify" resp. "omega with N" is now aware of N.pred.
+- Tactic "decide equality" now able to manage constructors which
+  contain proofs.
+- Added tactics reset ltac profile, show ltac profile (and variants)
+- Added tactics restart_timer, finish_timing, and time_constr as an
+  experimental way of timing Ltac's evaluation phase
+- Added tactic optimize_heap, analogous to the Vernacular Optimize
+  Heap, which performs a major garbage collection and heap compaction
+  in the OCaml run-time system.
+- The tactics "dtauto", "dintuition", "firstorder" now handle inductive types
+  with let bindings in the parameters.
+- The tactic "dtauto" now handles some inductives such as
+  "@sigT A (fun _ => B)" as non-dependent conjunctions.
+
+Focusing
+
+- Focusing bracket `{` now supports single-numbered goal selector,
+  e.g. `2: {` will focus on the second sub-goal. As usual, unfocus
+  with `}` once the sub-goal is fully solved.
 
-Changes from 8.6.1 to 8.7+beta
-==============================
+Vernacular Commands
+
+- Proofs ending in "Qed exporting ident, .., ident" are not supported
+  anymore. Constants generated during `abstract` are kept private to the
+  local environment.
+- The deprecated Coercion Local, Open Local Scope, Notation Local syntax
+  was removed. Use Local as a prefix instead.
+- For the Extraction Language command, "OCaml" is spelled correctly.
+  The older "Ocaml" is still accepted, but deprecated.
+
+Universes
+
+- Qualified naming of global universes now works like other namespaced
+  objects (e.g. constants), with a separate namespace, inside and across
+  module and library boundaries. Global universe names introduced in an
+  inductive / constant / Let declaration get qualified with the name of
+  the declaration.
+- Universe cumulativity for inductive types is now specified as a
+  variance for each polymorphic universe. See the reference manual for
+  more information.
+- Fix #5726: Notations that start with `Type` now support universe instances
+  with `@{u}`.
+
+Checker
+
+- The checker now accepts filenames in addition to logical paths.
+
+CoqIDE
+
+- Find and Replace All report the number of occurrences found; Find indicates
+  when it wraps.
+
+Documentation
+
+- The Coq FAQ, formerly located at https://coq.inria.fr/faq, has been
+  moved to the GitHub wiki section of this repository; the main entry
+  page is https://github.com/coq/coq/wiki/The-Coq-FAQ.
+
+Standard Library
+
+- New libraries Coq.Init.Decimal, Coq.Numbers.DecimalFacts,
+  Coq.Numbers.DecimalNat, Coq.Numbers.DecimalPos,
+  Coq.Numbers.DecimalN, Coq.Numbers.DecimalZ,
+  Coq.Numbers.DecimalString providing a type of decimal numbers, some
+  facts about them, and conversions between decimal numbers and nat,
+  positive, N, Z, and string.
+
+Changes from 8.7.1 to 8.7.2
+===========================
+
+Fixed a critical bug in the VM handling of universes (#6677). This bug
+affected all releases since 8.5.
+
+Improved support for building with OCaml 4.06.0 and external num package.
+
+Many other bug fixes, documentation improvements, and user
+message improvements (for details, see the 8.7.2 milestone at
+https://github.com/coq/coq/milestone/11?closed=1).
+
+Changes from 8.7.0 to 8.7.1
+===========================
+
+Compatibility with OCaml 4.06.0.
+
+Many bug fixes, documentation improvements, and user message improvements (for
+details see the 8.7.1 milestone at https://github.com/coq/coq/milestone/10?closed=1).
+
+Changes from 8.7+beta2 to 8.7.0
+===============================
+
+OCaml
+
+- Users can pass specific flags to the OCaml optimizing compiler by
+  -using the flambda-opts configure-time option.
+
+  Beware that compiling Coq with a flambda-enabled compiler is
+  experimental and may require large amounts of RAM and CPU, see
+  INSTALL for more details.
+
+Changes from 8.7+beta1 to 8.7+beta2
+===================================
+
+Tools
+
+- In CoqIDE, the "Compile Buffer" command takes account of flags in
+  _CoqProject or other project file.
+
+Improvements around some error messages.
+
+Many bug fixes including two important ones:
+
+- BZ#5730: CoqIDE becomes unresponsive on file open.
+- coq_makefile: make sure compile flags for Coq and coq_makefile are in sync
+  (in particular, make sure the `-safe-string` option is used to compile plugins).
+
+Changes from 8.6.1 to 8.7+beta1
+===============================
 
 Tactics
 
@@ -125,6 +268,13 @@ Plugins
 - The mathematical proof language (also known as declarative mode) was removed.
 - A new command Extraction TestCompile has been introduced, not meant
   for the general user but instead for Coq's test-suite.
+- The extraction plugin is no longer loaded by default. It must be
+  explicitly loaded with [Require Extraction], which is backwards
+  compatible.
+- The functional induction plugin (which provides the [Function]
+  vernacular) is no longer loaded by default. It must be explicitly
+  loaded with [Require FunInd], which is backwards compatible.
+
 
 Dependencies
 
@@ -204,7 +354,7 @@ Changes from 8.6 to 8.6.1
 - Fix bug 5550: "typeclasses eauto with" does not work with section variables.
 - Bug 5546, qualify datatype constructors when needed in Show Match
 - Bug #5535, test for Show with -emacs
-- Fix bug #5486, don't reverse ids in tuples 
+- Fix bug #5486, don't reverse ids in tuples
 - Fixing #5522 (anomaly with free vars of pat)
 - Fix bug #5526, don't check for nonlinearity in notation if printing only
 - Fix bug #5255
@@ -226,7 +376,7 @@ Changes from 8.6 to 8.6.1
 - show unused intro pattern warning
 - [future] Be eager when "chaining" already resolved future values.
 - Opaque side effects
-- Fix #5132: coq_makefile generates incorrect install goal 
+- Fix #5132: coq_makefile generates incorrect install goal
 - Run non-tactic comands without resilient_command
 - Univs: fix bug #5365, generation of u+k <= v constraints
 - make `emit' tail recursive
@@ -2353,7 +2503,7 @@ Tactics
   a registered setoid equality before starting to reduce in H. This is unlikely
   to break any script. Should this happen nonetheless, one can insert manually
   some "unfold ... in H" before rewriting.
-- Fixed various bugs about (setoid) rewrite ... in ... (in particular #1101)
+- Fixed various bugs about (setoid) rewrite ... in ... (in particular BZ#1101)
 - "rewrite ... in" now accepts a clause as place where to rewrite instead of
   juste a simple hypothesis name. For instance:
    rewrite H in H1,H2 |- * means rewrite H in H1; rewrite H in H2; rewrite H
@@ -2930,11 +3080,11 @@ Incompatibilities
 Bugs
 
 - Improved localisation of errors in Syntactic Definitions
-- Induction principle creation failure in presence of let-in fixed (#238)
-- Inversion bugs fixed (#212 and #220)
-- Omega bug related to Set fixed (#180)
-- Type-checking inefficiency of nested destructuring let-in fixed (#216)
-- Improved handling of let-in during holes resolution phase (#239)
+- Induction principle creation failure in presence of let-in fixed (BZ#238)
+- Inversion bugs fixed (BZ#212 and BZ#220)
+- Omega bug related to Set fixed (BZ#180)
+- Type-checking inefficiency of nested destructuring let-in fixed (BZ#216)
+- Improved handling of let-in during holes resolution phase (BZ#239)
 
 Efficiency
 
@@ -2947,18 +3097,18 @@ Changes from V7.3 to V7.3.1
 Bug fixes
 
   - Corrupted Field tactic and Match Context tactic construction fixed
-  - Checking of names already existing in Assert added (PR#182)
-  - Invalid argument bug in Exact tactic solved (PR#183)
-  - Colliding bound names bug fixed (PR#202)
-  - Wrong non-recursivity test for Record fixed (PR#189)
-  - Out of memory/seg fault bug related to parametric inductive fixed (PR#195)
+  - Checking of names already existing in Assert added (BZ#182)
+  - Invalid argument bug in Exact tactic solved (BZ#183)
+  - Colliding bound names bug fixed (BZ#202)
+  - Wrong non-recursivity test for Record fixed (BZ#189)
+  - Out of memory/seg fault bug related to parametric inductive fixed (BZ#195)
   - Setoid_replace/Setoid_rewrite bug wrt "==" fixed
 
 Misc
 
   - Ocaml version >= 3.06 is needed to compile Coq from sources
   - Simplification of fresh names creation strategy for Assert, Pose and
-    LetTac (PR#192)
+    LetTac (BZ#192)
 
 Changes from V7.2 to V7.3
 =========================
diff --git a/CONTRIBUTING.md b/CONTRIBUTING.md
index 05f21895e..213b87735 100644
--- a/CONTRIBUTING.md
+++ b/CONTRIBUTING.md
@@ -4,13 +4,13 @@ Thank you for your interest in contributing to Coq! There are many ways to contr
 
 ## Bug Reports
 
-Bug reports are enormously useful to identify issues with Coq; we can't fix what we don't know about. Bug reports should all be filed on the [Coq Bugzilla](https://coq.inria.fr/bugs/) (you'll have to make an account). You can file a bug for any of the following:
+Bug reports are enormously useful to identify issues with Coq; we can't fix what we don't know about. To report a bug, please open an issue in the [Coq issue tracker](https://github.com/coq/coq/issues) (you'll need a GitHub account). You can file a bug for any of the following:
 
 - An anomaly. These are always considered bugs, so Coq will even ask you to file a bug report!
 - An error you didn't expect. If you're not sure whether it's a bug or intentional, feel free to file a bug anyway. We may want to improve the documentation or error message.
 - Missing documentation. It's helpful to track where the documentation should be improved, so please file a bug if you can't find or don't understand some bit of documentation.
 - An error message that wasn't as helpful as you'd like. Bonus points for suggesting what information would have helped you.
-- Bugs in CoqIDE should also be filed on the Bugzilla. Bugs in the Emacs plugin should be filed against [ProofGeneral](https://github.com/ProofGeneral/PG/issues), or against [company-coq](https://github.com/cpitclaudel/company-coq/issues) if they are specific to company-coq features.
+- Bugs in CoqIDE should also be filed in the [Coq issue tracker](https://github.com/coq/coq/issues). Bugs in the Emacs plugin should be filed against [ProofGeneral](https://github.com/ProofGeneral/PG/issues), or against [company-coq](https://github.com/cpitclaudel/company-coq/issues) if they are specific to company-coq features.
 
 It would help if you search the existing issues before reporting a bug. This can be difficult, so consider it extra credit. We don't mind duplicate bug reports.
 
@@ -26,30 +26,44 @@ Documentation for getting started with the Coq sources is located in various fil
 
 Please make pull requests against the `master` branch.
 
-It's helpful to run the Coq test suite with `make test-suite` before submitting your change. Travis CI runs this test suite and a much larger one including external Coq developments on every pull request, but these results take significantly longer to come back (on the order of a few hours). Running the test suite locally will take somewhere around 10-15 minutes.
+If it's your first significant contribution to Coq (significant means: more than fixing a typo), your pull request should include a commit adding your name to the [`CREDITS`](/CREDITS) file (possibly with the name of your institution / employer if relevant to your contribution, an ORCID if you have one —you may log into https://orcid.org/ using your institutional account to get one—, and the year of your contribution).
+
+It's helpful to run the Coq test suite with `make test-suite` before submitting your change. Travis CI runs this test suite and a much larger one including external Coq developments on every pull request, but these results take significantly longer to come back (on the order of a few hours). Running the test suite locally will take somewhere around 10-15 minutes. Refer to [`dev/ci/README.md`](/dev/ci/README.md#information-for-developers) for more information on Travis CI tests.
+
+If your pull request fixes a bug, please consider adding a regression test as well. See [`test-suite/README.md`](/test-suite/README.md) for how to do so.
 
 Don't be alarmed if the pull request process takes some time. It can take a few days to get feedback, approval on the final changes, and then a merge. Coq doesn't release new versions very frequently so it can take a few months for your change to land in a released version. That said, you can start using the latest Coq `master` branch to take advantage of all the new features, improvements, and fixes.
 
+Whitespace discipline (do not indent using tabs, no trailing spaces, text files end with newlines) is checked by Travis (using `git diff --check`). We ship a [`dev/tools/pre-commit`](/dev/tools/pre-commit) git hook which fixes these errors at commit time. `configure` automatically sets you up to use it, unless you already have a hook at `.git/hooks/pre-commit`.
+
 Here are a few tags Coq developers may add to your PR and what they mean. In general feedback and requests for you as the pull request author will be in the comments and tags are only used to organize pull requests.
 
 - [needs: rebase](https://github.com/coq/coq/pulls?utf8=%E2%9C%93&q=is%3Aopen%20is%3Apr%20label%3A%22needs%3A%20rebase%22%20) indicates the PR should be rebased on top of the latest `master` branch. See the [GitHub documentation](https://help.github.com/articles/about-git-rebase/) for a brief introduction to using `git rebase`.
 - [needs: fixing](https://github.com/coq/coq/pulls?q=is%3Aopen+is%3Apr+label%3A%22needs%3A+fixing%22) indicates the PR needs a fix, as discussed in the comments.
 - [needs: testing](https://github.com/coq/coq/pulls?q=is%3Aopen+is%3Apr+label%3A%22needs%3A+testing%22) indicates the PR needs testing. This is often used when testing beyond what the test suite can handle is required. For example, performance benchmarking is currently performed with a different infrastructure. Unless some followup is specifically requested you aren't expected to do this additional testing.
 
+The release manager uses the following filter to know which PRs seem ready for merge. If you are waiting for a PR to be merged, make sure it appears in this list:
+
+- [Pull requests ready for merge](https://github.com/coq/coq/pulls?utf8=%E2%9C%93&q=is%3Apr%20is%3Aopen%20-label%3A%22needs%3A%20discussion%22%20-label%3A%22needs%3A%20testing%22%20-label%3A%22needs%3A%20fixing%22%20-label%3A%22needs%3A%20progress%22%20-label%3A%22needs%3A%20rebase%22%20-label%3A%22needs%3A%20review%22%20-label%3A%22needs%3A%20help%22%20-label%3A%22needs%3A%20independent%20fix%22%20-label%3A%22needs%3A%20feedback%22%20-label%3A%22help%20wanted%22%20-review%3Achanges_requested%20-status%3Apending%20base%3Amaster%20sort%3Aupdated-asc%20-label%3A%22needs%3A%20squashing%22%20)
+
 ## Documentation
 
 Currently the process for contributing to the documentation is the same as for changing anything else in Coq, so please submit a pull request as described above.
 
-Bugzilla includes a component to mark bugs related to documentation. You can view a list of documentation-related bugs using a [Bugzilla search](https://coq.inria.fr/bugs/buglist.cgi?component=Doc&list_id=455006&product=Coq&resolution=---). Many of these bugs can be fixed by contributing writing, without knowledge of Coq's OCaml source code.
+Our issue tracker includes a flag to mark bugs related to documentation. You can view a list of documentation-related bugs using a [GitHub issue search](https://github.com/coq/coq/issues?q=is%3Aopen+is%3Aissue+label%3A%22kind%3A+documentation%22). Many of these bugs can be fixed by contributing writing, without knowledge of Coq's OCaml source code.
 
 The sources for the [Coq reference manual](https://coq.inria.fr/distrib/current/refman/) are at [`doc/refman`](/doc/refman). These are written in LaTeX and compiled to HTML with [HeVeA](http://hevea.inria.fr/).
 
+You may also contribute to the informal documentation available in [Cocorico](https://github.com/coq/coq/wiki) (the Coq wiki), and the [Coq FAQ](https://github.com/coq/coq/wiki/The-Coq-FAQ). Both of these are editable by anyone with a GitHub account.
+
 ## Contributing outside this repository
 
 There are many useful ways to contribute to the Coq ecosystem that don't involve the Coq repository.
 
 Tutorials to teach Coq, and especially to teach particular advanced features, would be much appreciated. Some tutorials are listed on the [Coq website](https://coq.inria.fr/documentation). If you would like to add a link to this list, please make a pull request against the Coq website repository at https://github.com/coq/www.
 
+External plugins / libraries contribute to create a successful ecosystem around Coq. If your external development is mature enough, you may consider submitting it for addition to our CI tests. Refer to [`dev/ci/README.md`](/dev/ci/README.md) for more information.
+
 Ask and answer questions on [Stack Exchange](https://stackexchange.com/filters/299857/questions-tagged-coq-on-stackexchange-sites) which has a helpful community of Coq users.
 
 Hang out on the Coq IRC channel, `irc://irc.freenode.net/#coq`, and help answer questions.
diff --git a/COPYRIGHT b/COPYRIGHT
deleted file mode 100644
index fc4b7baa4..000000000
--- a/COPYRIGHT
+++ /dev/null
@@ -1,15 +0,0 @@
-                     The Coq proof assistant
-
-Copyright 1999-2016 The Coq development team, INRIA, CNRS, University
-Paris Sud, University Paris 7, Ecole Polytechnique.
-
-This product includes also software developed by
-  Pierre Crégut, France Telecom R & D (plugins/omega and plugins/romega)
-  Pierre Courtieu and Julien Forest, CNAM (plugins/funind)
-  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 c6848648e..8675b1a64 100644
--- a/CREDITS
+++ b/CREDITS
@@ -1,13 +1,16 @@
 The "Coq proof assistant" was jointly developed by
-- INRIA Formel, Coq, LogiCal, ProVal, TypiCal, Marelle, pi.r2 projects
-  (starting 1985),
+- INRIA Formel, Coq, LogiCal, ProVal, TypiCal, Marelle,
+  pi.r2, Ascola, Galinette projects (starting 1985),
 - Laboratoire de l'Informatique du Parallelisme (LIP)
   associated to CNRS and ENS Lyon (Sep. 1989 to Aug. 1997),
 - Laboratoire de Recherche en Informatique (LRI)
   associated to CNRS and university Paris Sud (since Sep. 1997),
 - Laboratoire d'Informatique de l'Ecole Polytechnique (LIX)
   associated to CNRS and Ecole Polytechnique (since Jan. 2003).
-- Laboratoire PPS associated to CNRS and university Paris 7 (since Jan. 2009).
+- Laboratoire PPS associated to CNRS and University Paris Diderot
+  (Jan. 2009 - Dec. 2015 when it was merged into IRIF).
+- Institut de Recherche en Informatique Fondamentale (IRIF),
+  associated to CNRS and University Paris Diderot (since Jan. 2016).
 
 All files of the "Coq proof assistant" in directories or sub-directories of
 
@@ -15,8 +18,8 @@ All files of the "Coq proof assistant" in directories or sub-directories of
   scripts states tactics test-suite theories tools toplevel
 
 are distributed under the terms of the GNU Lesser General Public License
-Version 2.1 (see file LICENSE). These files are COPYRIGHT 1999-2010,
-The Coq development team, CNRS, INRIA and Université Paris Sud.
+Version 2.1 (see file LICENSE). These files are COPYRIGHT 1999-2017,
+The Coq development team, INRIA, CNRS, LIX, LRI, PPS.
 
 Files from the directory doc are distributed as indicated in file doc/LICENCE.
 
@@ -37,13 +40,18 @@ plugins/firstorder
 plugins/fourier
   developed by Loïc Pottier (INRIA-Lemme, 2001)
 plugins/funind
-  developed by Pierre Courtieu (INRIA-Lemme, 2003-2004, CNAM, 2004-2008),
-  Julien Forest (INRIA-Everest, 2006, CNAM, 2007-2008)
+  developed by Pierre Courtieu (INRIA-Lemme, 2003-2004, CNAM, 2006-now),
+  Julien Forest (INRIA-Everest, 2006, CNAM, 2007-2008, ENSIIE, 2008-now)
   and Yves Bertot (INRIA-Marelle, 2005-2006)
-plugins/omega
-  developed by Pierre Crégut (France Telecom R&D, 1996)
+plugins/micromega
+  developed by Frédéric Besson (IRISA/INRIA, 2006-now), with some
+  extensions by Evgeny Makarov (INRIA, 2007); sum-of-squares solver and
+  interface to the csdp solver uses code from John Harrison (University
+  of Cambridge, 1998)
 plugins/nsatz
   developed by Loïc Pottier (INRIA-Marelle, 2009-2011)
+plugins/omega
+  developed by Pierre Crégut (France Telecom R&D, 1996)
 plugins/quote
   developed by Patrick Loiseleur (LRI, 1997-1999)
 plugins/romega
@@ -54,16 +62,14 @@ 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/ssreflect
+  developed by Georges Gonthier (Microsoft Research - Inria Joint Centre, 2007-2011),
+  Assia Mahboubi and Enrico Tassi (Inria, 2011-now).
 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
-  developed by Frédéric Besson (IRISA/INRIA, 2006-2008), with some
-  extensions by Evgeny Makarov (INRIA, 2007); sum-of-squares solver and
-  interface to the csdp solver uses code from John Harrison (University
-  of Cambridge, 1998)
 theories/ZArith
   started by Pierre Crégut (France Telecom R&D, 1996)
 theories/Strings
@@ -94,32 +100,42 @@ of the Coq Proof assistant during the indicated time:
 
   Bruno Barras (INRIA, 1995-now)
   Yves Bertot (INRIA, 2000-now)
-  Pierre Boutillier (INRIA-PPS, 2010-now)
+  Pierre Boutillier (INRIA-PPS, 2010-2015)
   Xavier Clerc (INRIA, 2012-2014)
+  Tej Chajed (MIT, 2016-now)
   Jacek Chrzaszcz (LRI, 1998-2003)
   Thierry Coquand (INRIA, 1985-1989)
   Pierre Corbineau (LRI, 2003-2005, Nijmegen, 2005-2008, Grenoble 1, 2008-2011)
   Cristina Cornes (INRIA, 1993-1996)
   Yann Coscoy (INRIA Sophia-Antipolis, 1995-1996)
+  Pierre Courtieu (CNAM, 2006-now)
   David Delahaye (INRIA, 1997-2002)
   Maxime Dénès (INRIA, 2013-now)
-  Daniel de Rauglaudre (INRIA, 1996-1998)
+  Daniel de Rauglaudre (INRIA, 1996-1998, 2012, 2016)
   Olivier Desmettre (INRIA, 2001-2003)
   Gilles Dowek (INRIA, 1991-1994)
   Amy Felty (INRIA, 1993)
   Jean-Christophe Filliâtre (ENS Lyon, 1994-1997, LRI, 1997-2008)
+  Emilio Jesús Gallego Arias (MINES ParisTech 2015-now)
+  Gaetan Gilbert (INRIA-Galinette, 2016-now)
   Eduardo Giménez (ENS Lyon, 1993-1996, INRIA, 1997-1998)
   Stéphane Glondu (INRIA-PPS, 2007-2013)
   Benjamin Grégoire (INRIA, 2003-2011)
+  Jason Gross (MIT 2013-now)
   Hugo Herbelin (INRIA, 1996-now)
   Sébastien Hinderer (INRIA, 2014)
   Gérard Huet (INRIA, 1985-1997)
-  Pierre Letouzey (LRI, 2000-2004, PPS, 2005-2008, INRIA-PPS, 2009-now)
+  Matej Košík (INRIA, 2015-2017)
+  Pierre Letouzey (LRI, 2000-2004, PPS, 2005-2008,
+                   INRIA-PPS then IRIF, 2009-now)
   Patrick Loiseleur (Paris Sud, 1997-1999)
   Evgeny Makarov (INRIA, 2007)
+  Gregory Malecha (Harvard University 2013-2015,
+                   University of California, San Diego 2016)
+  Cyprien Mangin (INRIA-PPS then IRIF, 2015-now)
   Pascal Manoury (INRIA, 1993)
-  Micaela Mayero (INRIA, 1997-2002)
   Claude Marché (INRIA, 2003-2004 & LRI, 2004)
+  Micaela Mayero (INRIA, 1997-2002)
   Guillaume Melquiond (INRIA, 2009-now)
   Benjamin Monate (LRI, 2003)
   César Muñoz (INRIA, 1994-1995)
@@ -129,18 +145,27 @@ of the Coq Proof assistant during the indicated time:
   Catherine Parent-Vigouroux (ENS Lyon, 1992-1995)
   Christine Paulin-Mohring (INRIA, 1985-1989, ENS Lyon, 1989-1997,
                             LRI, 1997-2006)
-  Pierre-Marie Pédrot (INRIA-PPS, 2011-now)
+  Pierre-Marie Pédrot (INRIA-PPS, 2011-2015, INRIA-Ascola, 2015-2016,
+                       University of Ljubljana, 2016-2017,
+                       MPI-SWS, 2017-2018)
   Matthias Puech (INRIA-Bologna, 2008-2011)
-  Yann Régis-Gianas (INRIA-PPS, 2009-now)
+  Yann Régis-Gianas (INRIA-PPS then IRIF, 2009-now)
   Clément Renard (INRIA, 2001-2004)
   Claudio Sacerdoti Coen (INRIA, 2004-2005)
   Amokrane Saïbi (INRIA, 1993-1998)
   Vincent Siles (INRIA, 2007)
   Élie Soubiran (INRIA, 2007-2010)
   Matthieu Sozeau (INRIA, 2005-now)
-  Arnaud Spiwack (INRIA, 2006-now)
+  Arnaud Spiwack (INRIA-LIX-Chalmers University, 2006-2010,
+                  INRIA, 2011-2014, MINES ParisTech 2014-2015,
+                  Tweag/IO 2015-now)
+  Paul Steckler (MIT 2016-2018)
   Enrico Tassi (INRIA, 2011-now)
+  Amin Timany (Katholieke Universiteit Leuven, 2017)
   Benjamin Werner (INRIA, 1989-1994)
+  Nickolai Zeldovich (MIT 2014-2016)
+  Théo Zimmermann (ORCID: https://orcid.org/0000-0002-3580-8806,
+                   INRIA-PPS then IRIF, 2015-now)
 
 ***************************************************************************
 INRIA refers to:
diff --git a/INSTALL b/INSTALL
index 39fb1849a..3b3fd8b83 100644
--- a/INSTALL
+++ b/INSTALL
@@ -1,5 +1,5 @@
 
-            INSTALLATION PROCEDURES FOR THE COQ V8.6 SYSTEM
+            INSTALLATION PROCEDURES FOR THE COQ V8.7 SYSTEM
             -----------------------------------------------
 
 
@@ -27,27 +27,30 @@ WHAT DO YOU NEED ?
 
      port install coq
 
-   To compile Coq V8.6 yourself, you need:
+   To compile Coq V8.7 yourself, you need:
 
-   - OCaml version 4.02.1 or later
-     (available at http://caml.inria.fr/)
+   - OCaml version 4.02.3 or later
+     (available at https://ocaml.org/)
 
-     OCaml version 4.02.0 is not supported because of a severe performance
-     issue increasing compilation time.
+   - Findlib (version >= 1.4.1)
+     (available at http://projects.camlcity.org/projects/findlib.html)
 
-   - 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)
+   - Camlp5 (version >= 6.14)
+     (available at https://camlp5.github.io/)
 
    - GNU Make version 3.81 or later
 
    - a C compiler
 
    - for Coqide, the Lablgtk development files, and the GTK libraries
-     incuding gtksourceview, see INSTALL.ide for more details
+     including gtksourceview, see INSTALL.ide for more details
+
+   Opam (https://opam.ocaml.org/) is recommended to install ocaml and
+   the corresponding packages.
+
+   $ opam install ocamlfind camlp5 lablgtk-extras
 
+   should get you a reasonable OCaml environment to compile Coq.
 
 QUICK INSTALLATION PROCEDURE.
 =============================
@@ -125,6 +128,26 @@ INSTALLATION PROCEDURE IN DETAILS (NORMAL USERS).
 	Use <command> to open an URL in a browser. %s must appear in <command>,
 	and will be replaced by the URL.
 
+-flambda-opts <flags>
+         This experimental option will pass specific user flags to the
+        OCaml optimizing compiler. In most cases, this option is used
+        to tweak the flambda backend; we recommend using
+
+        -flambda-opts `-O3 -unbox-closures`
+
+        but of course you are free to try with a different combination
+        of flags. You can read more at
+        https://caml.inria.fr/pub/docs/manual-ocaml/flambda.html
+
+        There is a known problem with certain OCaml versions and
+        `native_compute`, that will make compilation to require
+        a large amount of RAM (>= 10GiB) in some particular files.
+
+        We recommend disabling native compilation (`-native-compiler no`)
+        with flambda unless you use a modern (>= 4.06.0) OCaml.
+
+        c.f. https://caml.inria.fr/mantis/view.php?id=7630
+
 5- Still in the root directory, do
 
 	make
diff --git a/INSTALL.ide b/INSTALL.ide
index 513e37c91..26c192baa 100644
--- a/INSTALL.ide
+++ b/INSTALL.ide
@@ -39,7 +39,7 @@ COMPILATION REQUIREMENTS
   install GTK+ 2.x, should you need to force it for one reason
   or another.)
 - The OCaml bindings for GTK+ 2.x, lablgtk2 with support for gtksourceview2.
-  You need at least version 2.16.
+  You need at least version 2.18.3.
 
   Your distribution may contain precompiled packages. For example, for
   Debian, run
@@ -57,7 +57,7 @@ COMPILATION REQUIREMENTS
         ./configure && make world && make install
 
    You must have write access to the OCaml standard library path.
-   If this fails, read lablgtk-2.14.2/README.
+   If this fails, read the README.
 
 
 INSTALLATION
diff --git a/META.coq b/META.coq
index e70b8e28d..d180820e8 100644
--- a/META.coq
+++ b/META.coq
@@ -23,20 +23,28 @@ package "config" (
 
 )
 
+package "clib" (
+  description = "Base General Coq Library"
+  version     = "8.7"
+
+  directory   = "clib"
+  requires    = "str, unix, threads"
+
+  archive(byte)    = "clib.cma"
+  archive(native)  = "clib.cmxa"
+)
+
 package "lib" (
 
-  description = "Base Coq Library"
+  description = "Base Coq-Specific Library"
   version     = "8.7"
 
   directory   = "lib"
 
-  requires         = "coq.config"
+  requires    = "coq.clib, coq.config"
 
-  archive(byte)    = "clib.cma"
-  archive(byte)   += "lib.cma"
-
-  archive(native)  = "clib.cmxa"
-  archive(native) += "lib.cmxa"
+  archive(byte)   = "lib.cma"
+  archive(native) = "lib.cmxa"
 
 )
 
@@ -47,13 +55,17 @@ package "vm" (
 
   directory        = "kernel/byterun"
 
-# We should generate this file at configure time for local byte builds
-# to work properly.
-
-# Enable this setting for local byte builds, disabling the one below.
+# We could generate this file at configure time for the share byte
+# build path to work properly.
+#
+# Enable this setting for local byte builds if you want dynamic linking:
+#
 #  linkopts(byte)   = "-dllpath path_to_coq/kernel/byterun/ -dllib -lcoqrun"
 
-  linkopts(byte)   = "-dllib -lcoqrun"
+# We currently prefer static linking of the VM.
+  archive(byte)    = "libcoqrun.a"
+  linkopts(byte)   = "-custom"
+
   linkopts(native) = "-cclib -lcoqrun"
 
 )
@@ -65,7 +77,7 @@ package "kernel" (
 
   directory   = "kernel"
 
-  requires    = "coq.lib, coq.vm"
+  requires    = "dynlink, coq.lib, coq.vm"
 
   archive(byte)    = "kernel.cma"
   archive(native)  = "kernel.cmxa"
@@ -168,7 +180,7 @@ package "parsing" (
   description = "Coq Parsing Engine"
   version     = "8.7"
 
-  requires    = "coq.proofs"
+  requires    = "camlp5.gramlib, coq.proofs"
   directory   = "parsing"
 
   archive(byte)    = "parsing.cma"
@@ -254,6 +266,7 @@ package "idetop" (
 
 )
 
+# XXX Depends on way less than toplevel
 package "ide" (
 
   description = "Coq IDE Libraries"
@@ -268,43 +281,299 @@ package "ide" (
 
 )
 
-# XXX: Remove the dependency on toplevel (due to Coqinit use for compat flags)
-package "highparsing" (
+package "plugins" (
 
-  description = "Coq Extra Parsing"
+  description = "Coq built-in plugins"
   version     = "8.7"
 
-  requires    = "coq.toplevel"
-  directory   = "parsing"
+  directory   = "plugins"
 
-  archive(byte)    = "highparsing.cma"
-  archive(native)  = "highparsing.cmxa"
+  package "ltac" (
 
-)
+    description = "Coq LTAC Plugin"
+    version     = "8.7"
 
-# XXX: API should depend only on stm.
-package "API" (
+    requires    = "coq.stm"
+    directory   = "ltac"
 
-  description = "Coq API"
-  version     = "8.7"
+    archive(byte)    = "ltac_plugin.cmo"
+    archive(native)  = "ltac_plugin.cmx"
 
-  requires    = "coq.highparsing"
-  directory   = "API"
+  )
 
-  archive(byte)    = "API.cma"
-  archive(native)  = "API.cmxa"
+  package "tauto" (
 
-)
+    description = "Coq tauto plugin"
+    version     = "8.7"
 
-package "ltac" (
+    requires    = "coq.plugins.ltac"
+    directory   = "ltac"
 
-  description = "Coq LTAC Plugin"
-  version     = "8.7"
+    archive(byte)    = "tauto_plugin.cmo"
+    archive(native)  = "tauto_plugin.cmx"
+  )
+
+  package "omega" (
+
+    description = "Coq omega plugin"
+    version     = "8.7"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "omega"
+
+    archive(byte)    = "omega_plugin.cmo"
+    archive(native)  = "omega_plugin.cmx"
+  )
+
+  package "romega" (
+
+    description = "Coq romega plugin"
+    version     = "8.7"
+
+    requires    = "coq.plugins.omega"
+    directory   = "romega"
+
+    archive(byte)    = "romega_plugin.cmo"
+    archive(native)  = "romega_plugin.cmx"
+  )
+
+  package "micromega" (
+
+    description = "Coq micromega plugin"
+    version     = "8.7"
+
+    requires    = "num,coq.plugins.ltac"
+    directory   = "micromega"
+
+    archive(byte)    = "micromega_plugin.cmo"
+    archive(native)  = "micromega_plugin.cmx"
+  )
+
+  package "quote" (
+
+    description = "Coq quote plugin"
+    version     = "8.7"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "quote"
+
+    archive(byte)    = "quote_plugin.cmo"
+    archive(native)  = "quote_plugin.cmx"
+  )
+
+  package "newring" (
+
+    description = "Coq newring plugin"
+    version     = "8.7"
+
+    requires    = "coq.plugins.quote"
+    directory   = "setoid_ring"
+
+    archive(byte)    = "newring_plugin.cmo"
+    archive(native)  = "newring_plugin.cmx"
+  )
+
+  package "fourier" (
+
+    description = "Coq fourier plugin"
+    version     = "8.7"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "fourier"
+
+    archive(byte)    = "fourier_plugin.cmo"
+    archive(native)  = "fourier_plugin.cmx"
+  )
+
+  package "extraction" (
+
+    description = "Coq extraction plugin"
+    version     = "8.7"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "extraction"
+
+    archive(byte)    = "extraction_plugin.cmo"
+    archive(native)  = "extraction_plugin.cmx"
+  )
+
+  package "cc" (
+
+    description = "Coq cc plugin"
+    version     = "8.7"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "cc"
+
+    archive(byte)    = "cc_plugin.cmo"
+    archive(native)  = "cc_plugin.cmx"
+  )
+
+  package "ground" (
+
+    description = "Coq ground plugin"
+    version     = "8.7"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "firstorder"
+
+    archive(byte)    = "ground_plugin.cmo"
+    archive(native)  = "ground_plugin.cmx"
+  )
+
+  package "rtauto" (
+
+    description = "Coq rtauto plugin"
+    version     = "8.7"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "rtauto"
+
+    archive(byte)    = "rtauto_plugin.cmo"
+    archive(native)  = "rtauto_plugin.cmx"
+  )
+
+  package "btauto" (
+
+    description = "Coq btauto plugin"
+    version     = "8.7"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "btauto"
+
+    archive(byte)    = "btauto_plugin.cmo"
+    archive(native)  = "btauto_plugin.cmx"
+  )
+
+  package "recdef" (
+
+    description = "Coq recdef plugin"
+    version     = "8.7"
+
+    requires    = "coq.plugins.extraction"
+    directory   = "funind"
+
+    archive(byte)    = "recdef_plugin.cmo"
+    archive(native)  = "recdef_plugin.cmx"
+  )
+
+  package "nsatz" (
+
+    description = "Coq nsatz plugin"
+    version     = "8.7"
+
+    requires    = "num,coq.plugins.ltac"
+    directory   = "nsatz"
+
+    archive(byte)    = "nsatz_plugin.cmo"
+    archive(native)  = "nsatz_plugin.cmx"
+  )
+
+  package "natsyntax" (
+
+    description = "Coq natsyntax plugin"
+    version     = "8.7"
+
+    requires    = ""
+    directory   = "syntax"
+
+    archive(byte)    = "nat_syntax_plugin.cmo"
+    archive(native)  = "nat_syntax_plugin.cmx"
+  )
+
+  package "zsyntax" (
+
+    description = "Coq zsyntax plugin"
+    version     = "8.7"
+
+    requires    = ""
+    directory   = "syntax"
+
+    archive(byte)    = "z_syntax_plugin.cmo"
+    archive(native)  = "z_syntax_plugin.cmx"
+  )
+
+  package "rsyntax" (
+
+    description = "Coq rsyntax plugin"
+    version     = "8.7"
+
+    requires    = ""
+    directory   = "syntax"
+
+    archive(byte)    = "r_syntax_plugin.cmo"
+    archive(native)  = "r_syntax_plugin.cmx"
+  )
+
+  package "int31syntax" (
+
+    description = "Coq int31syntax plugin"
+    version     = "8.7"
+
+    requires    = ""
+    directory   = "syntax"
+
+    archive(byte)    = "int31_syntax_plugin.cmo"
+    archive(native)  = "int31_syntax_plugin.cmx"
+  )
+
+  package "asciisyntax" (
+
+    description = "Coq asciisyntax plugin"
+    version     = "8.7"
+
+    requires    = ""
+    directory   = "syntax"
+
+    archive(byte)    = "ascii_syntax_plugin.cmo"
+    archive(native)  = "ascii_syntax_plugin.cmx"
+  )
+
+  package "stringsyntax" (
+
+    description = "Coq stringsyntax plugin"
+    version     = "8.7"
+
+    requires    = "coq.plugins.asciisyntax"
+    directory   = "syntax"
+
+    archive(byte)    = "string_syntax_plugin.cmo"
+    archive(native)  = "string_syntax_plugin.cmx"
+  )
+
+  package "derive" (
+
+    description = "Coq derive plugin"
+    version     = "8.7"
+
+    requires    = ""
+    directory   = "derive"
+
+    archive(byte)    = "derive_plugin.cmo"
+    archive(native)  = "derive_plugin.cmx"
+  )
+
+  package "ssrmatching" (
+
+    description = "Coq ssrmatching plugin"
+    version     = "8.7"
+
+    requires    = "coq.plugins.ltac"
+    directory   = "ssrmatching"
+
+    archive(byte)    = "ssrmatching_plugin.cmo"
+    archive(native)  = "ssrmatching_plugin.cmx"
+  )
+
+  package "ssreflect" (
 
-  requires    = "coq.API"
-  directory   = "plugins/ltac"
+    description = "Coq ssreflect plugin"
+    version     = "8.7"
 
-  archive(byte)    = "ltac_plugin.cmo"
-  archive(native)  = "ltac_plugin.cmx"
+    requires    = "coq.plugins.ssrmatching"
+    directory   = "ssr"
 
+    archive(byte)    = "ssreflect_plugin.cmo"
+    archive(native)  = "ssreflect_plugin.cmx"
+  )
 )
diff --git a/Makefile b/Makefile
index 82595a6e6..0c9bccc83 100644
--- a/Makefile
+++ b/Makefile
@@ -15,7 +15,7 @@
 # You won't find Makefiles in sub-directories and this is done on purpose.
 # If you are not yet convinced of the advantages of a single Makefile, please
 # read
-#    http://miller.emu.id.au/pmiller/books/rmch/
+#    http://aegis.sourceforge.net/auug97.pdf
 # before complaining.
 #
 # When you are working in a subdir, you can compile without moving to the
@@ -54,6 +54,7 @@ FIND_SKIP_DIRS:='(' \
   -name "$${GIT_DIR}" -o \
   -name '_build' -o \
   -name '_build_ci' -o \
+  -name '_install_ci' -o \
   -name 'user-contrib' -o \
   -name 'coq-makefile' -o \
   -name '.opamcache' -o \
@@ -86,7 +87,7 @@ EXISTINGMLI := $(call find, '*.mli')
 ## Files that will be generated
 
 GENML4FILES:= $(ML4FILES:.ml4=.ml)
-export GENMLFILES:=$(LEXFILES:.mll=.ml) tools/tolink.ml kernel/copcodes.ml
+export GENMLFILES:=$(LEXFILES:.mll=.ml) kernel/copcodes.ml
 export GENHFILES:=kernel/byterun/coq_jumptbl.h
 export GENFILES:=$(GENMLFILES) $(GENMLIFILES) $(GENHFILES)
 
@@ -138,19 +139,10 @@ endif
 # This should help preventing weird compilation failures caused by leftover
 # compiled files after deleting or moving some source files.
 
-ifeq (,$(findstring clean,$(MAKECMDGOALS))) # Skip this for 'make clean' and alii
-ifndef ACCEPT_ALIEN_VO
 EXISTINGVO:=$(call find, '*.vo')
 KNOWNVO:=$(patsubst %.v,%.vo,$(call find, '*.v'))
 ALIENVO:=$(filter-out $(KNOWNVO),$(EXISTINGVO))
-ifdef ALIENVO
-$(error Leftover compiled Coq files without known sources: $(ALIENVO); \
-remove them first, for instance via 'make voclean' \
-(or skip this check via 'make ACCEPT_ALIEN_VO=1'))
-endif
-endif
 
-ifndef ACCEPT_ALIEN_OBJ
 EXISTINGOBJS:=$(call find, '*.cm[oxia]' -o -name '*.cmxa')
 KNOWNML:=$(EXISTINGML) $(GENMLFILES) $(GENML4FILES) $(MLPACKFILES:.mlpack=.ml) \
  $(patsubst %.mlp,%.ml,$(wildcard grammar/*.mlp))
@@ -158,9 +150,20 @@ KNOWNOBJS:=$(KNOWNML:.ml=.cmo) $(KNOWNML:.ml=.cmx) $(KNOWNML:.ml=.cmi) \
  $(MLIFILES:.mli=.cmi) \
  $(MLLIBFILES:.mllib=.cma) $(MLLIBFILES:.mllib=.cmxa) grammar/grammar.cma
 ALIENOBJS:=$(filter-out $(KNOWNOBJS),$(EXISTINGOBJS))
+
+ifeq (,$(findstring clean,$(MAKECMDGOALS))) # Skip this for 'make clean' and alii
+ifndef ACCEPT_ALIEN_VO
+ifdef ALIENVO
+$(error Leftover compiled Coq files without known sources: $(ALIENVO); \
+remove them first, for instance via 'make voclean' or 'make alienclean' \
+(or skip this check via 'make ACCEPT_ALIEN_VO=1'))
+endif
+endif
+
+ifndef ACCEPT_ALIEN_OBJ
 ifdef ALIENOBJS
 $(error Leftover compiled OCaml files without known sources: $(ALIENOBJS); \
-remove them first, for instance via 'make clean' \
+remove them first, for instance via 'make clean' or 'make alienclean' \
 (or skip this check via 'make ACCEPT_ALIEN_OBJ=1'))
 endif
 endif
@@ -195,7 +198,7 @@ Makefile $(wildcard Makefile.*) config/Makefile : ;
 # Cleaning
 ###########################################################################
 
-.PHONY: clean cleankeepvo objclean cruftclean indepclean docclean archclean optclean clean-ide ml4clean depclean cleanconfig distclean voclean timingclean devdocclean
+.PHONY: clean cleankeepvo objclean cruftclean indepclean docclean archclean optclean clean-ide ml4clean depclean cleanconfig distclean voclean timingclean devdocclean alienclean
 
 clean: objclean cruftclean depclean docclean devdocclean
 
@@ -230,8 +233,7 @@ docclean:
 	  doc/stdlib/*Library.coqdoc.tex doc/stdlib/library.files \
 	  doc/stdlib/library.files.ls doc/stdlib/FullLibrary.tex
 	rm -f doc/*/*.ps doc/*/*.pdf doc/*/*.eps doc/*/*.pdf_t doc/*/*.eps_t
-	rm -f doc/faq/axioms.png
-	rm -rf doc/refman/html doc/stdlib/html doc/faq/html doc/tutorial/tutorial.v.html
+	rm -rf doc/refman/html doc/stdlib/html doc/tutorial/tutorial.v.html
 	rm -f doc/refman/euclid.ml doc/refman/euclid.mli
 	rm -f doc/refman/heapsort.ml doc/refman/heapsort.mli
 	rm -f doc/common/version.tex
@@ -243,7 +245,7 @@ archclean: clean-ide optclean voclean
 	rm -f $(ALLSTDLIB).*
 
 optclean:
-	rm -f $(COQTOPEXE) $(COQMKTOP) $(CHICKEN)
+	rm -f $(COQTOPEXE) $(CHICKEN)
 	rm -f $(TOOLS) $(PRIVATEBINARIES) $(CSDPCERT)
 	find . -name '*.cmx' -o -name '*.cmx[as]' -o -name '*.[soa]' -o -name '*.so' | xargs rm -f
 
@@ -264,7 +266,7 @@ cacheclean:
 	find theories plugins test-suite -name '.*.aux' -delete
 
 cleanconfig:
-	rm -f config/Makefile config/coq_config.ml myocamlbuild_config.ml dev/ocamldebug-coq dev/camlp4.dbg config/Info-*.plist
+	rm -f config/Makefile config/coq_config.ml myocamlbuild_config.ml dev/ocamldebug-coq dev/camlp5.dbg config/Info-*.plist
 
 distclean: clean cleanconfig cacheclean timingclean
 
@@ -281,6 +283,9 @@ devdocclean:
 	rm -f $(OCAMLDOCDIR)/ocamldoc.sty $(OCAMLDOCDIR)/coq.tex
 	rm -f $(OCAMLDOCDIR)/html/*.html
 
+alienclean:
+	rm -f $(ALIENOBJS) $(ALIENVO)
+
 ###########################################################################
 # Continuous Intregration Tests
 ###########################################################################
diff --git a/Makefile.build b/Makefile.build
index 26a40c6cc..39d177a13 100644
--- a/Makefile.build
+++ b/Makefile.build
@@ -147,8 +147,14 @@ endif
 # 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).
 
+VDFILE := .vfiles
+MLDFILE := .mlfiles
+PLUGMLDFILE := plugins/.mlfiles
+MLLIBDFILE := .mllibfiles
+PLUGMLLIBDFILE := plugins/.mllibfiles
+
 DEPENDENCIES := \
- $(addsuffix .d, $(MLFILES) $(MLIFILES) $(MLLIBFILES) $(MLPACKFILES) $(CFILES) $(VFILES))
+ $(addsuffix .d, $(MLDFILE) $(MLLIBDFILE) $(PLUGMLDFILE) $(PLUGMLLIBDFILE) $(CFILES) $(VDFILE))
 
 -include $(DEPENDENCIES)
 
@@ -189,15 +195,15 @@ TIMER=$(if $(TIMED), $(STDTIME), $(TIMECMD))
 COQOPTS=$(NATIVECOMPUTE)
 BOOTCOQC=$(TIMER) $(COQTOPBEST) -boot $(COQOPTS) -compile
 
-LOCALINCLUDES=$(if $(filter plugins/%,$<),-I lib -I API -open API $(addprefix -I plugins/,$(PLUGINDIRS)),$(addprefix -I ,$(SRCDIRS)))
-MLINCLUDES=$(LOCALINCLUDES) -I $(MYCAMLP4LIB)
+LOCALINCLUDES=$(addprefix -I ,$(SRCDIRS))
+MLINCLUDES=$(LOCALINCLUDES) -I $(MYCAMLP5LIB)
 
 OCAMLC := $(OCAMLFIND) ocamlc $(CAMLFLAGS)
 OCAMLOPT := $(OCAMLFIND) opt $(CAMLFLAGS)
 
-BYTEFLAGS=-thread $(CAMLDEBUG) $(USERFLAGS)
-OPTFLAGS=-thread $(CAMLDEBUGOPT) $(CAMLTIMEPROF) $(USERFLAGS)
-DEPFLAGS=$(LOCALINCLUDES)$(if $(filter plugins/%,$<),, -I ide -I ide/utils)
+BYTEFLAGS=$(CAMLDEBUG) $(USERFLAGS)
+OPTFLAGS=$(CAMLDEBUGOPT) $(CAMLTIMEPROF) $(USERFLAGS) $(FLAMBDA_FLAGS)
+DEPFLAGS=$(LOCALINCLUDES)$(if $(filter plugins/%,$@),, -I ide -I ide/utils)
 
 # On MacOS, the binaries are signed, except our private ones
 ifeq ($(shell which codesign > /dev/null 2>&1 && echo $(ARCH)),Darwin)
@@ -228,20 +234,19 @@ 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)) $^)
+$(OCAMLOPT) $(MLINCLUDES) $(OPTFLAGS) $(LINKMETADATA) -o $@ -linkpkg $(1) $^ && $(STRIP) $@ && $(CODESIGN) $@,\
+$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) $(CUSTOM) -o $@ -linkpkg $(1) $^)
 endef
 
 # Camlp5 settings
 
-CAMLP4DEPS:=grammar/grammar.cma
-CAMLP4USE=pa_extend.cmo q_MLast.cmo pa_macro.cmo -D$(CAMLVERSION)
+CAMLP5DEPS:=grammar/grammar.cma
+CAMLP5USE=pa_extend.cmo q_MLast.cmo pa_macro.cmo -D$(CAMLVERSION)
 
 PR_O := $(if $(READABLE_ML4),pr_o.cmo,pr_dump.cmo)
 
-SYSMOD:=str unix dynlink threads
-SYSCMA:=$(addsuffix .cma,$(SYSMOD))
-SYSCMXA:=$(addsuffix .cmxa,$(SYSMOD))
+# Main packages linked by Coq.
+SYSMOD:=-package num,str,unix,dynlink,threads
 
 # We do not repeat the dependencies already in SYSMOD here
 P4CMA:=gramlib.cma
@@ -302,7 +307,7 @@ kernel/byterun/coq_jumptbl.h : kernel/byterun/coq_instruct.h
                -e '/^}/q' $< $(TOTARGET)
 
 kernel/copcodes.ml: kernel/byterun/coq_instruct.h
-	sed -n -e '/^enum/p' -e 's/,//g' -e '/^  /p' $< | \
+	tr -d "\r" < $< | sed -n -e '/^enum/p' -e 's/,//g' -e '/^  /p' | \
 	awk -f kernel/make-opcodes $(TOTARGET)
 
 %.o: %.c
@@ -340,14 +345,14 @@ grammar/vernacextend.cmo : $(GRAMBASEDEPS) grammar/tacextend.cmo \
 ## Ocaml compiler with the right options and -I for grammar
 
 GRAMC := $(OCAMLFIND) ocamlc $(CAMLFLAGS) $(CAMLDEBUG) $(USERFLAGS) \
- -I $(MYCAMLP4LIB) -I grammar
+ -I $(MYCAMLP5LIB) -I grammar
 
 ## Specific rules for grammar.cma
 
 grammar/grammar.cma : $(GRAMCMO)
 	$(SHOW)'Testing $@'
 	@touch grammar/test.mlp
-	$(HIDE)$(GRAMC) -pp '$(CAMLP4O) -I $(MYCAMLP4LIB) $^ -impl' -impl grammar/test.mlp -o grammar/test
+	$(HIDE)$(GRAMC) -pp '$(CAMLP5O) -I $(MYCAMLP5LIB) $^ -impl' -impl grammar/test.mlp -o grammar/test
 	@rm -f grammar/test.* grammar/test
 	$(SHOW)'OCAMLC -a $@'
 	$(HIDE)$(GRAMC) $^ -linkall -a -o $@
@@ -356,7 +361,7 @@ grammar/grammar.cma : $(GRAMCMO)
 
 COMPATCMO:=
 GRAMP4USE:=$(COMPATCMO) pa_extend.cmo q_MLast.cmo pa_macro.cmo -D$(CAMLVERSION)
-GRAMPP:=$(CAMLP4O) -I $(MYCAMLP4LIB) $(GRAMP4USE) $(CAMLP4COMPAT) -impl
+GRAMPP:=$(CAMLP5O) -I $(MYCAMLP5LIB) $(GRAMP4USE) $(CAMLP5COMPAT) -impl
 
 ## Rules for standard .mlp and .mli files in grammar/
 
@@ -370,19 +375,30 @@ grammar/%.cmi: grammar/%.mli
 
 
 ###########################################################################
-# Main targets (coqmktop, coqtop.opt, coqtop.byte)
+# Main targets (coqtop.opt, coqtop.byte)
 ###########################################################################
 
 .PHONY: coqbinaries coqbyte
 
-coqbinaries: $(COQMKTOP) $(COQTOPEXE) $(CHICKEN) $(CSDPCERT) $(FAKEIDE)
+coqbinaries: $(COQTOPEXE) $(CHICKEN) $(CSDPCERT) $(FAKEIDE)
 
 coqbyte: $(COQTOPBYTE) $(CHICKENBYTE)
 
+COQTOP_OPT_MLTOP=toplevel/coqtop_opt_bin.cmx
+COQTOP_BYTE_MLTOP=toplevel/coqtop_byte_bin.cmo
+
+$(COQTOP_BYTE_MLTOP): toplevel/coqtop_byte_bin.ml
+	$(SHOW)'OCAMLC    $<'
+	$(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) -package compiler-libs.toplevel -c $<
+
 ifeq ($(BEST),opt)
-$(COQTOPEXE): $(COQMKTOP) $(LINKCMX) $(LIBCOQRUN) $(TOPLOOPCMA:.cma=.cmxs)
+$(COQTOPEXE): $(LINKCMX) $(LIBCOQRUN) $(TOPLOOPCMA:.cma=.cmxs) $(COQTOP_OPT_MLTOP)
 	$(SHOW)'COQMKTOP -o $@'
-	$(HIDE)$(COQMKTOP) -boot -opt $(OPTFLAGS) $(LINKMETADATA) -o $@
+	$(HIDE)$(OCAMLOPT) -linkall -linkpkg -I toplevel \
+	                   -I kernel/byterun/ -cclib -lcoqrun \
+                           $(SYSMOD) -package camlp5.gramlib \
+	                   $(LINKCMX) $(OPTFLAGS) $(LINKMETADATA) \
+	                   $(COQTOP_OPT_MLTOP) toplevel/coqtop_bin.ml -o $@
 	$(STRIP) $@
 	$(CODESIGN) $@
 else
@@ -390,31 +406,21 @@ $(COQTOPEXE): $(COQTOPBYTE)
 	cp $< $@
 endif
 
-$(COQTOPBYTE): $(COQMKTOP) $(LINKCMO) $(LIBCOQRUN) $(TOPLOOPCMA)
+# VMBYTEFLAGS will either contain -custom of the right -dllpath for the VM
+$(COQTOPBYTE): $(LINKCMO) $(LIBCOQRUN) $(TOPLOOPCMA) $(COQTOP_BYTE_MLTOP)
 	$(SHOW)'COQMKTOP -o $@'
-	$(HIDE)$(COQMKTOP) -boot -top $(BYTEFLAGS) -o $@
-
-# coqmktop
-
-COQMKTOPCMO:=lib/clib.cma lib/cErrors.cmo tools/tolink.cmo tools/coqmktop.cmo
-
-$(COQMKTOP): $(call bestobj, $(COQMKTOPCMO))
-	$(SHOW)'OCAMLBEST -o $@'
-	$(HIDE)$(call bestocaml, $(OSDEPLIBS), $(SYSMOD))
-
-tools/tolink.ml: Makefile.build Makefile.common
-	$(SHOW)"ECHO... >" $@
-	$(HIDE)echo "let copts = \"-cclib -lcoqrun\"" > $@
-	$(HIDE)echo "let core_libs = \""$(LINKCMO)"\"" >> $@
-	$(HIDE)echo "let core_objs = \""$(OBJSMOD)"\"" >> $@
+	$(HIDE)$(OCAMLC) -linkall -linkpkg -I toplevel \
+	                 -I kernel/byterun/ -cclib -lcoqrun $(VMBYTEFLAGS) \
+                         $(SYSMOD) -package camlp5.gramlib,compiler-libs.toplevel \
+	                 $(LINKCMO) $(BYTEFLAGS) \
+	                 $(COQTOP_BYTE_MLTOP) toplevel/coqtop_bin.ml -o $@
 
-# coqc
-
-COQCCMO:=lib/clib.cma lib/cErrors.cmo toplevel/usage.cmo tools/coqc.cmo
+# For coqc
+COQCCMO:=clib/clib.cma lib/lib.cma toplevel/usage.cmo tools/coqc.cmo
 
 $(COQC): $(call bestobj, $(COQCCMO))
 	$(SHOW)'OCAMLBEST -o $@'
-	$(HIDE)$(call bestocaml, $(OSDEPLIBS), $(SYSMOD))
+	$(HIDE)$(call bestocaml, $(SYSMOD))
 
 ###########################################################################
 # other tools
@@ -428,91 +434,102 @@ tools: $(TOOLS) $(OCAMLLIBDEP) $(COQDEPBOOT)
 # may still be missing or not taken in account yet by make when coqdep_boot
 # is being built.
 
-COQDEPBOOTSRC := lib/minisys.cmo \
+# Remember to update the dependencies below when you add files!
+
+COQDEPBOOTSRC := \
+ clib/segmenttree.cmo clib/unicodetable.cmo clib/unicode.cmo clib/minisys.cmo \
  tools/coqdep_lexer.cmo tools/coqdep_common.cmo tools/coqdep_boot.cmo
 
-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
+clib/segmenttree.cmo : clib/segmenttree.cmi
+clib/segmenttree.cmx : clib/segmenttree.cmi
+clib/unicodetable.cmo : clib/segmenttree.cmo
+clib/unicodetable.cmx : clib/segmenttree.cmx
+clib/unicode.cmo : clib/unicodetable.cmo clib/unicode.cmi
+clib/unicode.cmx : clib/unicodetable.cmx clib/unicode.cmi
+clib/minisys.cmo : clib/unicode.cmo
+clib/minisys.cmx : clib/unicode.cmx
+tools/coqdep_lexer.cmo : clib/unicode.cmi tools/coqdep_lexer.cmi
+tools/coqdep_lexer.cmx : clib/unicode.cmx tools/coqdep_lexer.cmi
+tools/coqdep_common.cmo : clib/minisys.cmo tools/coqdep_lexer.cmi tools/coqdep_common.cmi
+tools/coqdep_common.cmx : clib/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): $(call bestobj, $(COQDEPBOOTSRC))
 	$(SHOW)'OCAMLBEST -o $@'
-	$(HIDE)$(call bestocaml, -I tools, unix)
+	$(HIDE)$(call bestocaml, -I tools -package unix)
 
 $(OCAMLLIBDEP): $(call bestobj, tools/ocamllibdep.cmo)
 	$(SHOW)'OCAMLBEST -o $@'
-	$(HIDE)$(call bestocaml, -I tools, unix)
+	$(HIDE)$(call bestocaml, -I tools -package unix)
 
 # The full coqdep (unused by this build, but distributed by make install)
 
-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
+COQDEPCMO:=clib/clib.cma lib/lib.cma tools/coqdep_lexer.cmo	\
+  tools/coqdep_common.cmo tools/coqdep.cmo
 
 $(COQDEP): $(call bestobj, $(COQDEPCMO))
 	$(SHOW)'OCAMLBEST -o $@'
-	$(HIDE)$(call bestocaml, $(OSDEPLIBS), $(SYSMOD))
+	$(HIDE)$(call bestocaml, $(SYSMOD))
 
 $(GALLINA): $(call bestobj, tools/gallina_lexer.cmo tools/gallina.cmo)
 	$(SHOW)'OCAMLBEST -o $@'
-	$(HIDE)$(call bestocaml,,)
+	$(HIDE)$(call bestocaml,)
 
-COQMAKEFILECMO:=lib/clib.cma tools/coq_makefile.cmo
+COQMAKEFILECMO:=clib/clib.cma lib/lib.cma tools/coq_makefile.cmo
 
 $(COQMAKEFILE): $(call bestobj,$(COQMAKEFILECMO))
 	$(SHOW)'OCAMLBEST -o $@'
-	$(HIDE)$(call bestocaml,,str unix threads)
+	$(HIDE)$(call bestocaml, -package str,unix,threads)
 
 $(COQTEX): $(call bestobj, tools/coq_tex.cmo)
 	$(SHOW)'OCAMLBEST -o $@'
-	$(HIDE)$(call bestocaml,,str)
+	$(HIDE)$(call bestocaml, -package str)
 
 $(COQWC): $(call bestobj, tools/coqwc.cmo)
 	$(SHOW)'OCAMLBEST -o $@'
-	$(HIDE)$(call bestocaml,,)
+	$(HIDE)$(call bestocaml, -package str)
 
-COQDOCCMO:=lib/clib.cma $(addprefix tools/coqdoc/, \
+COQDOCCMO:=clib/clib.cma lib/lib.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)
+	$(HIDE)$(call bestocaml, -package str,unix)
 
-$(COQWORKMGR): $(call bestobj, lib/clib.cma stm/coqworkmgrApi.cmo tools/coqworkmgr.cmo)
+$(COQWORKMGR): $(call bestobj, clib/clib.cma lib/lib.cma stm/spawned.cmo stm/coqworkmgrApi.cmo tools/coqworkmgr.cmo)
 	$(SHOW)'OCAMLBEST -o $@'
-	$(HIDE)$(call bestocaml,, $(SYSMOD))
+	$(HIDE)$(call bestocaml, $(SYSMOD))
 
 # fake_ide : for debugging or test-suite purpose, a fake ide simulating
 # a connection to coqtop -ideslave
 
-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/richpp.cmo ide/xmlprotocol.cmo tools/fake_ide.cmo
+FAKEIDECMO:=clib/clib.cma lib/lib.cma ide/document.cmo	\
+ ide/serialize.cmo ide/xml_lexer.cmo ide/xml_parser.cmo	\
+ ide/xml_printer.cmo ide/richpp.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)
+	$(HIDE)$(call bestocaml, -I ide -package str,unix,threads)
 
 # votour: a small vo explorer (based on the checker)
 
-bin/votour: $(call bestobj, lib/cObj.cmo checker/analyze.cmo checker/values.cmo checker/votour.cmo)
+bin/votour: $(call bestobj, clib/cObj.cmo checker/analyze.cmo checker/values.cmo checker/votour.cmo)
 	$(SHOW)'OCAMLBEST -o $@'
-	$(HIDE)$(call bestocaml, -I checker,)
+	$(HIDE)$(call bestocaml, -I checker)
 
 ###########################################################################
 # Csdp to micromega special targets
 ###########################################################################
 
-CSDPCERTCMO:=lib/clib.cma $(addprefix plugins/micromega/, \
+CSDPCERTCMO:=clib/clib.cma $(addprefix plugins/micromega/, \
   mutils.cmo 	micromega.cmo \
   sos_types.cmo sos_lib.cmo sos.cmo 	csdpcert.cmo )
 
 $(CSDPCERT): $(call bestobj, $(CSDPCERTCMO))
 	$(SHOW)'OCAMLBEST -o $@'
-	$(HIDE)$(call bestocaml,,nums unix)
+	$(HIDE)$(call bestocaml, -package num,unix)
 
 ###########################################################################
 # tests
@@ -558,12 +575,6 @@ kernel/kernel.cma: kernel/kernel.mllib
 	$(SHOW)'OCAMLC -a -o $@'
 	$(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) $(VMBYTEFLAGS) -a -o $@ $(filter-out %.mllib, $^)
 
-# Specific rule for API/API.cmi
-# Make sure that API/API.mli cannot leak types from the Coq codebase.
-API/API.cmi : API/API.mli
-	$(SHOW)'OCAMLC    $<'
-	$(HIDE)$(OCAMLC) -I lib -I $(MYCAMLP4LIB) -c $<
-
 %.cma: %.mllib
 	$(SHOW)'OCAMLC -a -o $@'
 	$(HIDE)$(OCAMLC) $(MLINCLUDES) $(BYTEFLAGS) -a -o $@ $(filter-out %.mllib, $^)
@@ -582,16 +593,35 @@ API/API.cmi : API/API.mli
 	$(SHOW)'OCAMLOPT -pack -o $@'
 	$(HIDE)$(OCAMLOPT) $(MLINCLUDES) $(OPTFLAGS) -pack -o $@ $(filter-out %.mlpack, $^)
 
+COND_IDEFLAGS=$(if $(filter tools/fake_ide% tools/coq_makefile%,$<), -I ide,)
+COND_PRINTERFLAGS=$(if $(filter dev/%,$<), -I dev,)
+
 COND_BYTEFLAGS= \
- $(if $(filter tools/fake_ide% tools/coq_makefile%,$<), -I ide,) $(MLINCLUDES) $(BYTEFLAGS)
+ $(COND_IDEFLAGS) $(COND_PRINTERFLAGS) $(MLINCLUDES) $(BYTEFLAGS)
 
 COND_OPTFLAGS= \
- $(if $(filter tools/fake_ide% tools/coq_makefile%,$<), -I ide,) $(MLINCLUDES) $(OPTFLAGS)
+ $(COND_IDEFLAGS) $(MLINCLUDES) $(OPTFLAGS)
+
+plugins/micromega/%.cmi: plugins/micromega/%.mli
+	$(SHOW)'OCAMLC    $<'
+	$(HIDE)$(OCAMLC) $(COND_BYTEFLAGS) -package unix,num -c $<
+
+plugins/nsatz/%.cmi: plugins/nsatz/%.mli
+	$(SHOW)'OCAMLC    $<'
+	$(HIDE)$(OCAMLC) $(COND_BYTEFLAGS) -package unix,num -c $<
 
 %.cmi: %.mli
 	$(SHOW)'OCAMLC    $<'
 	$(HIDE)$(OCAMLC) $(COND_BYTEFLAGS) -c $<
 
+plugins/micromega/%.cmo: plugins/micromega/%.ml
+	$(SHOW)'OCAMLC    $<'
+	$(HIDE)$(OCAMLC) $(COND_BYTEFLAGS) -package unix,num -c $<
+
+plugins/nsatz/%.cmo: plugins/nsatz/%.ml
+	$(SHOW)'OCAMLC    $<'
+	$(HIDE)$(OCAMLC) $(COND_BYTEFLAGS) -package unix,num -c $<
+
 %.cmo: %.ml
 	$(SHOW)'OCAMLC    $<'
 	$(HIDE)$(OCAMLC) $(COND_BYTEFLAGS) -c $<
@@ -625,6 +655,14 @@ plugins/micromega/sos_FORPACK:=
 plugins/micromega/sos_print_FORPACK:=
 plugins/micromega/csdpcert_FORPACK:=
 
+plugins/micromega/%.cmx: plugins/micromega/%.ml
+	$(SHOW)'OCAMLOPT  $<'
+	$(HIDE)$(OCAMLOPT) $(COND_OPTFLAGS) $(HACKMLI) $($(@:.cmx=_FORPACK)) -package unix,num -c $<
+
+plugins/nsatz/%.cmx: plugins/nsatz/%.ml
+	$(SHOW)'OCAMLOPT  $<'
+	$(HIDE)$(OCAMLOPT) $(COND_OPTFLAGS) $(HACKMLI) $($(@:.cmx=_FORPACK)) -package unix,num -c $<
+
 plugins/%.cmx: plugins/%.ml
 	$(SHOW)'OCAMLOPT  $<'
 	$(HIDE)$(OCAMLOPT) $(COND_OPTFLAGS) $(HACKMLI) $($(@:.cmx=_FORPACK)) -c $<
@@ -645,10 +683,10 @@ plugins/%.cmx: plugins/%.ml
 	$(SHOW)'OCAMLLEX  $<'
 	$(HIDE)$(OCAMLLEX) -o $@ "$*.mll"
 
-%.ml: %.ml4 $(CAMLP4DEPS)
+%.ml: %.ml4 $(CAMLP5DEPS)
 	$(SHOW)'CAMLP5O   $<'
-	$(HIDE)$(CAMLP4O) -I $(MYCAMLP4LIB) $(PR_O) \
-	  $(CAMLP4DEPS) $(CAMLP4USE) $(CAMLP4COMPAT) -impl $< -o $@
+	$(HIDE)$(CAMLP5O) -I $(MYCAMLP5LIB) $(PR_O) \
+	  $(CAMLP5DEPS) $(CAMLP5USE) $(CAMLP5COMPAT) -impl $< -o $@
 
 
 ###########################################################################
@@ -658,21 +696,24 @@ plugins/%.cmx: plugins/%.ml
 # 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) $(DEPFLAGS) "$<" $(TOTARGET)
+MAINMLFILES := $(filter-out checker/% plugins/%, $(MLFILES) $(MLIFILES))
+MAINMLLIBFILES := $(filter-out checker/% plugins/%, $(MLLIBFILES) $(MLPACKFILES))
+
+$(MLDFILE).d: $(D_DEPEND_BEFORE_SRC) $(MAINMLFILES) $(D_DEPEND_AFTER_SRC) $(GENFILES)
+	$(SHOW)'OCAMLDEP  MLFILES MLIFILES'
+	$(HIDE)$(OCAMLDEP) $(DEPFLAGS) $(MAINMLFILES) $(TOTARGET)
 
-%.mli.d: $(D_DEPEND_BEFORE_SRC) %.mli $(D_DEPEND_AFTER_SRC) $(GENFILES)
-	$(SHOW)'OCAMLDEP  $<'
-	$(HIDE)$(OCAMLDEP) $(DEPFLAGS) "$<" $(TOTARGET)
+$(MLLIBDFILE).d: $(D_DEPEND_BEFORE_SRC) $(MAINMLLIBFILES) $(D_DEPEND_AFTER_SRC) $(OCAMLLIBDEP) $(GENFILES)
+	$(SHOW)'OCAMLLIBDEP  MLLIBFILES MLPACKFILES'
+	$(HIDE)$(OCAMLLIBDEP) $(DEPFLAGS) $(MAINMLLIBFILES) $(TOTARGET)
 
-%.mllib.d: $(D_DEPEND_BEFORE_SRC) %.mllib $(D_DEPEND_AFTER_SRC) $(OCAMLLIBDEP) $(GENFILES)
-	$(SHOW)'OCAMLLIBDEP  $<'
-	$(HIDE)$(OCAMLLIBDEP) $(DEPFLAGS) "$<" $(TOTARGET)
+$(PLUGMLDFILE).d: $(D_DEPEND_BEFORE_SRC) $(filter plugins/%, $(MLFILES) $(MLIFILES)) $(D_DEPEND_AFTER_SRC) $(GENFILES)
+	$(SHOW)'OCAMLDEP  plugins/MLFILES plugins/MLIFILES'
+	$(HIDE)$(OCAMLDEP) $(DEPFLAGS) $(filter plugins/%, $(MLFILES) $(MLIFILES)) $(TOTARGET)
 
-%.mlpack.d: $(D_DEPEND_BEFORE_SRC) %.mlpack $(D_DEPEND_AFTER_SRC) $(OCAMLLIBDEP) $(GENFILES)
-	$(SHOW)'OCAMLLIBDEP  $<'
-	$(HIDE)$(OCAMLLIBDEP) $(DEPFLAGS) "$<" $(TOTARGET)
+$(PLUGMLLIBDFILE).d: $(D_DEPEND_BEFORE_SRC) $(filter plugins/%, $(MLLIBFILES) $(MLPACKFILES)) $(D_DEPEND_AFTER_SRC) $(OCAMLLIBDEP) $(GENFILES)
+	$(SHOW)'OCAMLLIBDEP  plugins/MLLIBFILES plugins/MLPACKFILES'
+	$(HIDE)$(OCAMLLIBDEP) $(DEPFLAGS) $(filter plugins/%, $(MLLIBFILES) $(MLPACKFILES)) $(TOTARGET)
 
 ###########################################################################
 # Compilation of .v files
@@ -705,26 +746,6 @@ theories/Init/%.vo theories/Init/%.glob: theories/Init/%.v $(VO_TOOLS_DEP)
 	$(HIDE)rm -f theories/Init/$*.glob
 	$(HIDE)$(BOOTCOQC) $< -noinit -R theories Coq $(TIMING_ARG) $(TIMING_EXTRA)
 
-# MExtraction.v generates the ml core file of the micromega tactic.
-# We check that this generated code is still in sync with the version
-# of micromega.ml in the archive.
-
-# Note: we now dump to stdout there via "Recursive Extraction" for better
-# control on the name of the generated file, and avoid a .ml that
-# would end in our $(MLFILES). The "sed" below is to kill the final
-# blank line printed by Recursive Extraction (unlike Extraction "foo").
-
-MICROMEGAV:=plugins/micromega/MExtraction.v
-MICROMEGAML:=plugins/micromega/micromega.ml
-MICROMEGAGEN:=plugins/micromega/.micromega.ml.generated
-
-$(MICROMEGAV:.v=.vo) $(MICROMEGAV:.v=.glob) : $(MICROMEGAV) theories/Init/Prelude.vo $(VO_TOOLS_DEP)
-	$(SHOW)'COQC      $<'
-	$(HIDE)rm -f $*.glob
-	$(HIDE)$(BOOTCOQC) $< | sed -e '$$d' > $(MICROMEGAGEN)
-	$(HIDE)cmp -s $(MICROMEGAML) $(MICROMEGAGEN) || \
-	   echo "Warning: $(MICROMEGAML) and the code generated by $(MICROMEGAV) differ !"
-
 # The general rule for building .vo files :
 
 %.vo %.glob: %.v theories/Init/Prelude.vo $(VO_TOOLS_DEP)
@@ -744,9 +765,9 @@ endif
 
 # Dependencies of .v files
 
-%.v.d: $(D_DEPEND_BEFORE_SRC) %.v $(D_DEPEND_AFTER_SRC) $(COQDEPBOOT)
-	$(SHOW)'COQDEP    $<'
-	$(HIDE)$(COQDEPBOOT) -boot $(DYNDEP) "$<" $(TOTARGET)
+$(VDFILE).d: $(D_DEPEND_BEFORE_SRC) $(VFILES) $(D_DEPEND_AFTER_SRC) $(COQDEPBOOT)
+	$(SHOW)'COQDEP    VFILES'
+	$(HIDE)$(COQDEPBOOT) -boot $(DYNDEP) $(VFILES) $(TOTARGET)
 
 ###########################################################################
 
diff --git a/Makefile.checker b/Makefile.checker
index 435d8e8f6..0e429fe86 100644
--- a/Makefile.checker
+++ b/Makefile.checker
@@ -20,16 +20,22 @@ CHICKEN:=bin/coqchk$(EXE)
 
 # The sources
 
-CHKLIBS:= -I config -I lib -I checker
+CHKLIBS:= -I config -I clib -I lib -I checker
 
 ## NB: currently, both $(OPTFLAGS) and $(BYTEFLAGS) contain -thread
 
 # The rules
 
+CHECKMLDFILE := checker/.mlfiles
+CHECKMLLIBFILE := checker/.mllibfiles
+
+CHECKERDEPS := $(addsuffix .d, $(CHECKMLDFILE) $(CHECKMLLIBFILE))
+-include $(CHECKERDEPS)
+
 ifeq ($(BEST),opt)
-$(CHICKEN): checker/check.cmxa checker/main.ml
+$(CHICKEN): checker/check.cmxa checker/main.mli checker/main.ml
 	$(SHOW)'OCAMLOPT -o $@'
-	$(HIDE)$(OCAMLOPT) $(SYSCMXA) $(CHKLIBS) $(OPTFLAGS) $(LINKMETADATA) -o $@ $^
+	$(HIDE)$(OCAMLOPT) -linkpkg $(SYSMOD) $(CHKLIBS) $(OPTFLAGS) $(LINKMETADATA) -o $@ $^
 	$(STRIP) $@
 	$(CODESIGN) $@
 else
@@ -37,9 +43,9 @@ $(CHICKEN): $(CHICKENBYTE)
 	cp $< $@
 endif
 
-$(CHICKENBYTE): checker/check.cma checker/main.ml
+$(CHICKENBYTE): checker/check.cma checker/main.mli checker/main.ml
 	$(SHOW)'OCAMLC -o $@'
-	$(HIDE)$(OCAMLC) $(SYSCMA) $(CHKLIBS) $(BYTEFLAGS) $(CUSTOM) -o $@ $^
+	$(HIDE)$(OCAMLC) -linkpkg $(SYSMOD) $(CHKLIBS) $(BYTEFLAGS) $(CUSTOM) -o $@ $^
 
 checker/check.cma: checker/check.mllib | md5chk
 	$(SHOW)'OCAMLC -a -o $@'
@@ -49,17 +55,13 @@ 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)
+$(CHECKMLDFILE).d: $(filter checker/%, $(MLFILES) $(MLIFILES))
+	$(SHOW)'OCAMLDEP  checker/MLFILES checker/MLIFILES'
+	$(HIDE)$(OCAMLFIND) ocamldep -slash $(CHKLIBS) $(filter checker/%, $(MLFILES) $(MLIFILES)) $(TOTARGET)
 
-checker/%.mllib.d: checker/%.mllib | $(OCAMLLIBDEP)
-	$(SHOW)'OCAMLLIBDEP  $<'
-	$(HIDE)$(OCAMLLIBDEP) $(CHKLIBS) "$<" $(TOTARGET)
+$(CHECKMLLIBFILE).d: $(filter checker/%, $(MLLIBFILES) $(MLPACKFILES)) | $(OCAMLLIBDEP)
+	$(SHOW)'OCAMLLIBDEP  checker/MLLIBFILES checker/MLPACKFILES'
+	$(HIDE)$(OCAMLLIBDEP) $(CHKLIBS) $(filter checker/%, $(MLLIBFILES) $(MLPACKFILES)) $(TOTARGET)
 
 checker/%.cmi: checker/%.mli
 	$(SHOW)'OCAMLC    $<'
@@ -75,8 +77,8 @@ checker/%.cmx: checker/%.ml
 
 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
+	$(HIDE)if grep -q "^MD5 $$($(OCAML) tools/md5sum.ml checker/cic.mli)$$" checker/values.ml; \
+	       then true; else echo "Error: outdated checker/values.ml" >&2; false; fi
 
 .PHONY: md5chk
 
diff --git a/Makefile.ci b/Makefile.ci
index 744b7c655..4e92264d6 100644
--- a/Makefile.ci
+++ b/Makefile.ci
@@ -1,17 +1,20 @@
-CI_TARGETS=ci-all \
-    ci-bignums \
+CI_TARGETS=ci-bignums \
     ci-color \
     ci-compcert \
     ci-coq-dpdgraph \
     ci-coquelicot \
+    ci-corn \
     ci-cpdt \
+    ci-elpi \
+    ci-equations \
     ci-fiat-crypto \
     ci-fiat-parsers \
     ci-flocq \
     ci-formal-topology \
     ci-geocoq \
     ci-hott \
-    ci-iris-coq \
+    ci-iris-lambda-rust \
+    ci-ltac2 \
     ci-math-classes \
     ci-math-comp \
     ci-metacoq \
@@ -20,13 +23,23 @@ CI_TARGETS=ci-all \
     ci-unimath \
     ci-vst
 
-.PHONY: $(CI_TARGETS)
+.PHONY: ci-all $(CI_TARGETS)
+
+ci-color: ci-bignums
+
+ci-math-classes: ci-bignums
+
+ci-corn: ci-math-classes
+
+ci-formal-topology: ci-corn
 
 # Generic rule, we use make to ease travis integration with mixed rules
 $(CI_TARGETS): ci-%:
-	rm -f ci-$*.ok
-	+(./dev/ci/ci-$*.sh 2>&1 && touch ci-$*.ok) | tee time-of-build.log
-	echo 'Aggregating timing log...' && echo -en 'travis_fold:start:coq.test.timing\\r'
-	python ./tools/make-one-time-file.py time-of-build.log
-	echo -en 'travis_fold:end:coq.test.timing\\r'
-	rm ci-$*.ok # must not be -f; we're checking to see that it exists
+	+./dev/ci/ci-wrapper.sh $*
+
+ci-all: $(CI_TARGETS)
+
+# For emacs:
+# Local Variables:
+# mode: makefile
+# End:
diff --git a/Makefile.common b/Makefile.common
index ccbe9261e..d3a9b0b96 100644
--- a/Makefile.common
+++ b/Makefile.common
@@ -12,8 +12,6 @@
 # Executables
 ###########################################################################
 
-COQMKTOP:=bin/coqmktop$(EXE)
-
 COQTOPBYTE:=bin/coqtop.byte$(EXE)
 COQTOPEXE:=bin/coqtop$(EXE)
 
@@ -75,9 +73,9 @@ INSTALLSH:=./install.sh
 MKDIR:=install -d
 
 CORESRCDIRS:=\
-  config 	lib		kernel	intf	kernel/byterun	library \
+  config 	clib 		lib		kernel	intf	kernel/byterun	library \
   engine 	pretyping	interp	proofs	parsing 	printing \
-  tactics 	vernac		stm		toplevel 	API
+  tactics 	vernac		stm		toplevel
 
 PLUGINDIRS:=\
   omega		romega 		micromega 	quote \
@@ -102,10 +100,10 @@ BYTERUN:=$(addprefix kernel/byterun/, \
 # respecting this order is useful for developers that want to load or link
 # the libraries directly
 
-CORECMA:=lib/clib.cma lib/lib.cma kernel/kernel.cma intf/intf.cma library/library.cma \
+CORECMA:=clib/clib.cma lib/lib.cma kernel/kernel.cma intf/intf.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 vernac/vernac.cma \
-	parsing/highparsing.cma stm/stm.cma toplevel/toplevel.cma API/API.cma
+	stm/stm.cma toplevel/toplevel.cma
 
 TOPLOOPCMA:=stm/proofworkertop.cma stm/tacworkertop.cma stm/queryworkertop.cma
 
diff --git a/Makefile.dev b/Makefile.dev
index b0299bd16..d35ad7501 100644
--- a/Makefile.dev
+++ b/Makefile.dev
@@ -18,9 +18,9 @@
 DEBUGPRINTERS:=dev/top_printers.cmo dev/vm_printers.cmo
 
 devel: printers
-printers: $(CORECMA) $(DEBUGPRINTERS) dev/camlp4.dbg
+printers: $(CORECMA) $(DEBUGPRINTERS) dev/camlp5.dbg
 
-dev/camlp4.dbg:
+dev/camlp5.dbg:
 	echo "load_printer gramlib.cma" > $@
 
 ############
@@ -98,7 +98,7 @@ pluginsopt: $(PLUGINSOPT)
 pluginsbyte: $(PLUGINS)
 
 # This should build all the ocaml code but not (most of) the .v files
-coqocaml: tools coqbinaries pluginsopt coqide printers bin/votour
+coqocaml: tools coqbinaries $(PLUGINSCMO:.cmo=$(DYNOBJ)) coqide printers bin/votour
 
 .PHONY: coqlight states miniopt minibyte pluginsopt pluginsbyte coqocaml
 
@@ -116,12 +116,11 @@ 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
 
-.PHONY: lib kernel byterun library proofs tactics interp parsing pretyping API
-.PHONY: engine highparsing stm toplevel
+.PHONY: lib kernel byterun library proofs tactics interp parsing pretyping
+.PHONY: engine stm toplevel
 
 ######################
 ### 3) theories files
diff --git a/Makefile.doc b/Makefile.doc
index dd7717359..8cb9c9f0f 100644
--- a/Makefile.doc
+++ b/Makefile.doc
@@ -61,7 +61,7 @@ REFMANCOQTEXFILES:=$(addprefix doc/refman/, \
 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 \
+  RefMan-uti.tex RefMan-ide.tex RefMan-modr.tex \
   AsyncProofs.tex RefMan-ssr.tex) \
   $(REFMANCOQTEXFILES) \
 
@@ -77,23 +77,23 @@ REFMANPNGFILES:=$(REFMANEPSFILES:.eps=.png)
 ######################################################################
 
 .PHONY: doc doc-html doc-pdf doc-ps refman refman-quick tutorial
-.PHONY: stdlib full-stdlib faq rectutorial refman-html-dir
+.PHONY: stdlib full-stdlib rectutorial refman-html-dir
 
 INDEXURLS:=doc/refman/html/index_urls.txt
 
-doc: refman faq tutorial rectutorial stdlib $(INDEXURLS)
+doc: refman tutorial rectutorial stdlib $(INDEXURLS)
 
 doc-html:\
   doc/tutorial/Tutorial.v.html doc/refman/html/index.html \
-  doc/faq/html/index.html doc/stdlib/html/index.html doc/RecTutorial/RecTutorial.html
+  doc/stdlib/html/index.html doc/RecTutorial/RecTutorial.html
 
 doc-pdf:\
   doc/tutorial/Tutorial.v.pdf doc/refman/Reference-Manual.pdf \
-  doc/faq/FAQ.v.pdf doc/stdlib/Library.pdf doc/RecTutorial/RecTutorial.pdf
+  doc/stdlib/Library.pdf doc/RecTutorial/RecTutorial.pdf
 
 doc-ps:\
   doc/tutorial/Tutorial.v.ps doc/refman/Reference-Manual.ps \
-  doc/faq/FAQ.v.ps doc/stdlib/Library.ps doc/RecTutorial/RecTutorial.ps
+  doc/stdlib/Library.ps doc/RecTutorial/RecTutorial.ps
 
 refman: \
   doc/refman/html/index.html doc/refman/Reference-Manual.ps doc/refman/Reference-Manual.pdf
@@ -107,8 +107,6 @@ stdlib: \
 full-stdlib: \
   doc/stdlib/html/index.html doc/stdlib/FullLibrary.ps doc/stdlib/FullLibrary.pdf
 
-faq: doc/faq/html/index.html doc/faq/FAQ.v.ps doc/faq/FAQ.v.pdf
-
 rectutorial: doc/RecTutorial/RecTutorial.html \
   doc/RecTutorial/RecTutorial.ps doc/RecTutorial/RecTutorial.pdf
 
@@ -148,9 +146,6 @@ endif
 HIDEBIBTEXINFO=| grep -v "^A level-1 auxiliary file"
 SHOWMAKEINDEXERROR=egrep '^!! Input index error|^\*\* Input style error|^   --'
 
-# Empty subsection levels in faq are on purpose
-HEVEAFAQFILTER=2>&1 | grep -v "^Warning: List with no item"
-
 ######################################################################
 # Common
 ######################################################################
@@ -218,13 +213,9 @@ doc/refman/html/index.html: doc/refman/Reference-Manual.html $(REFMANPNGFILES) \
 	@touch $(INDEXES)
 	(cd doc/common/styles/html/$(HTMLSTYLE);\
 		for f in `find . -name \*.css`; do \
-			install -m 644 -D $$f ../../../../refman/html/$$f;\
-		done)
-	(cd doc/common/styles/html/$(HTMLSTYLE);\
-		for f in `find . -name coqdoc.css -o -name style.css`; do \
-			install -m 644 -D $$f ../../../../refman/html/;\
+			$(MKDIR) $$(dirname ../../../../refman/html/$$f);\
+			$(INSTALLLIB) $$f ../../../../refman/html/$$f;\
 		done)
-	install -m 644 doc/common/styles/html/$(HTMLSTYLE)/*.css doc/refman/html
 
 refman-quick:
 	(cd doc/refman;\
@@ -257,33 +248,6 @@ doc/tutorial/Tutorial.v.pdf: $(DOCCOMMON) doc/tutorial/Tutorial.v.tex
 doc/tutorial/Tutorial.v.html: $(DOCCOMMON) doc/tutorial/Tutorial.v.tex
 	(cd doc/tutorial; $(HEVEA) $(HEVEAOPTS) Tutorial.v)
 
-
-######################################################################
-# FAQ
-######################################################################
-
-doc/faq/FAQ.v.dvi: doc/common/version.tex doc/common/title.tex doc/faq/FAQ.v.tex doc/faq/axioms.eps
-	(cd doc/faq;\
-	$(LATEX) -interaction=batchmode FAQ.v;\
-	$(BIBTEX) -terse FAQ.v;\
-	$(LATEX) -interaction=batchmode FAQ.v > /dev/null;\
-	$(LATEX) -interaction=batchmode FAQ.v > /dev/null;\
-	../tools/show_latex_messages FAQ.v.log)
-
-doc/faq/FAQ.v.pdf: doc/common/version.tex doc/common/title.tex doc/faq/FAQ.v.dvi doc/faq/axioms.pdf
-	(cd doc/faq;\
-        $(PDFLATEX) -interaction=batchmode FAQ.v.tex;\
-	../tools/show_latex_messages FAQ.v.log)
-
-doc/faq/FAQ.v.html: doc/faq/FAQ.v.dvi doc/faq/axioms.png # to ensure FAQ.v.bbl
-	(cd doc/faq; ($(HEVEA) $(HEVEAOPTS) FAQ.v.tex $(HEVEAFAQFILTER)))
-
-doc/faq/html/index.html: doc/faq/FAQ.v.html
-	- rm -rf doc/faq/html
-	$(MKDIR) doc/faq/html
-	$(INSTALLLIB) doc/faq/interval_discr.v doc/faq/axioms.png doc/faq/html
-	$(INSTALLLIB) doc/faq/FAQ.v.html doc/faq/html/index.html
-
 ######################################################################
 # Standard library
 ######################################################################
@@ -390,11 +354,13 @@ install-doc-meta:
 	$(INSTALLLIB) doc/LICENSE $(FULLDOCDIR)/LICENSE.doc
 
 install-doc-html: 
-	$(MKDIR) $(addprefix $(FULLDOCDIR)/html/, refman stdlib faq)
-	$(INSTALLLIB) doc/refman/html/* $(FULLDOCDIR)/html/refman 
-	$(INSTALLLIB) doc/stdlib/html/* $(FULLDOCDIR)/html/stdlib 
+	$(MKDIR) $(addprefix $(FULLDOCDIR)/html/, refman stdlib)
+	(for f in `cd doc/refman/html; find . -type f`; do \
+		$(MKDIR) $$(dirname $(FULLDOCDIR)/html/refman/$$f);\
+		$(INSTALLLIB) doc/refman/html/$$f $(FULLDOCDIR)/html/refman/$$f;\
+	done)
+	$(INSTALLLIB) doc/stdlib/html/* $(FULLDOCDIR)/html/stdlib
 	$(INSTALLLIB) doc/RecTutorial/RecTutorial.html $(FULLDOCDIR)/html/RecTutorial.html
-	$(INSTALLLIB) doc/faq/html/* $(FULLDOCDIR)/html/faq
 	$(INSTALLLIB) doc/tutorial/Tutorial.v.html $(FULLDOCDIR)/html/Tutorial.html
 
 install-doc-printable: 
@@ -405,10 +371,8 @@ install-doc-printable:
 		doc/stdlib/Library.ps $(FULLDOCDIR)/ps
 	$(INSTALLLIB) doc/tutorial/Tutorial.v.pdf $(FULLDOCDIR)/pdf/Tutorial.pdf
 	$(INSTALLLIB) doc/RecTutorial/RecTutorial.pdf $(FULLDOCDIR)/pdf/RecTutorial.pdf
-	$(INSTALLLIB) doc/faq/FAQ.v.pdf $(FULLDOCDIR)/pdf/FAQ.pdf
 	$(INSTALLLIB) doc/tutorial/Tutorial.v.ps $(FULLDOCDIR)/ps/Tutorial.ps
 	$(INSTALLLIB) doc/RecTutorial/RecTutorial.ps $(FULLDOCDIR)/ps/RecTutorial.ps
-	$(INSTALLLIB) doc/faq/FAQ.v.ps $(FULLDOCDIR)/ps/FAQ.ps
 
 install-doc-index-urls:
 	$(MKDIR) $(FULLDATADIR)
@@ -423,7 +387,7 @@ 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 API/API.mli \
+	./parsing/*.mli ./proofs/*.mli \
 	./tactics/*.mli ./stm/*.mli ./toplevel/*.mli ./ltac/*.mli)
 
 # Defining options to generate dependencies graphs
@@ -470,7 +434,7 @@ OCAMLDOC_MLLIBD = $(OCAMLFIND) ocamldoc -rectypes $(MLINCLUDES) $(ODOCDOTOPTS) -
 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
+parsing/parsing.dot : | parsing/parsing.mllib.d
 	$(OCAMLDOC_MLLIBD)
 
 grammar/grammar.dot : | grammar/grammar.mllib.d
diff --git a/Makefile.ide b/Makefile.ide
index 542d8c252..4846f5e60 100644
--- a/Makefile.ide
+++ b/Makefile.ide
@@ -41,12 +41,12 @@ IDESRCDIRS:= $(CORESRCDIRS) ide ide/utils
 
 COQIDEFLAGS=$(addprefix -I , $(IDESRCDIRS)) $(COQIDEINCLUDES)
 
-IDEDEPS:=lib/clib.cma lib/cErrors.cmo lib/spawn.cmo
+IDEDEPS:=clib/clib.cma lib/lib.cma
 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
+LINKIDE:=$(IDEDEPS) $(IDECDEPS) $(IDECMA) ide/coqide_main.mli ide/coqide_main.ml
+LINKIDEOPT:=$(IDEOPTCDEPS) $(patsubst %.cma,%.cmxa,$(IDEDEPS:.cmo=.cmx)) $(IDECMA:.cma=.cmxa) ide/coqide_main.mli ide/coqide_main.ml
 
 IDEFILES=$(wildcard ide/*.lang) ide/coq_style.xml ide/coq.png ide/MacOS/default_accel_map
 
@@ -106,9 +106,9 @@ $(COQIDEBYTE): $(LINKIDE)
 	$(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/coqide_main.ml: ide/coqide_main.ml4 config/Makefile # no camlp5deps here
+	$(SHOW)'CAMLP5O   $<'
+	$(HIDE)$(CAMLP5O) -I $(MYCAMLP5LIB) $(PR_O) $(CAMLP5USE) -D$(IDEINT) -impl $< -o $@
 
 
 ide/%.cmi: ide/%.mli
@@ -123,6 +123,15 @@ ide/%.cmx: ide/%.ml
 	$(SHOW)'OCAMLOPT  $<'
 	$(HIDE)$(OCAMLOPT) $(COQIDEFLAGS) $(OPTFLAGS) -c $<
 
+# We need to compile this file without -safe-string due mess with
+# lablgtk API. Other option is to require lablgtk >= 2.8.16
+ide/ideutils.cmo: ide/ideutils.ml
+	$(SHOW)'OCAMLC    $<'
+	$(HIDE)$(filter-out -safe-string,$(OCAMLC)) $(COQIDEFLAGS) $(BYTEFLAGS) -c $<
+
+ide/ideutils.cmx: ide/ideutils.ml
+	$(SHOW)'OCAMLOPT  $<'
+	$(HIDE)$(filter-out -safe-string,$(OCAMLOPT)) $(COQIDEFLAGS) $(filter-out -safe-string,$(OPTFLAGS)) -c $<
 
 ####################
 ## Install targets
@@ -153,10 +162,12 @@ install-ide-bin:
 
 install-ide-toploop:
 ifeq ($(BEST),opt)
+	$(MKDIR) $(FULLCOQLIB)/toploop/
 	$(INSTALLBIN) $(IDETOPLOOPCMA:.cma=.cmxs) $(FULLCOQLIB)/toploop/
 endif
 install-ide-toploop-byte:
 ifneq ($(BEST),opt)
+	$(MKDIR) $(FULLCOQLIB)/toploop/
 	$(INSTALLBIN) $(IDETOPLOOPCMA) $(FULLCOQLIB)/toploop/
 endif
 
diff --git a/Makefile.install b/Makefile.install
index 85ffc93d5..9a7229d52 100644
--- a/Makefile.install
+++ b/Makefile.install
@@ -77,6 +77,7 @@ endif
 install-byte: install-coqide-byte
 	$(MKDIR) $(FULLBINDIR)
 	$(INSTALLBIN) $(COQTOPBYTE) $(FULLBINDIR)
+	$(MKDIR) $(FULLCOQLIB)/toploop
 	$(INSTALLBIN) $(TOPLOOPCMA) $(FULLCOQLIB)/toploop/
 	$(INSTALLSH) $(FULLCOQLIB) $(LINKCMO) $(PLUGINS)
 ifndef CUSTOM
@@ -87,7 +88,6 @@ 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)
 
@@ -101,12 +101,16 @@ INSTALLCMI = $(sort \
 	$(foreach lib,$(CORECMA), $(addsuffix .cmi,$($(lib:.cma=_MLLIB_DEPENDENCIES))))) \
 	$(PLUGINS:.cmo=.cmi)
 
+INSTALLCMX = $(sort $(filter-out checker/% ide/% tools/% dev/% configure.cmx, $(MLFILES:.ml=.cmx)))
+
 install-devfiles:
 	$(MKDIR) $(FULLBINDIR)
-	$(INSTALLBIN) $(COQMKTOP) $(FULLBINDIR)
 	$(MKDIR) $(FULLCOQLIB)
 	$(INSTALLSH)  $(FULLCOQLIB) $(GRAMMARCMA)
-	$(INSTALLSH)  $(FULLCOQLIB) $(INSTALLCMI)
+	$(INSTALLSH)  $(FULLCOQLIB) $(INSTALLCMI)           # Regular CMI files
+	$(INSTALLSH)  $(FULLCOQLIB) $(INSTALLCMX)           # To avoid warning 58 "-opaque"
+	$(INSTALLSH)  $(FULLCOQLIB) $(PLUGINSCMO:.cmo=.cmx) # For static linking of plugins
+	$(INSTALLSH)  $(FULLCOQLIB) $(PLUGINSCMO:.cmo=.o)   # For static linking of plugins
 	$(INSTALLSH)  $(FULLCOQLIB) $(TOOLS_HELPERS)
 ifeq ($(BEST),opt)
 	$(INSTALLSH)  $(FULLCOQLIB) $(LINKCMX) $(CORECMA:.cma=.a) $(STATICPLUGINS:.cma=.a)
@@ -136,7 +140,7 @@ 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
+	man/coq_makefile.1 man/coqchk.1
 
 install-coq-manpages:
 	$(MKDIR) $(FULLMANDIR)/man1
@@ -144,7 +148,7 @@ install-coq-manpages:
 
 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)
+	$(INSTALLLIB) tools/gallina-db.el tools/coq-font-lock.el tools/gallina-syntax.el tools/gallina.el tools/inferior-coq.el $(FULLEMACSLIB)
 
 # command to update TeX' kpathsea database
 #UPDATETEX = $(MKTEXLSR) /usr/share/texmf /var/spool/texmf $(BASETEXDIR) > /dev/null
diff --git a/README.ci.md b/README.ci.md
deleted file mode 100644
index cf9da5094..000000000
--- a/README.ci.md
+++ /dev/null
@@ -1,116 +0,0 @@
-**WARNING:** This document is a work in progress and intended as a RFC.
-If you are not a Coq Developer, don't follow these instructions yet.
-
-Introduction
-============
-
-As of 2017, Coq's Git repository includes a `.travis.yml` file, a
-`.gitlab-ci.yml` file, and supporting scripts, that enable lightweight
-Continuous Integration (CI) tests to be run on clones of that repository stored
-at Github or on a GitLab instance, respectively. This affords two benefits.
-
-First, it allows developers working on Coq itself to perform CI on their own
-Git remotes, thereby enabling them to catch and fix problems with their
-proposed changes before submitting pull requests to Coq itself. This in turn
-reduces the risk of a faulty PR being opened against the official Coq
-repository.
-
-Secondly, it allows developers working on a library dependent on Coq to have
-that library included in the Travis CI tests invoked by the official Coq
-repository on GitHub.
-
-(More comprehensive testing than is provided by the Travis CI and GitLab CI
-integration is the responsibility 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 library for inclusion in Coq's Travis CI builds
-==================================================================
-
-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 it?
-
-If so, all you need to do is:
-
-1. Put your library in a public repository tracking the `master`
-   branch of Coq's Git repository.
-2. Make sure that your development builds in less than 35 minutes.
-3. Submit a PR adding your 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 CI set, add a script for building
-your library to `dev/ci/`, update `.travis.yml`, `.gitlab-ci.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...
-
-Since pull requests only happen on GitHub there is no need to test the
-corresponding GitLab CI variables.
-
-Travis specific information
-===========================
-
-Travis rebuilds all of Coq's executables and stdlib for each job. Coq
-is built with `./configure -local`, then used for the job's test.
-
-GitLab specific information
-===========================
-
-GitLab is set up to use the "build artifact" feature to avoid
-rebuilding Coq. In one job, Coq is built with `./configure -prefix
-install` and `make install` is run, then the `install` directory
-persists to and is used by the next jobs.
-
-Artifacts can also be downloaded from the GitLab repository.
-Currently, available artifacts are:
-- the Coq executables and stdlib, in three copies varying in
-  architecture and Ocaml version used to build Coq.
-- the Coq documentation, in two different copies varying in the OCaml
-  version used to build Coq
-
-As an exception to the above, jobs testing that compilation triggers
-no Ocaml warnings build Coq in parallel with other tests.
diff --git a/README.doc b/README.doc
deleted file mode 100644
index 4e72c894b..000000000
--- a/README.doc
+++ /dev/null
@@ -1,18 +0,0 @@
-                           The Coq documentation
-                           =====================
-
-The Coq documentation includes:
-
-- a reference manual;
-- a generic tutorial on Coq;
-- a tutorial on recursive types;
-- a document presenting the Coq standard library;
-- a list of questions/answers in the FAQ style
-
-All these documents are available online from the Coq official site
-(http://coq.inria.fr), either as PS/PDF files or as HTML documents.
-
-The sources of the documentation are available along with the sources
-of the Coq proof assistant. It is released under the Open Publication
-License (see file doc/LICENSE in the sources of Coq)
-
diff --git a/README.md b/README.md
index 7a430ff70..883630acf 100644
--- a/README.md
+++ b/README.md
@@ -1,29 +1,34 @@
 # Coq
 
-[![Travis](https://travis-ci.org/coq/coq.svg?branch=master)](https://travis-ci.org/coq/coq/builds) [![Gitter](https://badges.gitter.im/coq/coq.svg)](https://gitter.im/coq/coq)
+[![Travis](https://travis-ci.org/coq/coq.svg?branch=master)](https://travis-ci.org/coq/coq/builds)
+[![Appveyor](https://ci.appveyor.com/api/projects/status/eln43k05pa2vm908/branch/master?svg=true)](https://ci.appveyor.com/project/coq/coq/branch/master)
+[![Circle CI](https://circleci.com/gh/coq/coq/tree/master.svg?style=shield)](https://circleci.com/gh/coq/workflows/coq/tree/master)
+[![Gitter](https://badges.gitter.im/coq/coq.svg)](https://gitter.im/coq/coq)
+[![DOI](https://zenodo.org/badge/DOI/10.5281/zenodo.1003420.svg)](https://doi.org/10.5281/zenodo.1003420)
 
 Coq is a formal proof management system. It provides a formal language to write
 mathematical definitions, executable algorithms and theorems together with an
 environment for semi-interactive development of machine-checked proofs.
 
 ## Installation
-Go to the [download page](https://coq.inria.fr/download) for Windows and MacOS packages;
+Download the pre-built packages of the [latest release](https://github.com/coq/coq/releases/latest) for Windows and MacOS;
 read the [help page](https://coq.inria.fr/opam/www/using.html) on how to install Coq with OPAM;
 or refer to the [`INSTALL` file](/INSTALL) for the procedure to install from source.
 
 ## Documentation
-The documentation is part of the archive in directory doc. The
+
+The sources of the documentation can be found in directory [`doc`](/doc). The
 documentation of the last released version is available on the Coq
 web site at [coq.inria.fr/documentation](http://coq.inria.fr/documentation).
+See also [Cocorico](https://github.com/coq/coq/wiki) (the Coq wiki),
+and the [Coq FAQ](https://github.com/coq/coq/wiki/The-Coq-FAQ),
+for additional user-contributed documentation.
 
 ## Changes
 There is a file named [`CHANGES`](/CHANGES) that explains the differences and the
 incompatibilities since last versions. If you upgrade Coq, please read
 it carefully.
 
-## Availability
-Coq is available from [coq.inria.fr](http://coq.inria.fr).
-
 ## The Coq Club
 The Coq Club moderated mailing list is meant to be a standard way
 to discuss questions about the Coq system and related topics. The
@@ -38,11 +43,8 @@ The topics to be discussed in the club should include:
 * theoretical questions about typed lambda-calculi which are
   closely related to Coq.
 
-For any questions/suggestions about the Coq Club, please write to
-`coq-club-request@inria.fr`.
-
 ## Bugs report
-Send your bug reports by filling a form at [coq.inria.fr/bugs](http://coq.inria.fr/bugs).
+Please report any bug / feature request in [our issue tracker](https://github.com/coq/coq/issues).
 
 To be effective, bug reports should mention the OCaml version used
 to compile and run Coq, the Coq version (`coqtop -v`), the configuration
diff --git a/appveyor.yml b/appveyor.yml
index ea31075a6..64c1bedb5 100644
--- a/appveyor.yml
+++ b/appveyor.yml
@@ -8,18 +8,24 @@ image:
 - Visual Studio 2017
 
 environment:
-  CYGROOT: C:\cygwin64
   CYGMIRROR: http://ftp.inf.tu-dresden.de/software/windows/cygwin32
-  CYGCACHE: C:\cygwin64\var\cache\setup
-  opam_url: https://github.com/fdopen/opam-repository-mingw/releases/download/0.0.0.1/opam64.tar.xz
-
-install:
-- cmd: '%CYGROOT%\setup-x86_64.exe -qnNdO -R %CYGROOT% -l %CYGCACHE% -s
-  %CYGMIRROR% -P rsync -P patch -P diffutils -P make -P unzip -P m4 -P findutils -P time'
-- cmd: '%CYGROOT%/bin/bash -l %APPVEYOR_BUILD_FOLDER%/dev/build/windows/appveyor.sh'
+  matrix:
+  - USEOPAM: true
+    ARCH: 64
+  - USEOPAM: false
+    ARCH: 32
+  - USEOPAM: false
+    ARCH: 64
 
 build_script:
-- cmd: '%CYGROOT%/bin/bash -lc "cd $APPVEYOR_BUILD_FOLDER && ./configure -local && make"'
+- cmd: 'call %APPVEYOR_BUILD_FOLDER%\dev\ci\appveyor.bat'
+
+test: off
+
+artifacts:
+  - path: 'dev\nsis\*.exe'
+    name: installer
+
+  - path: 'coq-opensource-archive-*.zip'
+    name: opensource-archive
 
-test_script:
-- cmd: '%CYGROOT%/bin/bash -lc "cd $APPVEYOR_BUILD_FOLDER && make byte && make -C test-suite all INTERACTIVE= && make validate"'
diff --git a/checker/analyze.ml b/checker/analyze.ml
index df75d5b93..7047d8a14 100644
--- a/checker/analyze.ml
+++ b/checker/analyze.ml
@@ -55,6 +55,55 @@ let magic_number = "\132\149\166\190"
 
 (** Memory reification *)
 
+module LargeArray :
+sig
+  type 'a t
+  val empty : 'a t
+  val length : 'a t -> int
+  val make : int -> 'a -> 'a t
+  val get : 'a t -> int -> 'a
+  val set : 'a t -> int -> 'a -> unit
+end =
+struct
+
+  let max_length = Sys.max_array_length
+
+  type 'a t = 'a array array * 'a array
+  (** Invariants:
+      - All subarrays of the left array have length [max_length].
+      - The right array has length < [max_length].
+  *)
+
+  let empty = [||], [||]
+
+  let length (vl, vr) =
+    (max_length * Array.length vl) + Array.length vr
+
+  let make n x =
+    let k = n / max_length in
+    let r = n mod max_length in
+    let vl = Array.init k (fun _ -> Array.make max_length x) in
+    let vr = Array.make r x in
+    (vl, vr)
+
+  let get (vl, vr) n =
+    let k = n / max_length in
+    let r = n mod max_length in
+    let len = Array.length vl in
+    if k < len then vl.(k).(r)
+    else if k == len then vr.(r)
+    else invalid_arg "index out of bounds"
+
+  let set (vl, vr) n x =
+    let k = n / max_length in
+    let r = n mod max_length in
+    let len = Array.length vl in
+    if k < len then vl.(k).(r) <- x
+    else if k == len then vr.(r) <- x
+    else invalid_arg "index out of bounds"
+
+end
+
 type repr =
 | RInt of int
 | RBlock of (int * int) (* tag × len *)
@@ -82,7 +131,7 @@ end
 module type S =
 sig
   type input
-  val parse : input -> (data * obj array)
+  val parse : input -> (data * obj LargeArray.t)
 end
 
 module Make(M : Input) =
@@ -261,7 +310,7 @@ let parse_object chan =
 let parse chan =
   let (magic, len, _, _, size) = parse_header chan in
   let () = assert (magic = magic_number) in
-  let memory = Array.make size (Struct ((-1), [||])) in
+  let memory = LargeArray.make size (Struct ((-1), [||])) in
   let current_object = ref 0 in
   let fill_obj = function
   | RPointer n ->
@@ -272,7 +321,7 @@ let parse chan =
     data, None
   | RString s ->
     let data = Ptr !current_object in
-    let () = memory.(!current_object) <- String s in
+    let () = LargeArray.set memory !current_object (String s) in
     let () = incr current_object in
     data, None
   | RBlock (tag, 0) ->
@@ -282,7 +331,7 @@ let parse chan =
   | RBlock (tag, len) ->
     let data = Ptr !current_object in
     let nblock = Array.make len (Atm (-1)) in
-    let () = memory.(!current_object) <- Struct (tag, nblock) in
+    let () = LargeArray.set memory !current_object (Struct (tag, nblock)) in
     let () = incr current_object in
     data, Some nblock
   | RCode addr ->
@@ -343,3 +392,32 @@ module PString = Make(IString)
 
 let parse_channel = PChannel.parse
 let parse_string s = PString.parse (s, ref 0)
+
+let instantiate (p, mem) =
+  let len = LargeArray.length mem in
+  let ans = LargeArray.make len (Obj.repr 0) in
+  (** First pass: initialize the subobjects *)
+  for i = 0 to len - 1 do
+    let obj = match LargeArray.get mem i with
+    | Struct (tag, blk) -> Obj.new_block tag (Array.length blk)
+    | String str -> Obj.repr str
+    in
+    LargeArray.set ans i obj
+  done;
+  let get_data = function
+  | Int n -> Obj.repr n
+  | Ptr p -> LargeArray.get ans p
+  | Atm tag -> Obj.new_block tag 0
+  | Fun _ -> assert false (** We shouldn't serialize closures *)
+  in
+  (** Second pass: set the pointers *)
+  for i = 0 to len - 1 do
+    match LargeArray.get mem i with
+    | Struct (_, blk) ->
+      let obj = LargeArray.get ans i in
+      for k = 0 to Array.length blk - 1 do
+        Obj.set_field obj k (get_data blk.(k))
+      done
+    | String _ -> ()
+  done;
+  get_data p
diff --git a/checker/analyze.mli b/checker/analyze.mli
index 42efcf01d..9c837643f 100644
--- a/checker/analyze.mli
+++ b/checker/analyze.mli
@@ -8,8 +8,20 @@ type obj =
 | Struct of int * data array (* tag × data *)
 | String of string
 
-val parse_channel : in_channel -> (data * obj array)
-val parse_string : string -> (data * obj array)
+module LargeArray :
+sig
+  type 'a t
+  val empty : 'a t
+  val length : 'a t -> int
+  val make : int -> 'a -> 'a t
+  val get : 'a t -> int -> 'a
+  val set : 'a t -> int -> 'a -> unit
+end
+(** A data structure similar to arrays but allowing to overcome the 2^22 length
+    limitation on 32-bit architecture. *)
+
+val parse_channel : in_channel -> (data * obj LargeArray.t)
+val parse_string : string -> (data * obj LargeArray.t)
 
 (** {6 Functorized version} *)
 
@@ -26,10 +38,13 @@ end
 module type S =
 sig
   type input
-  val parse : input -> (data * obj array)
+  val parse : input -> (data * obj LargeArray.t)
   (** Return the entry point and the reification of the memory out of a
       marshalled structure. *)
 end
 
 module Make (M : Input) : S with type input = M.t
 (** Functorized version of the previous code. *)
+
+val instantiate : data * obj LargeArray.t -> Obj.t
+(** Create the OCaml object out of the reified representation. *)
diff --git a/checker/check.ml b/checker/check.ml
index 180ca1ece..82341ad9b 100644
--- a/checker/check.ml
+++ b/checker/check.ml
@@ -22,6 +22,11 @@ let extend_dirpath p id = DirPath.make (id :: DirPath.repr p)
 type section_path = {
   dirpath : string list ;
   basename : string }
+
+type object_file =
+| PhysicalFile of CUnix.physical_path
+| LogicalFile of section_path
+
 let dir_of_path p =
   DirPath.make (List.map Id.of_string p.dirpath)
 let path_of_dirpath dir =
@@ -69,11 +74,6 @@ let libraries_table = ref LibraryMap.empty
 let find_library dir =
   LibraryMap.find dir !libraries_table
 
-let try_find_library dir =
-  try find_library dir
-  with Not_found ->
-    user_err Pp.(str ("Unknown library " ^ (DirPath.to_string dir)))
-
 let library_full_filename dir = (find_library dir).library_filename
 
   (* If a library is loaded several time, then the first occurrence must
@@ -129,8 +129,6 @@ type logical_path = DirPath.t
 
 let load_paths = ref ([],[] : CUnix.physical_path list * logical_path list)
 
-let get_load_paths () = fst !load_paths
-
 (* Hints to partially detects if two paths refer to the same repertory *)
 let rec remove_path_dot p =
   let curdir = Filename.concat Filename.current_dir_name "" in (* Unix: "./" *)
@@ -227,13 +225,8 @@ let locate_absolute_library dir =
 
 let locate_qualified_library qid =
   try
-    let loadpath =
-      (* Search library in loadpath *)
-      if qid.dirpath=[] then get_load_paths ()
-      else
-        (* we assume qid is an absolute dirpath *)
-        load_paths_of_dir_path (dir_of_path qid)
-    in
+    (* we assume qid is an absolute dirpath *)
+    let loadpath = load_paths_of_dir_path (dir_of_path qid) in
     if loadpath = [] then raise LibUnmappedDir;
     let name =  qid.basename^".vo" in
     let path, file = System.where_in_path loadpath name in
@@ -263,7 +256,17 @@ let try_locate_absolute_library dir =
     | LibUnmappedDir -> error_unmapped_dir (path_of_dirpath dir)
     | LibNotFound -> error_lib_not_found (path_of_dirpath dir)
 
-let try_locate_qualified_library qid =
+let try_locate_qualified_library lib = match lib with
+| PhysicalFile f ->
+  let () =
+    if not (System.file_exists_respecting_case "" f) then
+      error_lib_not_found { dirpath = []; basename = f; }
+  in
+  let dir = Filename.dirname f in
+  let base = Filename.chop_extension (Filename.basename f) in
+  let dir = extend_dirpath (find_logical_path dir) (Id.of_string base) in
+  (dir, f)
+| LogicalFile qid ->
   try
     locate_qualified_library qid
   with
@@ -298,18 +301,27 @@ let name_clash_message dir mdir f =
 (* Dependency graph *)
 let depgraph = ref LibraryMap.empty
 
+let marshal_in_segment f ch =
+  try
+    let stop = input_binary_int ch in
+    let v = Analyze.instantiate (Analyze.parse_channel ch) in
+    let digest = Digest.input ch in
+    Obj.obj v, stop, digest
+  with _ ->
+    user_err (str "Corrupted file " ++ quote (str f))
+
 let intern_from_file (dir, f) =
   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), _, 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
+      let (sd:Cic.summary_disk), _, digest = marshal_in_segment f ch in
+      let (md:Cic.library_disk), _, digest = marshal_in_segment f ch in
+      let (opaque_csts:'a option), _, udg = marshal_in_segment f ch in
+      let (discharging:'a option), _, _ = marshal_in_segment f ch in
+      let (tasks:'a option), _, _ = marshal_in_segment f ch in
       let (table:Cic.opaque_table), pos, checksum =
-        System.marshal_in_segment f ch in
+        marshal_in_segment f ch in
       (* Verification of the final checksum *)
       let () = close_in ch in
       let ch = open_in_bin f in
@@ -412,9 +424,3 @@ let recheck_library ~norec ~admit ~check =
     (fun (dir,_) -> pr_dirpath dir ++ fnl()) needed));
   List.iter (check_one_lib nochk) needed;
   Flags.if_verbose Feedback.msg_notice (str"Modules were successfully checked")
-
-open Printf
-
-let mem s =
-  let m = try_find_library s in
-  h 0 (str (sprintf "%dk" (CObj.size_kb m)))
diff --git a/checker/check.mli b/checker/check.mli
new file mode 100644
index 000000000..28ae385b5
--- /dev/null
+++ b/checker/check.mli
@@ -0,0 +1,30 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open CUnix
+open Names
+
+type section_path = {
+  dirpath : string list;
+  basename : string;
+}
+
+type object_file =
+| PhysicalFile of physical_path
+| LogicalFile of section_path
+
+type logical_path = DirPath.t
+
+val default_root_prefix : DirPath.t
+
+val add_load_path : physical_path * logical_path -> unit
+
+val recheck_library :
+  norec:object_file list ->
+  admit:object_file list ->
+  check:object_file list -> unit
diff --git a/checker/check.mllib b/checker/check.mllib
index 488507a13..f79ba66e3 100644
--- a/checker/check.mllib
+++ b/checker/check.mllib
@@ -1,5 +1,6 @@
 Coq_config
 
+Analyze
 Hook
 Terminal
 Canary
diff --git a/checker/checker.ml b/checker/checker.ml
index 7a69700d2..e8eff889c 100644
--- a/checker/checker.ml
+++ b/checker/checker.ml
@@ -10,7 +10,6 @@ open Pp
 open CErrors
 open Util
 open System
-open Flags
 open Names
 open Check
 
@@ -19,7 +18,7 @@ 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 ();
+  flush_all (); Format.eprintf "@[Fatal Error: @[%a@]@]%!@\n" Pp.pp_with info; flush_all ();
   exit (if anomaly then 129 else 1)
 
 let coq_root = Id.of_string "Coq"
@@ -41,9 +40,10 @@ let dirpath_of_string s =
       [] -> Check.default_root_prefix
     | dir -> DirPath.make (List.map Id.of_string dir)
 let path_of_string s =
-  match parse_dir s with
+  if Filename.check_suffix s ".vo" then PhysicalFile s
+  else match parse_dir s with
       [] -> invalid_arg "path_of_string"
-    | l::dir -> {dirpath=dir; basename=l}
+    | l::dir -> LogicalFile {dirpath=dir; basename=l}
 
 let ( / ) = Filename.concat
 
@@ -74,7 +74,7 @@ let add_path ~unix_path:dir ~coq_root:coq_dirpath =
 let convert_string d =
   try Id.of_string d
   with CErrors.UserError _ ->
-    if_verbose Feedback.msg_warning
+    Flags.if_verbose Feedback.msg_warning
       (str "Directory " ++ str d ++ str " cannot be used as a Coq identifier (skipped)");
     raise Exit
 
@@ -96,17 +96,13 @@ let add_rec_path ~unix_path ~coq_root =
 
 (* By the option -include -I or -R of the command line *)
 let includes = ref []
-let push_include (s, alias) = includes := (s,alias,false) :: !includes
-let push_rec_include (s, alias) = includes := (s,alias,true) :: !includes
+let push_include (s, alias) = includes := (s,alias) :: !includes
 
 let set_default_include d =
   push_include (d, Check.default_root_prefix)
 let set_include d p =
   let p = dirpath_of_string p in
   push_include (d,p)
-let set_rec_include d p =
-  let p = dirpath_of_string p in
-  push_rec_include(d,p)
 
 (* Initializes the LoadPath *)
 let init_load_path () =
@@ -132,8 +128,7 @@ let init_load_path () =
   add_path ~unix_path:"." ~coq_root:Check.default_root_prefix;
   (* additional loadpath, given with -I -include -R options *)
   List.iter
-    (fun (unix_path, coq_root, reci) ->
-      if reci then add_rec_path ~unix_path ~coq_root else add_path ~unix_path ~coq_root)
+    (fun (unix_path, coq_root) -> add_rec_path ~unix_path ~coq_root)
     (List.rev !includes);
   includes := []
 
@@ -145,15 +140,15 @@ let set_impredicative_set () = impredicative_set := Cic.ImpredicativeSet
 let engage () = Safe_typing.set_engagement (!impredicative_set)
 
 
-let admit_list = ref ([] : section_path list)
+let admit_list = ref ([] : object_file list)
 let add_admit s =
   admit_list := path_of_string s :: !admit_list
 
-let norec_list = ref ([] : section_path list)
+let norec_list = ref ([] : object_file list)
 let add_norec s =
   norec_list := path_of_string s :: !norec_list
 
-let compile_list = ref ([] : section_path list)
+let compile_list = ref ([] : object_file list)
 let add_compile s =
   compile_list := path_of_string s :: !compile_list
 
@@ -179,7 +174,9 @@ let print_usage_channel co command =
   output_string co command;
   output_string co "coqchk options are:\n";
   output_string co
-"  -R dir coqdir          map physical dir to logical coqdir\
+"  -Q dir coqdir          map physical dir to logical coqdir\
+\n  -R dir coqdir          synonymous for -Q\
+\n\
 \n\
 \n  -admit module          load module and dependencies without checking\
 \n  -norec module          check module but admit dependencies without checking\
@@ -211,8 +208,7 @@ let usage () =
 open Type_errors
 
 let anomaly_string () = str "Anomaly: "
-let report () = (str "." ++ spc () ++ str "Please report" ++
-                 strbrk "at " ++ str Coq_config.wwwbugtracker ++ str ".")
+let report () = strbrk (". Please report at " ^ Coq_config.wwwbugtracker ^ ".")
 
 let guill s = str "\"" ++ str s ++ str "\""
 
@@ -311,6 +307,9 @@ let explain_exn = function
 	       report ())
   | e -> CErrors.print e (* for anomalies and other uncaught exceptions *)
 
+let deprecated flag =
+  Feedback.msg_warning (str "Deprecated flag " ++ quote (str flag))
+
 let parse_args argv =
   let rec parse = function
     | [] -> ()
@@ -324,12 +323,15 @@ let parse_args argv =
       Flags.coqlib_spec := true;
       parse rem
 
-    | ("-I"|"-include") :: d :: "-as" :: p :: rem -> set_include d p; parse rem
+    | ("-I"|"-include") :: d :: "-as" :: p :: rem -> deprecated "-I"; set_include d p; parse rem
     | ("-I"|"-include") :: d :: "-as" :: [] -> usage ()
-    | ("-I"|"-include") :: d :: rem -> set_default_include d; parse rem
+    | ("-I"|"-include") :: d :: rem -> deprecated "-I"; set_default_include d; parse rem
     | ("-I"|"-include") :: []       -> usage ()
 
-    | "-R" :: d :: p :: rem -> set_rec_include d p;parse rem
+    | "-Q" :: d :: p :: rem -> set_include d p;parse rem
+    | "-Q" :: ([] | [_]) -> usage ()
+
+    | "-R" :: d :: p :: rem -> set_include d p;parse rem
     | "-R" :: ([] | [_]) -> usage ()
 
     | "-debug" :: rem -> set_debug (); parse rem
@@ -342,7 +344,7 @@ let parse_args argv =
     | ("-?"|"-h"|"-H"|"-help"|"--help") :: _ -> usage ()
 
     | ("-v"|"--version") :: _ -> version ()
-    | "-boot" :: rem -> boot := true; parse rem
+    | "-boot" :: rem -> Flags.boot := true; parse rem
     | ("-m" | "--memory") :: rem -> Check_stat.memory_stat := true; parse rem
     | ("-o" | "--output-context") :: rem ->
         Check_stat.output_context := true; parse rem
@@ -366,15 +368,18 @@ let parse_args argv =
 (* To prevent from doing the initialization twice *)
 let initialized = ref false
 
+(* XXX: At some point we need to either port the checker to use the
+   feedback system or to remove its use completely. *)
 let init_with_argv argv =
   if not !initialized then begin
     initialized := true;
     Sys.catch_break false; (* Ctrl-C is fatal during the initialisation *)
+    let _fhandle = Feedback.(add_feeder (console_feedback_listener Format.err_formatter)) in
     try
       parse_args argv;
       if !Flags.debug then Printexc.record_backtrace true;
       Envars.set_coqlib ~fail:(fun x -> CErrors.user_err Pp.(str x));
-      if_verbose print_header ();
+      Flags.if_verbose print_header ();
       init_load_path ();
       engage ();
     with e ->
diff --git a/checker/checker.mli b/checker/checker.mli
new file mode 100644
index 000000000..ceab13774
--- /dev/null
+++ b/checker/checker.mli
@@ -0,0 +1,9 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+val start : unit -> unit
diff --git a/checker/cic.mli b/checker/cic.mli
index 59dd5bc4d..1f4322dff 100644
--- a/checker/cic.mli
+++ b/checker/cic.mli
@@ -81,7 +81,7 @@ type 'constr pfixpoint =
 type 'constr pcofixpoint =
     int * 'constr prec_declaration
 type 'a puniverses = 'a Univ.puniverses
-type pconstant = constant puniverses
+type pconstant = Constant.t puniverses
 type pinductive = inductive puniverses
 type pconstructor = constructor puniverses
 
@@ -127,12 +127,12 @@ type section_context = unit
 
 type delta_hint =
   | Inline of int * constr option
-  | Equiv of kernel_name
+  | Equiv of KerName.t
 
-type delta_resolver = module_path MPmap.t * delta_hint KNmap.t
+type delta_resolver = ModPath.t MPmap.t * delta_hint KNmap.t
 
 type 'a umap_t = 'a MPmap.t * 'a MBImap.t
-type substitution = (module_path * delta_resolver) umap_t
+type substitution = (ModPath.t * delta_resolver) umap_t
 
 (** {6 Delayed constr} *)
 
@@ -170,6 +170,17 @@ type set_predicativity = ImpredicativeSet | PredicativeSet
 
 type engagement = set_predicativity
 
+(** {6 Conversion oracle} *)
+
+type level = Expand | Level of int | Opaque
+
+type oracle = {
+  var_opacity : level Id.Map.t;
+  cst_opacity : level Cmap.t;
+  var_trstate : Id.Pred.t;
+  cst_trstate : Cpred.t;
+}
+
 (** {6 Representation of constants (Definition/Axiom) } *)
 
 
@@ -194,7 +205,7 @@ type inline = int option
     always transparent. *)
 
 type projection_body = {
-  proj_ind : mutual_inductive;
+  proj_ind : MutInd.t;
   proj_npars : int;
   proj_arg : int;
   proj_type : constr; (* Type under params *)
@@ -208,7 +219,7 @@ type constant_def =
   | OpaqueDef of lazy_constr
 
 type constant_universes =
-  | Monomorphic_const of Univ.universe_context
+  | Monomorphic_const of Univ.ContextSet.t
   | Polymorphic_const of Univ.abstract_universe_context
 
 (** The [typing_flags] are instructions to the type-checker which
@@ -219,6 +230,7 @@ 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 *)
+  conv_oracle : oracle; (** Unfolding strategies for conversion *)
 }
 
 type constant_body = {
@@ -241,7 +253,7 @@ type recarg =
 
 type wf_paths = recarg Rtree.t
 
-type record_body = (Id.t * constant array * projection_body array) option
+type record_body = (Id.t * Constant.t array * projection_body array) option
     (* The body is empty for non-primitive records, otherwise we get its
        binder name in projections and list of projections if it is primitive. *)
 
@@ -303,7 +315,7 @@ type one_inductive_body = {
   }
 
 type abstract_inductive_universes =
-  | Monomorphic_ind of Univ.universe_context
+  | Monomorphic_ind of Univ.ContextSet.t
   | Polymorphic_ind of Univ.abstract_universe_context
   | Cumulative_ind of Univ.abstract_cumulativity_info
 
@@ -346,13 +358,11 @@ type ('ty,'a) functorize =
     and won't play any role into the kernel after that : they are kept
     only for short module printing and for extraction. *)
 
-type with_declaration =
-  | WithMod of Id.t list * module_path
-  | WithDef of Id.t list * (constr * Univ.universe_context)
+type with_declaration
 
 type module_alg_expr =
-  | MEident of module_path
-  | MEapply of module_alg_expr * module_path
+  | MEident of ModPath.t
+  | MEapply of module_alg_expr * ModPath.t
   | MEwith of module_alg_expr * with_declaration
 
 (** A component of a module structure *)
@@ -385,9 +395,9 @@ and module_implementation =
   | Struct of module_signature (** interactive body *)
   | FullStruct (** special case of [Struct] : the body is exactly [mod_type] *)
 
-and module_body =
-  { mod_mp : module_path; (** absolute path of the module *)
-    mod_expr : module_implementation; (** implementation *)
+and 'a generic_module_body =
+  { mod_mp : ModPath.t; (** absolute path of the module *)
+    mod_expr : 'a; (** implementation *)
     mod_type : module_signature; (** expanded type *)
     (** algebraic type, kept if it's relevant for extraction *)
     mod_type_alg : module_expression option;
@@ -395,13 +405,19 @@ and module_body =
     mod_constraints : Univ.ContextSet.t;
     (** quotiented set of equivalent constants and inductive names *)
     mod_delta : delta_resolver;
-    mod_retroknowledge : action list }
+    mod_retroknowledge : 'a module_retroknowledge; }
+
+and module_body = module_implementation generic_module_body
 
 (** A [module_type_body] is just a [module_body] with no
-    implementation ([mod_expr] always [Abstract]) and also
-    an empty [mod_retroknowledge] *)
+    implementation and also an empty [mod_retroknowledge] *)
+
+and module_type_body = unit generic_module_body
 
-and module_type_body = module_body
+and _ module_retroknowledge =
+| ModBodyRK :
+  action list -> module_implementation module_retroknowledge
+| ModTypeRK : unit module_retroknowledge
 
 (*************************************************************************)
 (** {4 From safe_typing.ml} *)
diff --git a/checker/closure.ml b/checker/closure.ml
index 70718bfdc..14b31e09d 100644
--- a/checker/closure.ml
+++ b/checker/closure.ml
@@ -49,13 +49,6 @@ let with_stats c =
   end else
     Lazy.force c
 
-type transparent_state = Id.Pred.t * Cpred.t
-let all_opaque = (Id.Pred.empty, Cpred.empty)
-let all_transparent = (Id.Pred.full, Cpred.full)
-
-let is_transparent_variable (ids, _) id = Id.Pred.mem id ids
-let is_transparent_constant (_, csts) cst = Cpred.mem cst csts
-
 module type RedFlagsSig = sig
   type reds
   type red_kind
@@ -63,8 +56,6 @@ module type RedFlagsSig = sig
   val fDELTA : red_kind
   val fIOTA : red_kind
   val fZETA : red_kind
-  val fCONST : constant -> red_kind
-  val fVAR : Id.t -> red_kind
   val no_red : reds
   val red_add : reds -> red_kind -> reds
   val mkflags : red_kind list -> reds
@@ -80,51 +71,33 @@ module RedFlags = (struct
   type reds = {
     r_beta : bool;
     r_delta : bool;
-    r_const : transparent_state;
     r_zeta : bool;
     r_evar : bool;
     r_iota : bool }
 
   type red_kind = BETA | DELTA | IOTA | ZETA
-	      | CONST of constant | VAR of Id.t
+
   let fBETA = BETA
   let fDELTA = DELTA
   let fIOTA = IOTA
   let fZETA = ZETA
-  let fCONST kn  = CONST kn
-  let fVAR id  = VAR id
   let no_red = {
     r_beta = false;
     r_delta = false;
-    r_const = all_opaque;
     r_zeta = false;
     r_evar = false;
     r_iota = false }
 
   let red_add red = function
     | BETA -> { red with r_beta = true }
-    | DELTA -> { red with r_delta = true; r_const = all_transparent }
-    | CONST kn ->
-	let (l1,l2) = red.r_const in
-	{ red with r_const = l1, Cpred.add kn l2 }
+    | DELTA -> { red with r_delta = true}
     | IOTA -> { red with r_iota = true }
     | ZETA -> { red with r_zeta = true }
-    | VAR id ->
-	let (l1,l2) = red.r_const in
-	{ red with r_const = Id.Pred.add id l1, l2 }
 
   let mkflags = List.fold_left red_add no_red
 
   let red_set red = function
     | BETA -> incr_cnt red.r_beta beta
-    | CONST kn ->
-	let (_,l) = red.r_const in
-	let c = Cpred.mem kn l in
-	incr_cnt c delta
-    | VAR id -> (* En attendant d'avoir des kn pour les Var *)
-	let (l,_) = red.r_const in
-	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
     | DELTA -> (* Used for Rel/Var defined in context *)
@@ -165,7 +138,7 @@ type 'a tableKey =
   | VarKey of Id.t
   | RelKey of int
 
-type table_key = constant puniverses tableKey
+type table_key = Constant.t puniverses tableKey
 
 module KeyHash =
 struct
@@ -279,11 +252,10 @@ and fterm =
   | FProj of projection * fconstr
   | FFix of fixpoint * fconstr subs
   | FCoFix of cofixpoint * fconstr subs
-  | FCase of case_info * fconstr * fconstr * fconstr array
   | FCaseT of case_info * constr * fconstr * constr array * fconstr subs (* predicate and branches are closures *)
-  | FLambda of int * (name * constr) list * constr * fconstr subs
-  | FProd of name * fconstr * fconstr
-  | FLetIn of name * fconstr * fconstr * constr * fconstr subs
+  | FLambda of int * (Name.t * constr) list * constr * fconstr subs
+  | FProd of Name.t * fconstr * fconstr
+  | FLetIn of Name.t * fconstr * fconstr * constr * fconstr subs
   | FEvar of existential_key * fconstr array (* why diff from kernel/closure? *)
   | FLIFT of int * fconstr
   | FCLOS of constr * fconstr subs
@@ -306,7 +278,6 @@ let update v1 (no,t) =
 
 type stack_member =
   | Zapp of fconstr array
-  | Zcase of case_info * fconstr * fconstr array
   | ZcaseT of case_info * constr * constr array * fconstr subs
   | Zproj of int * int * projection
   | Zfix of fconstr * stack
@@ -456,13 +427,10 @@ let rec to_constr constr_fun lfts v =
     | FFlex (ConstKey op) -> Const op
     | FInd op -> Ind op
     | FConstruct op -> Construct op
-    | FCase (ci,p,c,ve) ->
-	Case (ci, constr_fun lfts p,
-              constr_fun lfts c,
-	      Array.map (constr_fun lfts) ve)
-    | FCaseT (ci,p,c,ve,e) -> (* TODO: enable sharing, cf FCLOS below ? *)
-        to_constr constr_fun lfts
-	  {norm=Red;term=FCase(ci,mk_clos2 e p,c,mk_clos_vect e ve)}
+    | FCaseT (ci,p,c,ve,e) ->
+       let fp = mk_clos2 e p in
+       let fve = mk_clos_vect e ve in
+       Case (ci, constr_fun lfts fp, constr_fun lfts c, Array.map (constr_fun lfts) fve)
     | FFix ((op,(lna,tys,bds)),e) ->
         let n = Array.length bds in
         let ftys = Array.map (mk_clos e) tys in
@@ -532,9 +500,6 @@ let rec zip m stk =
   match stk with
     | [] -> m
     | Zapp args :: s -> zip {norm=neutr m.norm; term=FApp(m, args)} s
-    | Zcase(ci,p,br)::s ->
-        let t = FCase(ci, p, m, br) in
-        zip {norm=neutr m.norm; term=t} s
     | ZcaseT(ci,p,br,e)::s ->
         let t = FCaseT(ci, p, m, br, e) in
         zip {norm=neutr m.norm; term=t} s
@@ -616,7 +581,7 @@ let rec get_args n tys f e stk =
 
 (* Eta expansion: add a reference to implicit surrounding lambda at end of stack *)
 let rec eta_expand_stack = function
-  | (Zapp _ | Zfix _ | Zcase _ | ZcaseT _ | Zproj _ 
+  | (Zapp _ | Zfix _ | ZcaseT _ | Zproj _
 	| Zshift _ | Zupdate _ as e) :: s ->
       e :: eta_expand_stack s
   | [] ->
@@ -708,6 +673,9 @@ let contract_fix_vect fix =
   in
   (subs_cons(Array.init nfix make_body, env), thisbody)
 
+let unfold_projection env p =
+  let pb = lookup_projection p env in
+  Zproj (pb.proj_npars, pb.proj_arg, p)
 
 (*********************************************************************)
 (* A machine that inspects the head of a term until it finds an
@@ -720,7 +688,6 @@ let rec knh info m stk =
     | FCLOS(t,e) -> knht info e t (zupdate m stk)
     | FLOCKED -> assert false
     | FApp(a,b) -> knh info a (append_stack b (zupdate m stk))
-    | FCase(ci,p,t,br) -> knh info t (Zcase(ci,p,br)::zupdate m stk)
     | FCaseT(ci,p,t,br,env) -> knh info t (ZcaseT(ci,p,br,env)::zupdate m stk)
     | FFix(((ri,n),(_,_,_)),_) ->
         (match get_nth_arg m ri.(n) stk with
@@ -729,10 +696,9 @@ let rec knh info m stk =
     | FCast(t,_,_) -> knh info t stk
 
     | FProj (p,c) ->
-      if red_set info.i_flags (fCONST (Projection.constant p)) then
-        (let pb = lookup_projection p (info.i_env) in
-	   knh info c (Zproj (pb.proj_npars, pb.proj_arg, p)
-		       :: zupdate m stk))
+      if red_set info.i_flags fDELTA then
+        let s = unfold_projection info.i_env p in
+        knh info c (s :: zupdate m stk)
       else (m,stk)
 
 (* cases where knh stops *)
@@ -764,11 +730,11 @@ let rec knr info m stk =
       (match get_args n tys f e stk with
           Inl e', s -> knit info e' f s
         | Inr lam, s -> (lam,s))
-  | FFlex(ConstKey kn) when red_set info.i_flags (fCONST (fst kn)) ->
+  | FFlex(ConstKey kn) when red_set info.i_flags fDELTA ->
       (match ref_value_cache info (ConstKey kn) with
           Some v -> kni info v stk
         | None -> (set_norm m; (m,stk)))
-  | FFlex(VarKey id) when red_set info.i_flags (fVAR id) ->
+  | FFlex(VarKey id) when red_set info.i_flags fDELTA ->
       (match ref_value_cache info (VarKey id) with
           Some v -> kni info v stk
         | None -> (set_norm m; (m,stk)))
@@ -778,10 +744,6 @@ let rec knr info m stk =
         | None -> (set_norm m; (m,stk)))
   | FConstruct((ind,c),u) when red_set info.i_flags fIOTA ->
       (match strip_update_shift_app m stk with
-          (depth, args, Zcase(ci,_,br)::s) ->
-            assert (ci.ci_npar>=0);
-            let rargs = drop_parameters depth ci.ci_npar args in
-            kni info br.(c-1) (rargs@s)
        | (depth, args, ZcaseT(ci,_,br,env)::s) ->
             assert (ci.ci_npar>=0);
             let rargs = drop_parameters depth ci.ci_npar args in
@@ -798,7 +760,7 @@ let rec knr info m stk =
        | (_,args,s) -> (m,args@s))
   | FCoFix _ when red_set info.i_flags fIOTA ->
       (match strip_update_shift_app m stk with
-          (_, args, (((Zcase _|ZcaseT _)::_) as stk')) ->
+          (_, args, (((ZcaseT _)::_) as stk')) ->
             let (fxe,fxbd) = contract_fix_vect m.term in
             knit info fxe fxbd (args@stk')
         | (_,args,s) -> (m,args@s))
@@ -835,6 +797,7 @@ type clos_infos = fconstr infos
 
 let infos_env x = x.i_env
 let infos_flags x = x.i_flags
+let oracle_of_infos x = x.i_env.env_conv_oracle
 
 let create_clos_infos flgs env =
   create (fun _ -> inject) flgs env
diff --git a/checker/closure.mli b/checker/closure.mli
index ed5bb3d09..7bdc21b60 100644
--- a/checker/closure.mli
+++ b/checker/closure.mli
@@ -24,14 +24,6 @@ val with_stats: 'a Lazy.t -> 'a
   Rem: reduction of a Rel/Var bound to a term is Delta, but reduction of
   a LetIn expression is Letin reduction *)
 
-type transparent_state = Id.Pred.t * Cpred.t
-
-val all_opaque      : transparent_state
-val all_transparent : transparent_state
-
-val is_transparent_variable : transparent_state -> variable -> bool
-val is_transparent_constant : transparent_state -> constant -> bool
-
 (* Sets of reduction kinds. *)
 module type RedFlagsSig = sig
   type reds
@@ -42,8 +34,6 @@ module type RedFlagsSig = sig
   val fDELTA : red_kind
   val fIOTA : red_kind
   val fZETA : red_kind
-  val fCONST : constant -> red_kind
-  val fVAR : Id.t -> red_kind
 
   (* No reduction at all *)
   val no_red : reds
@@ -71,7 +61,7 @@ type 'a tableKey =
   | VarKey of Id.t
   | RelKey of int
 
-type table_key = constant puniverses tableKey
+type table_key = Constant.t puniverses tableKey
 
 type 'a infos
 val ref_value_cache: 'a infos -> table_key -> 'a option
@@ -98,11 +88,10 @@ type fterm =
   | FProj of projection * fconstr
   | FFix of fixpoint * fconstr subs
   | FCoFix of cofixpoint * fconstr subs
-  | FCase of case_info * fconstr * fconstr * fconstr array
   | FCaseT of case_info * constr * fconstr * constr array * fconstr subs (* predicate and branches are closures *)
-  | FLambda of int * (name * constr) list * constr * fconstr subs
-  | FProd of name * fconstr * fconstr
-  | FLetIn of name * fconstr * fconstr * constr * fconstr subs
+  | FLambda of int * (Name.t * constr) list * constr * fconstr subs
+  | FProd of Name.t * fconstr * fconstr
+  | FLetIn of Name.t * fconstr * fconstr * constr * fconstr subs
   | FEvar of existential_key * fconstr array
   | FLIFT of int * fconstr
   | FCLOS of constr * fconstr subs
@@ -115,7 +104,6 @@ type fterm =
 
 type stack_member =
   | Zapp of fconstr array
-  | Zcase of case_info * fconstr * fconstr array
   | ZcaseT of case_info * constr * constr array * fconstr subs
   | Zproj of int * int * projection
   | Zfix of fconstr * stack
@@ -133,6 +121,8 @@ val eta_expand_stack : stack -> stack
 val eta_expand_ind_stack : env -> inductive -> fconstr -> stack -> 
    (fconstr * stack) -> stack * stack
 
+val unfold_projection : env -> Projection.t -> stack_member
+
 (* To lazy reduce a constr, create a [clos_infos] with
    [create_clos_infos], inject the term to reduce with [inject]; then use
    a reduction function *)
@@ -142,13 +132,15 @@ val inject : constr -> fconstr
 val fterm_of : fconstr -> fterm
 val term_of_fconstr : fconstr -> constr
 val destFLambda :
-  (fconstr subs -> constr -> fconstr) -> fconstr -> name * fconstr * fconstr
+  (fconstr subs -> constr -> fconstr) -> fconstr -> Name.t * fconstr * fconstr
 
 (* Global and local constant cache *)
 type clos_infos
 val create_clos_infos : reds -> env -> clos_infos
 val infos_env : clos_infos -> env
 val infos_flags : clos_infos -> reds
+val oracle_of_infos : clos_infos -> oracle
+
 
 (* Reduction function *)
 
diff --git a/checker/declarations.ml b/checker/declarations.ml
index 093d999a3..2fe930dca 100644
--- a/checker/declarations.ml
+++ b/checker/declarations.ml
@@ -484,8 +484,8 @@ let subst_wf_paths sub p = Rtree.smartmap (subst_recarg sub) p
 
 let eq_recarg r1 r2 = match r1, r2 with
   | Norec, Norec -> true
-  | Mrec i1, Mrec i2 -> Names.eq_ind i1 i2
-  | Imbr i1, Imbr i2 -> Names.eq_ind i1 i2
+  | Mrec i1, Mrec i2 -> Names.eq_ind_chk i1 i2
+  | Imbr i1, Imbr i2 -> Names.eq_ind_chk i1 i2
   | _ -> false
 
 let eq_wf_paths = Rtree.equal eq_recarg
@@ -573,34 +573,36 @@ let implem_map fs fa = function
   | Algebraic a -> Algebraic (fa a)
   | impl -> impl
 
-let subst_with_body sub = function
-  | WithMod(id,mp) -> WithMod(id,subst_mp sub mp)
-  | WithDef(id,(c,ctx)) -> WithDef(id,(subst_mps sub c,ctx))
-
 let rec subst_expr sub = function
   | MEident mp -> MEident (subst_mp sub mp)
   | MEapply (me1,mp2)-> MEapply (subst_expr sub me1, subst_mp sub mp2)
-  | MEwith (me,wd)-> MEwith (subst_expr sub me, subst_with_body sub wd)
+  | MEwith (me,wd)-> MEwith (subst_expr sub me, wd)
 
 let rec subst_expression sub me =
-  functor_map (subst_module sub) (subst_expr sub) me
+  functor_map (subst_module_type sub) (subst_expr sub) me
 
 and subst_signature sub sign =
-  functor_map (subst_module sub) (subst_structure sub) sign
+  functor_map (subst_module_type sub) (subst_structure sub) sign
 
 and subst_structure sub struc =
   let subst_body = function
     | SFBconst cb -> SFBconst (subst_const_body sub cb)
     | SFBmind mib -> SFBmind (subst_mind sub mib)
     | SFBmodule mb -> SFBmodule (subst_module sub mb)
-    | SFBmodtype mtb -> SFBmodtype (subst_module sub mtb)
+    | SFBmodtype mtb -> SFBmodtype (subst_module_type sub mtb)
   in
   List.map (fun (l,b) -> (l,subst_body b)) struc
 
-and subst_module sub mb =
+and subst_body : 'a. (_ -> 'a -> 'a) -> _ -> 'a generic_module_body -> 'a generic_module_body =
+  fun subst_impl sub mb ->
   { mb with
     mod_mp = subst_mp sub mb.mod_mp;
-    mod_expr =
-      implem_map (subst_signature sub) (subst_expression sub) mb.mod_expr;
+    mod_expr = subst_impl sub mb.mod_expr;
     mod_type = subst_signature sub mb.mod_type;
     mod_type_alg = Option.smartmap (subst_expression sub) mb.mod_type_alg }
+
+and subst_module sub mb =
+  subst_body (fun sub e -> implem_map (subst_signature sub) (subst_expression sub) e) sub mb
+
+and subst_module_type sub mb =
+  subst_body (fun _ () -> ()) sub mb
diff --git a/checker/declarations.mli b/checker/declarations.mli
index 6fc71bb94..7458b3e0b 100644
--- a/checker/declarations.mli
+++ b/checker/declarations.mli
@@ -34,12 +34,12 @@ val empty_delta_resolver : delta_resolver
 type 'a subst_fun = substitution -> 'a -> 'a
 
 val empty_subst : substitution
-val add_mbid : MBId.t -> module_path -> substitution -> substitution
-val add_mp   : module_path -> module_path -> substitution -> substitution
-val map_mbid : MBId.t -> module_path -> substitution
-val map_mp   : module_path -> module_path -> substitution
-val mp_in_delta : module_path -> delta_resolver -> bool
-val mind_of_delta : delta_resolver -> mutual_inductive -> mutual_inductive
+val add_mbid : MBId.t -> ModPath.t -> substitution -> substitution
+val add_mp   : ModPath.t -> ModPath.t -> substitution -> substitution
+val map_mbid : MBId.t -> ModPath.t -> substitution
+val map_mp   : ModPath.t -> ModPath.t -> substitution
+val mp_in_delta : ModPath.t -> delta_resolver -> bool
+val mind_of_delta : delta_resolver -> MutInd.t -> MutInd.t
 
 val subst_const_body : constant_body subst_fun
 val subst_mind : mutual_inductive_body subst_fun
diff --git a/checker/environ.ml b/checker/environ.ml
index a0818012c..bbd043c8e 100644
--- a/checker/environ.ml
+++ b/checker/environ.ml
@@ -8,7 +8,7 @@ open Declarations
 type globals = {
   env_constants : constant_body Cmap_env.t;
   env_inductives : mutual_inductive_body Mindmap_env.t;
-  env_inductives_eq : kernel_name  KNmap.t;
+  env_inductives_eq : KerName.t KNmap.t;
   env_modules : module_body MPmap.t;
   env_modtypes : module_type_body MPmap.t}
 
@@ -21,7 +21,15 @@ type env = {
     env_globals       : globals;
     env_rel_context   : rel_context;
     env_stratification : stratification;
-    env_imports : Cic.vodigest MPmap.t }
+    env_imports : Cic.vodigest MPmap.t;
+    env_conv_oracle : oracle; }
+
+let empty_oracle = {
+  var_opacity = Id.Map.empty;
+  cst_opacity = Cmap.empty;
+  var_trstate = Id.Pred.empty;
+  cst_trstate = Cpred.empty;
+}
 
 let empty_env = {
   env_globals =
@@ -34,7 +42,8 @@ let empty_env = {
   env_stratification =
   { env_universes = Univ.initial_universes;
     env_engagement = PredicativeSet };
-  env_imports = MPmap.empty }
+  env_imports = MPmap.empty;
+  env_conv_oracle = empty_oracle }
 
 let engagement env = env.env_stratification.env_engagement
 let universes env = env.env_stratification.env_universes
@@ -51,6 +60,8 @@ let set_engagement (impr_set as c) env =
   { env with env_stratification =
       { env.env_stratification with env_engagement = c } }
 
+let set_oracle env oracle = { env with env_conv_oracle = oracle }
+
 (* Digests *)
 
 let add_digest env dp digest =
@@ -115,7 +126,7 @@ let add_constant kn cs env =
 	env_constants = new_constants } in
   { env with env_globals = new_globals }
 
-type const_evaluation_result = NoBody | Opaque | IsProj
+type const_evaluation_result = NoBody | Opaque
 
 (* Constant types *)
 
@@ -137,18 +148,16 @@ exception NotEvaluableConst of const_evaluation_result
 
 let constant_value env (kn,u) =
   let cb = lookup_constant kn env in
-  if cb.const_proj = None then
-    match cb.const_body with
-    | Def l_body -> 
-      let b = force_constr l_body in
-      begin
-        match cb.const_universes with
-        | Monomorphic_const _ -> b
-        | Polymorphic_const _ -> subst_instance_constr u (force_constr l_body)
-      end
-    | OpaqueDef _ -> raise (NotEvaluableConst Opaque)
-    | Undef _ -> raise (NotEvaluableConst NoBody)
-  else raise (NotEvaluableConst IsProj)
+  match cb.const_body with
+  | Def l_body ->
+    let b = force_constr l_body in
+    begin
+      match cb.const_universes with
+      | Monomorphic_const _ -> b
+      | Polymorphic_const _ -> subst_instance_constr u (force_constr l_body)
+    end
+  | OpaqueDef _ -> raise (NotEvaluableConst Opaque)
+  | Undef _ -> raise (NotEvaluableConst NoBody)
 
 (* A global const is evaluable if it is defined and not opaque *)
 let evaluable_constant cst env =
diff --git a/checker/environ.mli b/checker/environ.mli
index 8e8d0fd49..36e0ea027 100644
--- a/checker/environ.mli
+++ b/checker/environ.mli
@@ -6,7 +6,7 @@ open Cic
 type globals = {
   env_constants : constant_body Cmap_env.t;
   env_inductives : mutual_inductive_body Mindmap_env.t;
-  env_inductives_eq : kernel_name KNmap.t;
+  env_inductives_eq : KerName.t KNmap.t;
   env_modules : module_body MPmap.t;
   env_modtypes : module_type_body MPmap.t}
 type stratification = {
@@ -18,6 +18,7 @@ type env = {
   env_rel_context : rel_context;
   env_stratification : stratification;
   env_imports : Cic.vodigest MPmap.t;
+  env_conv_oracle : Cic.oracle;
 }
 val empty_env : env
 
@@ -25,6 +26,10 @@ val empty_env : env
 val engagement : env -> Cic.engagement
 val set_engagement : Cic.engagement -> env -> env
 
+(** Oracle *)
+
+val set_oracle : env -> Cic.oracle -> env
+
 (* Digests *)
 val add_digest : env -> DirPath.t -> Cic.vodigest -> env
 val lookup_digest : env -> DirPath.t -> Cic.vodigest
@@ -34,7 +39,7 @@ val rel_context : env -> rel_context
 val lookup_rel : int -> env -> rel_declaration
 val push_rel : rel_declaration -> env -> env
 val push_rel_context : rel_context -> env -> env
-val push_rec_types : name array * constr array * 'a -> env -> env
+val push_rec_types : Name.t array * constr array * 'a -> env -> env
 
 (* Universes *)
 val universes : env -> Univ.universes
@@ -44,31 +49,31 @@ val push_context_set : ?strict:bool -> Univ.universe_context_set -> env -> env
 val check_constraints : Univ.constraints -> env -> bool
 
 (* Constants *)
-val lookup_constant : constant -> env -> Cic.constant_body
-val add_constant : constant -> Cic.constant_body -> env -> env
-val constant_type : env -> constant puniverses -> constr Univ.constrained
-type const_evaluation_result = NoBody | Opaque | IsProj
+val lookup_constant : Constant.t -> env -> Cic.constant_body
+val add_constant : Constant.t -> Cic.constant_body -> env -> env
+val constant_type : env -> Constant.t puniverses -> constr Univ.constrained
+type const_evaluation_result = NoBody | Opaque
 exception NotEvaluableConst of const_evaluation_result
-val constant_value : env -> constant puniverses -> constr
-val evaluable_constant : constant -> env -> bool
+val constant_value : env -> Constant.t puniverses -> constr
+val evaluable_constant : Constant.t -> env -> bool
 
-val is_projection : constant -> env -> bool
+val is_projection : Constant.t -> env -> bool
 val lookup_projection : projection -> env -> projection_body
 
 (* Inductives *)
 val mind_equiv : env -> inductive -> inductive -> bool
 
 val lookup_mind :
-  mutual_inductive -> env -> Cic.mutual_inductive_body
+  MutInd.t -> env -> Cic.mutual_inductive_body
 
 val add_mind :
-  mutual_inductive -> Cic.mutual_inductive_body -> env -> env
+  MutInd.t -> Cic.mutual_inductive_body -> env -> env
 
 (* Modules *)
 val add_modtype :
-  module_path -> Cic.module_type_body -> env -> env
+  ModPath.t -> Cic.module_type_body -> env -> env
 val shallow_add_module :
-  module_path -> Cic.module_body -> env -> env
-val shallow_remove_module : module_path -> env -> env
-val lookup_module : module_path -> env -> Cic.module_body
-val lookup_modtype : module_path -> env -> Cic.module_type_body
+  ModPath.t -> Cic.module_body -> env -> env
+val shallow_remove_module : ModPath.t -> env -> env
+val lookup_module : ModPath.t -> env -> Cic.module_body
+val lookup_modtype : ModPath.t -> env -> Cic.module_type_body
diff --git a/checker/include b/checker/include
index 09bf2826c..da0346359 100644
--- a/checker/include
+++ b/checker/include
@@ -13,7 +13,6 @@
 #directory "kernel";;
 #directory "checker";;
 #directory "+threads";;
-#directory "+camlp4";;
 #directory "+camlp5";;
 
 #load "unix.cma";;
diff --git a/checker/indtypes.ml b/checker/indtypes.ml
index 22c843812..1807ae0ec 100644
--- a/checker/indtypes.ml
+++ b/checker/indtypes.ml
@@ -502,10 +502,19 @@ let check_positivity_one (env, _,ntypes,_ as ienv) hyps nrecp (_,i as ind) indlc
       indlc
   in mk_paths (Mrec ind) irecargs
 
+let prrecarg = function
+  | Norec -> str "Norec"
+  | Mrec (mind,i) ->
+     str "Mrec[" ++ MutInd.debug_print mind ++ pr_comma () ++ int i ++ str "]"
+  | Imbr (mind,i) ->
+     str "Imbr[" ++ MutInd.debug_print mind ++ pr_comma () ++ int i ++ str "]"
+
 let check_subtree t1 t2 =
   let cmp_labels l1 l2 = l1 == Norec || eq_recarg l1 l2 in
   if not (Rtree.equiv eq_recarg cmp_labels t1 t2)
-  then failwith "bad recursive trees"
+  then user_err Pp.(str "Bad recursive tree: found " ++ fnl ()
+    ++ Rtree.pp_tree prrecarg t1 ++ fnl () ++ str " when expected " ++ fnl ()
+    ++ Rtree.pp_tree prrecarg t2)
 (* if t1=t2 then () else msg_warning (str"TODO: check recursive positions")*)
 
 let check_positivity env_ar mind params nrecp inds =
@@ -555,14 +564,23 @@ let check_subtyping cumi paramsctxt env inds =
       We must produce the substitution σ : [ Var(i) -> Var (i + n) | 0 <= i < n]
       and push the constraints [ Var(n) ... Var(2n - 1) |- cst{σ} ], together
       with the cumulativity constraints [ cumul_cst ]. *)
-  let len = AUContext.size (ACumulativityInfo.univ_context cumi) in
-  let inst = Instance.of_array (Array.init len (fun i -> Level.var (i + len))) in
+  let uctx = ACumulativityInfo.univ_context cumi in
+  let len = AUContext.size uctx in
+  let inst = Instance.of_array @@ Array.init len (fun i -> Level.var (i + len)) in
+
   let other_context = ACumulativityInfo.univ_context cumi in
   let uctx_other = UContext.make (inst, AUContext.instantiate inst other_context) in
-  let cumul_context = AUContext.repr (ACumulativityInfo.subtyp_context cumi) in
-  let cumul_cst = UContext.constraints cumul_context in
+  let cumul_cst =
+    Array.fold_left_i (fun i csts var ->
+        match var with
+        | Variance.Irrelevant -> csts
+        | Variance.Covariant -> Constraint.add (Level.var i,Le,Level.var (i+len)) csts
+        | Variance.Invariant -> Constraint.add (Level.var i,Eq,Level.var (i+len)) csts)
+      Constraint.empty (ACumulativityInfo.variance cumi)
+  in
   let env = Environ.push_context uctx_other env in
   let env = Environ.add_constraints cumul_cst env in
+
   (* process individual inductive types: *)
   Array.iter (fun { mind_user_lc = lc; mind_arity = arity } ->
       match arity with
@@ -586,6 +604,8 @@ let check_inductive env kn mib =
       Univ.AUContext.repr (Univ.ACumulativityInfo.univ_context cumi)
   in
   let env = Environ.push_context ind_ctx env in
+  (** Locally set the oracle for further typechecking *)
+  let env0 = Environ.set_oracle env mib.mind_typing_flags.conv_oracle in
   (* check mind_record : TODO ? check #constructor = 1 ? *)
   (* check mind_finite : always OK *)
   (* check mind_ntypes *)
@@ -593,13 +613,13 @@ let check_inductive env kn mib =
     user_err Pp.(str "not the right number of packets");
   (* check mind_params_ctxt *)
   let params = mib.mind_params_ctxt in
-  let _ = check_ctxt env params in
+  let _ = check_ctxt env0 params in
   (* check mind_nparams *)
   if rel_context_nhyps params <> mib.mind_nparams then
     user_err Pp.(str "number the right number of parameters");
   (* mind_packets *)
   (*  - check arities *)
-  let env_ar = typecheck_arity env params mib.mind_packets in
+  let env_ar = typecheck_arity env0 params mib.mind_packets in
   (*  - check constructor types *)
   Array.iter (typecheck_one_inductive env_ar params mib) mib.mind_packets;
   (* check the inferred subtyping relation *)
diff --git a/checker/indtypes.mli b/checker/indtypes.mli
index b0554989e..5d4c3ee99 100644
--- a/checker/indtypes.mli
+++ b/checker/indtypes.mli
@@ -12,8 +12,8 @@ open Cic
 open Environ
 (*i*)
 
-val prkn : kernel_name -> Pp.t
-val prcon : constant -> Pp.t
+val prkn : KerName.t -> Pp.t
+val prcon : Constant.t -> Pp.t
 
 (*s The different kinds of errors that may result of a malformed inductive
   definition. *)
@@ -34,4 +34,4 @@ exception InductiveError of inductive_error
 
 (*s The following function does checks on inductive declarations. *)
 
-val check_inductive : env -> mutual_inductive -> mutual_inductive_body -> env
+val check_inductive : env -> MutInd.t -> mutual_inductive_body -> env
diff --git a/checker/inductive.ml b/checker/inductive.ml
index 1271a02b0..8d426a3c0 100644
--- a/checker/inductive.ml
+++ b/checker/inductive.ml
@@ -381,7 +381,7 @@ let type_case_branches env (pind,largs) (p,pj) c =
 let check_case_info env indsp ci =
   let (mib,mip) = lookup_mind_specif env indsp in
   if
-    not (eq_ind indsp ci.ci_ind) ||
+    not (eq_ind_chk indsp ci.ci_ind) ||
     (mib.mind_nparams <> ci.ci_npar) ||
     (mip.mind_consnrealdecls <> ci.ci_cstr_ndecls) ||
     (mip.mind_consnrealargs <> ci.ci_cstr_nargs)
@@ -435,20 +435,14 @@ type subterm_spec =
   | Dead_code
   | Not_subterm
 
-let eq_recarg r1 r2 = match r1, r2 with
-| Norec, Norec -> true
-| Mrec i1, Mrec i2 -> Names.eq_ind i1 i2
-| Imbr i1, Imbr i2 -> Names.eq_ind i1 i2
-| _ -> false
-
 let eq_wf_paths = Rtree.equal eq_recarg
 
 let inter_recarg r1 r2 = match r1, r2 with
 | Norec, Norec -> Some r1
 | Mrec i1, Mrec i2
 | Imbr i1, Imbr i2
-| Mrec i1, Imbr i2 -> if Names.eq_ind i1 i2 then Some r1 else None
-| Imbr i1, Mrec i2 -> if Names.eq_ind i1 i2 then Some r2 else None
+| Mrec i1, Imbr i2 -> if Names.eq_ind_chk i1 i2 then Some r1 else None
+| Imbr i1, Mrec i2 -> if Names.eq_ind_chk i1 i2 then Some r2 else None
 | _ -> None
 
 let inter_wf_paths = Rtree.inter eq_recarg inter_recarg Norec
@@ -544,7 +538,7 @@ let lookup_subterms env ind =
 
 let match_inductive ind ra =
   match ra with
-    | (Mrec i | Imbr i) -> eq_ind ind i
+    | (Mrec i | Imbr i) -> eq_ind_chk ind i
     | Norec -> false
 
 (* In {match c as z in ci y_s return P with |C_i x_s => t end}
@@ -645,7 +639,7 @@ let get_recargs_approx env tree ind args =
        (* When the inferred tree allows it, we consider that we have a potential
        nested inductive type *)
        begin match dest_recarg tree with
-	     | Imbr kn' | Mrec kn' when eq_ind (fst ind_kn) kn' ->
+             | Imbr kn' | Mrec kn' when eq_ind_chk (fst ind_kn) kn' ->
 			   build_recargs_nested ienv tree (ind_kn, largs)
 	     | _ -> mk_norec
        end
@@ -1070,8 +1064,8 @@ let check_fix env ((nvect,_),(names,_,bodies as _recdef) as fix) =
   done
 
 (*
-let cfkey = Profile.declare_profile "check_fix";;
-let check_fix env fix = Profile.profile3 cfkey check_fix env fix;;
+let cfkey = CProfile.declare_profile "check_fix";;
+let check_fix env fix = CProfile.profile3 cfkey check_fix env fix;;
 *)
 
 (************************************************************************)
diff --git a/checker/inductive.mli b/checker/inductive.mli
index 8f605935d..0170bbc94 100644
--- a/checker/inductive.mli
+++ b/checker/inductive.mli
@@ -31,7 +31,7 @@ val type_of_inductive : env -> mind_specif puniverses -> constr
 (* Return type as quoted by the user *)
 val type_of_constructor : pconstructor -> mind_specif -> constr
 
-val arities_of_specif : mutual_inductive puniverses -> mind_specif -> constr array
+val arities_of_specif : MutInd.t puniverses -> mind_specif -> constr array
 
 (* [type_case_branches env (I,args) (p:A) c] computes useful types
    about the following Cases expression:
diff --git a/checker/main.mli b/checker/main.mli
new file mode 100644
index 000000000..e1555ba2e
--- /dev/null
+++ b/checker/main.mli
@@ -0,0 +1,10 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(* This empty file avoids a race condition that occurs when compiling a .ml file
+   that does not have a corresponding .mli file *)
diff --git a/checker/mod_checking.ml b/checker/mod_checking.ml
index b6816dd48..7685863ea 100644
--- a/checker/mod_checking.ml
+++ b/checker/mod_checking.ml
@@ -25,11 +25,14 @@ let refresh_arity ar =
     | _ -> ar, Univ.ContextSet.empty
 
 let check_constant_declaration env kn cb =
-  Feedback.msg_notice (str "  checking cst:" ++ prcon kn);
+  Flags.if_verbose Feedback.msg_notice (str "  checking cst:" ++ prcon kn);
+  (** Locally set the oracle for further typechecking *)
+  let oracle = env.env_conv_oracle in
+  let env = Environ.set_oracle env cb.const_typing_flags.conv_oracle in
   (** [env'] contains De Bruijn universe variables *)
   let env' =
     match cb.const_universes with
-    | Monomorphic_const ctx -> push_context ~strict:true ctx env
+    | Monomorphic_const ctx -> push_context_set ~strict:true ctx env
     | Polymorphic_const auctx ->
       let ctx = Univ.AUContext.repr auctx in
       push_context ~strict:false ctx env
@@ -53,8 +56,12 @@ let check_constant_declaration env kn cb =
 	  conv_leq envty j ty)
     | None -> ()
   in
-  if constant_is_polymorphic cb then add_constant kn cb env
-  else add_constant kn cb env'
+  let env =
+    if constant_is_polymorphic cb then add_constant kn cb env
+    else add_constant kn cb env'
+  in
+  (** Reset the value of the oracle *)
+  Environ.set_oracle env oracle
 
 (** {6 Checking modules } *)
 
@@ -70,12 +77,12 @@ let lookup_module mp env =
 
 let mk_mtb mp sign delta =
   { mod_mp = mp;
-    mod_expr = Abstract;
+    mod_expr = ();
     mod_type = sign;
     mod_type_alg = None;
     mod_constraints = Univ.ContextSet.empty;
     mod_delta = delta;
-    mod_retroknowledge = []; }
+    mod_retroknowledge = ModTypeRK; }
 
 let rec check_module env mp mb =
   let (_:module_signature) =
diff --git a/checker/mod_checking.mli b/checker/mod_checking.mli
index 16a3792aa..c7af8b286 100644
--- a/checker/mod_checking.mli
+++ b/checker/mod_checking.mli
@@ -6,4 +6,4 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-val check_module : Environ.env -> Names.module_path -> Cic.module_body -> unit
+val check_module : Environ.env -> Names.ModPath.t -> Cic.module_body -> unit
diff --git a/checker/modops.ml b/checker/modops.ml
index 79cd5c29f..f0abc39ea 100644
--- a/checker/modops.ml
+++ b/checker/modops.ml
@@ -49,7 +49,7 @@ let destr_functor = function
   | NoFunctor _ -> error_not_a_functor ()
 
 let module_body_of_type mp mtb =
-  { mtb with mod_mp = mp; mod_expr = Abstract }
+  { mtb with mod_mp = mp; mod_expr = Abstract; mod_retroknowledge = ModBodyRK [] }
 
 let rec add_structure mp sign resolver env =
   let add_one env (l,elem) =
@@ -93,17 +93,19 @@ let strengthen_const mp_from l cb resolver =
 
 let rec strengthen_mod mp_from mp_to mb =
   if Declarations.mp_in_delta mb.mod_mp mb.mod_delta then mb
-  else strengthen_body true mp_from mp_to mb
+  else
+    let mk_expr mp_to = Algebraic (NoFunctor (MEident mp_to)) in
+    strengthen_body mk_expr mp_from mp_to mb
 
-and strengthen_body is_mod mp_from mp_to mb =
+and strengthen_body : 'a. (_ -> 'a) -> _ -> _ -> 'a generic_module_body -> 'a generic_module_body =
+  fun mk_expr mp_from mp_to mb ->
   match mb.mod_type with
   | MoreFunctor _ -> mb
   | NoFunctor sign ->
     let resolve_out,sign_out = strengthen_sig mp_from sign mp_to mb.mod_delta
     in
     { mb with
-      mod_expr =
-        (if is_mod then Algebraic (NoFunctor (MEident mp_to)) else Abstract);
+      mod_expr = mk_expr mp_to;
       mod_type = NoFunctor sign_out;
       mod_delta = resolve_out }
 
@@ -130,7 +132,7 @@ and strengthen_sig mp_from sign mp_to resolver =
 	resolve_out,item::rest'
 
 let strengthen mtb mp =
-  strengthen_body false mtb.mod_mp mp mtb
+  strengthen_body ignore mtb.mod_mp mp mtb
 
 let subst_and_strengthen mb mp =
   strengthen_mod mb.mod_mp mp (subst_module (map_mp mb.mod_mp mp) mb)
@@ -138,9 +140,9 @@ let subst_and_strengthen mb mp =
 let module_type_of_module mp mb =
   let mtb =
     { mb with
-      mod_expr = Abstract;
+      mod_expr = ();
       mod_type_alg = None;
-      mod_retroknowledge = [] }
+      mod_retroknowledge = ModTypeRK }
   in
   match mp with
   | Some mp -> strengthen {mtb with mod_mp = mp} mp
diff --git a/checker/modops.mli b/checker/modops.mli
index 0efff63c8..b73557d92 100644
--- a/checker/modops.mli
+++ b/checker/modops.mli
@@ -15,7 +15,7 @@ open Environ
 (* Various operations on modules and module types *)
 
 val module_type_of_module :
-  module_path option -> module_body -> module_type_body
+  ModPath.t option -> module_body -> module_type_body
 
 val is_functor : ('ty,'a) functorize -> bool
 
@@ -24,24 +24,24 @@ val destr_functor : ('ty,'a) functorize -> MBId.t * 'ty * ('ty,'a) functorize
 (* adds a module and its components, but not the constraints *)
 val add_module : module_body ->  env -> env
 
-val add_module_type : module_path -> module_type_body -> env -> env
+val add_module_type : ModPath.t -> module_type_body -> env -> env
 
-val strengthen : module_type_body -> module_path -> module_type_body
+val strengthen : module_type_body -> ModPath.t -> module_type_body
 
-val subst_and_strengthen : module_body -> module_path -> module_body
+val subst_and_strengthen : module_body -> ModPath.t -> module_body
 
 val error_incompatible_modtypes :
   module_type_body -> module_type_body -> 'a
 
-val error_not_match : label -> structure_field_body -> 'a
+val error_not_match : Label.t -> structure_field_body -> 'a
 
 val error_with_module : unit -> 'a
 
-val error_no_such_label : label -> 'a
+val error_no_such_label : Label.t -> 'a
 
 val error_no_such_label_sub :
-  label -> module_path -> 'a
+  Label.t -> ModPath.t -> 'a
 
-val error_not_a_constant : label -> 'a
+val error_not_a_constant : Label.t -> 'a
 
-val error_not_a_module : label -> 'a
+val error_not_a_module : Label.t -> 'a
diff --git a/checker/print.mli b/checker/print.mli
new file mode 100644
index 000000000..3b2715de9
--- /dev/null
+++ b/checker/print.mli
@@ -0,0 +1,11 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Cic
+
+val print_pure_constr : constr -> unit
diff --git a/checker/reduction.ml b/checker/reduction.ml
index 6d8783d7e..d7d742d8a 100644
--- a/checker/reduction.ml
+++ b/checker/reduction.ml
@@ -42,8 +42,8 @@ let compare_stack_shape stk1 stk2 =
     | (_, Zapp l2::s2) -> compare_rec (bal-Array.length l2) stk1 s2
     | (Zproj (n1,m1,p1)::s1, Zproj (n2,m2,p2)::s2) ->
         Int.equal bal 0 && compare_rec 0 s1 s2
-    | ((Zcase(c1,_,_)|ZcaseT(c1,_,_,_))::s1,
-       (Zcase(c2,_,_)|ZcaseT(c2,_,_,_))::s2) ->
+    | ((ZcaseT(c1,_,_,_))::s1,
+       (ZcaseT(c2,_,_,_))::s2) ->
         bal=0 (* && c1.ci_ind  = c2.ci_ind *) && compare_rec 0 s1 s2
     | (Zfix(_,a1)::s1, Zfix(_,a2)::s2) ->
         bal=0 && compare_rec 0 a1 a2 && compare_rec 0 s1 s2
@@ -78,8 +78,7 @@ let pure_stack lfts stk =
                 (l, Zlfix((lfx,fx),pa)::pstk)
             | (ZcaseT(ci,p,br,env),(l,pstk)) ->
                 (l,Zlcase(ci,l,mk_clos env p,mk_clos_vect env br)::pstk)
-            | (Zcase(ci,p,br),(l,pstk)) ->
-                (l,Zlcase(ci,l,p,br)::pstk)) in
+            ) in
   snd (pure_rec lfts stk)
 
 (****************************************************************************)
@@ -159,24 +158,17 @@ let compare_stacks f fmind lft1 stk1 lft2 stk2 =
 let convert_inductive_instances cv_pb cumi u u' univs =
   let len_instance =
       Univ.AUContext.size (Univ.ACumulativityInfo.univ_context cumi) in
-  let ind_subtypctx =  Univ.ACumulativityInfo.subtyp_context cumi in
   if not ((len_instance = Univ.Instance.length u) &&
           (len_instance = Univ.Instance.length u')) then
     anomaly (Pp.str "Invalid inductive subtyping encountered!")
   else
-    let comp_cst =
-      let comp_subst = (Univ.Instance.append u u') in
-      Univ.AUContext.instantiate comp_subst ind_subtypctx
-    in
+    let variance = Univ.ACumulativityInfo.variance cumi in
     let comp_cst =
       match cv_pb with
-        CONV ->
-        let comp_cst' =
-          let comp_subst = (Univ.Instance.append u' u) in
-          Univ.AUContext.instantiate comp_subst ind_subtypctx
-        in
-        Univ.Constraint.union comp_cst comp_cst'
-      | CUMUL -> comp_cst
+      | CONV ->
+        Univ.Variance.eq_constraints variance u u' Univ.Constraint.empty
+      | CUMUL ->
+        Univ.Variance.leq_constraints variance u u' Univ.Constraint.empty
     in
     if (Univ.check_constraints comp_cst univs) then () else raise NotConvertible
 
@@ -243,7 +235,6 @@ let rec no_arg_available = function
   | Zshift _ :: stk -> no_arg_available stk
   | Zapp v :: stk -> Array.length v = 0 && no_arg_available stk
   | Zproj _ :: _ -> true
-  | Zcase _ :: _ -> true
   | ZcaseT _ :: _ -> true
   | Zfix _ :: _ -> true
 
@@ -256,7 +247,6 @@ let rec no_nth_arg_available n = function
       if n >= k then no_nth_arg_available (n-k) stk
       else false
   | Zproj _ :: _ -> true
-  | Zcase _ :: _ -> true
   | ZcaseT _ :: _ -> true
   | Zfix _ :: _ -> true
 
@@ -266,13 +256,12 @@ let rec no_case_available = function
   | Zshift _ :: stk -> no_case_available stk
   | Zapp _ :: stk -> no_case_available stk
   | Zproj (_,_,_) :: _ -> false
-  | Zcase _ :: _ -> false
   | ZcaseT _ :: _ -> false
   | Zfix _ :: _ -> true
 
 let in_whnf (t,stk) =
   match fterm_of t with
-    | (FLetIn _ | FCase _ | FCaseT _ | FApp _ | FCLOS _ | FLIFT _ | FCast _) -> false
+    | (FLetIn _ | FCaseT _ | FApp _ | FCLOS _ | FLIFT _ | FCast _) -> false
     | FLambda _ -> no_arg_available stk
     | FConstruct _ -> no_case_available stk
     | FCoFix _ -> no_case_available stk
@@ -280,16 +269,29 @@ let in_whnf (t,stk) =
     | (FFlex _ | FProd _ | FEvar _ | FInd _ | FAtom _ | FRel _ | FProj _) -> true
     | FLOCKED -> assert false
 
-let oracle_order fl1 fl2 =
-  match fl1,fl2 with
-      ConstKey c1, ConstKey c2 -> (*height c1 > height c2*)false
-    | _, ConstKey _ -> true
-    | _ -> false
-
-let unfold_projection infos p c =
-  let pb = lookup_projection p (infos_env infos) in
-  let s = Zproj (pb.proj_npars, pb.proj_arg, p) in
-    (c, s)
+let default_level = Level 0
+
+let get_strategy { var_opacity; cst_opacity } = function
+  | VarKey id ->
+      (try Names.Id.Map.find id var_opacity
+      with Not_found -> default_level)
+  | ConstKey (c, _) ->
+      (try Names.Cmap.find c cst_opacity
+      with Not_found -> default_level)
+  | RelKey _ -> Expand
+
+let oracle_order infos l2r k1 k2 =
+  let o = Closure.oracle_of_infos infos in
+  match get_strategy o k1, get_strategy o k2 with
+  | Expand, Expand -> l2r
+  | Expand, (Opaque | Level _) -> true
+  | (Opaque | Level _), Expand -> false
+  | Opaque, Opaque -> l2r
+  | Level _, Opaque -> true
+  | Opaque, Level _ -> false
+  | Level n1, Level n2 ->
+     if Int.equal n1 n2 then l2r
+     else n1 < n2
 
 (* Conversion between  [lft1]term1 and [lft2]term2 *)
 let rec ccnv univ cv_pb infos lft1 lft2 term1 term2 =
@@ -343,7 +345,7 @@ and eqappr univ cv_pb infos (lft1,st1) (lft2,st2) =
         with NotConvertible ->
           (* else the oracle tells which constant is to be expanded *)
           let (app1,app2) =
-            if oracle_order fl1 fl2 then
+            if oracle_order infos false fl1 fl2 then
               match unfold_reference infos fl1 with
               | Some def1 -> ((lft1, whd_stack infos def1 v1), appr2)
               | None ->
@@ -360,12 +362,12 @@ and eqappr univ cv_pb infos (lft1,st1) (lft2,st2) =
             eqappr univ cv_pb infos app1 app2)
 	  
     | (FProj (p1,c1), _) ->
-      let (def1, s1) = unfold_projection infos p1 c1 in
-        eqappr univ cv_pb infos (lft1, whd_stack infos def1 (s1 :: v1)) appr2
+      let s1 = unfold_projection (infos_env infos) p1 in
+        eqappr univ cv_pb infos (lft1, whd_stack infos c1 (s1 :: v1)) appr2
 	  
     | (_, FProj (p2,c2)) ->
-      let (def2, s2) = unfold_projection infos p2 c2 in
-        eqappr univ cv_pb infos appr1 (lft2, whd_stack infos def2 (s2 :: v2))
+      let s2 = unfold_projection (infos_env infos) p2 in
+        eqappr univ cv_pb infos appr1 (lft2, whd_stack infos c2 (s2 :: v2))
 
     (* other constructors *)
     | (FLambda _, FLambda _) ->
@@ -504,8 +506,8 @@ and eqappr univ cv_pb infos (lft1,st1) (lft2,st2) =
          else raise NotConvertible
 
      (* Should not happen because both (hd1,v1) and (hd2,v2) are in whnf *)
-     | ( (FLetIn _, _) | (FCase _,_) | (FCaseT _,_) | (FApp _,_) | (FCLOS _,_) | (FLIFT _,_)
-       | (_, FLetIn _) | (_,FCase _) | (_,FCaseT _) | (_,FApp _) | (_,FCLOS _) | (_,FLIFT _)
+     | ( (FLetIn _, _) | (FCaseT _,_) | (FApp _,_) | (FCLOS _,_) | (FLIFT _,_)
+       | (_, FLetIn _) | (_,FCaseT _) | (_,FApp _) | (_,FCLOS _) | (_,FLIFT _)
        | (FLOCKED,_) | (_,FLOCKED) ) -> assert false
 
      (* In all other cases, terms are not convertible *)
@@ -580,7 +582,6 @@ let dest_prod_assum env =
     | LetIn (x,b,t,c) ->
         let d = LocalDef (x,b,t) in
 	prodec_rec (push_rel d env) (d::l) c
-    | Cast (c,_,_)    -> prodec_rec env l c
     | _               ->
       let rty' = whd_all env rty in
 	if Term.eq_constr rty' rty then l, rty
@@ -598,7 +599,6 @@ let dest_lam_assum env =
     | LetIn (x,b,t,c) ->
         let d = LocalDef (x,b,t) in
 	lamec_rec (push_rel d env) (d::l) c
-    | Cast (c,_,_)    -> lamec_rec env l c
     | _               -> l,rty
   in
   lamec_rec env empty_rel_context
diff --git a/checker/subtyping.ml b/checker/subtyping.ml
index 68a467bea..77201c25b 100644
--- a/checker/subtyping.ml
+++ b/checker/subtyping.ml
@@ -108,6 +108,14 @@ let check_inductive  env mp1 l info1 mib2 spec2 subst1 subst2=
       let env = check_polymorphic_instance error env auctx auctx' in
       env, Univ.make_abstract_instance auctx'
     | Cumulative_ind cumi, Cumulative_ind cumi' ->
+      (** Currently there is no way to control variance of inductive types, but
+          just in case we require that they are in a subtyping relation. *)
+      let () =
+        let v = Univ.ACumulativityInfo.variance cumi in
+        let v' = Univ.ACumulativityInfo.variance cumi' in
+        if not (Array.for_all2 Univ.Variance.check_subtype v' v) then
+          CErrors.anomaly Pp.(str "Variance mismatch for " ++ MutInd.print kn)
+      in
       let auctx = Univ.ACumulativityInfo.univ_context cumi in
       let auctx' = Univ.ACumulativityInfo.univ_context cumi' in
       let env = check_polymorphic_instance error env auctx auctx' in
@@ -393,7 +401,7 @@ and check_modtypes env mtb1 mtb2 subst1 subst2 equiv =
 			  mod_type = body_t1;
 			  mod_type_alg = None;
 			  mod_constraints = mtb1.mod_constraints;
-			  mod_retroknowledge = [];
+			  mod_retroknowledge = ModBodyRK [];
 			  mod_delta = mtb1.mod_delta} env
 	  in
 	  check_structure env body_t1 body_t2 equiv
diff --git a/checker/term.mli b/checker/term.mli
index 679a56ee4..2524dff18 100644
--- a/checker/term.mli
+++ b/checker/term.mli
@@ -38,8 +38,8 @@ val fold_rel_context_outside :
 val map_rel_decl : (constr -> constr) -> rel_declaration -> rel_declaration
 val map_rel_context : (constr -> constr) -> rel_context -> rel_context
 val extended_rel_list : int -> rel_context -> constr list
-val compose_lam : (name * constr) list -> constr -> constr
-val decompose_lam : constr -> (name * constr) list * constr
+val compose_lam : (Name.t * constr) list -> constr -> constr
+val decompose_lam : constr -> (Name.t * constr) list * constr
 val decompose_lam_n_assum : int -> constr -> rel_context * constr
 val mkProd_or_LetIn : rel_declaration -> constr -> constr
 val it_mkProd_or_LetIn : constr -> rel_context -> constr
diff --git a/checker/type_errors.ml b/checker/type_errors.ml
index c5a69efdc..5794d8713 100644
--- a/checker/type_errors.ml
+++ b/checker/type_errors.ml
@@ -52,14 +52,14 @@ type type_error =
   | WrongCaseInfo of inductive * case_info
   | NumberBranches of unsafe_judgment * int
   | IllFormedBranch of constr * int * constr * constr
-  | Generalization of (name * constr) * unsafe_judgment
+  | Generalization of (Name.t * constr) * unsafe_judgment
   | ActualType of unsafe_judgment * constr
   | CantApplyBadType of
       (int * constr * constr) * unsafe_judgment * unsafe_judgment array
   | CantApplyNonFunctional of unsafe_judgment * unsafe_judgment array
-  | IllFormedRecBody of guard_error * name array * int
+  | IllFormedRecBody of guard_error * Name.t array * int
   | IllTypedRecBody of
-      int * name array * unsafe_judgment array * constr array
+      int * Name.t array * unsafe_judgment array * constr array
   | UnsatisfiedConstraints of Univ.constraints
 
 exception TypeError of env * type_error
diff --git a/checker/type_errors.mli b/checker/type_errors.mli
index b5f14c718..f45144c23 100644
--- a/checker/type_errors.mli
+++ b/checker/type_errors.mli
@@ -54,14 +54,14 @@ type type_error =
   | WrongCaseInfo of inductive * case_info
   | NumberBranches of unsafe_judgment * int
   | IllFormedBranch of constr * int * constr * constr
-  | Generalization of (name * constr) * unsafe_judgment
+  | Generalization of (Name.t * constr) * unsafe_judgment
   | ActualType of unsafe_judgment * constr
   | CantApplyBadType of
       (int * constr * constr) * unsafe_judgment * unsafe_judgment array
   | CantApplyNonFunctional of unsafe_judgment * unsafe_judgment array
-  | IllFormedRecBody of guard_error * name array * int
+  | IllFormedRecBody of guard_error * Name.t array * int
   | IllTypedRecBody of
-      int * name array * unsafe_judgment array * constr array
+      int * Name.t array * unsafe_judgment array * constr array
   | UnsatisfiedConstraints of Univ.constraints
 
 exception TypeError of env * type_error
@@ -96,9 +96,9 @@ val error_cant_apply_bad_type :
       unsafe_judgment -> unsafe_judgment array -> 'a
 
 val error_ill_formed_rec_body :
-  env -> guard_error -> name array -> int -> 'a
+  env -> guard_error -> Name.t array -> int -> 'a
 
 val error_ill_typed_rec_body  :
-  env -> int -> name array -> unsafe_judgment array -> constr array -> 'a
+  env -> int -> Name.t array -> unsafe_judgment array -> constr array -> 'a
 
 val error_unsatisfied_constraints : env -> Univ.constraints -> 'a
diff --git a/checker/univ.ml b/checker/univ.ml
index 558315c2c..ebc37bc10 100644
--- a/checker/univ.ml
+++ b/checker/univ.ml
@@ -29,107 +29,6 @@ open Util
    union-find algorithm. The assertions $<$ and $\le$ are represented by
    adjacency lists *)
 
-module type Hashconsed =
-sig
-  type t
-  val hash : t -> int
-  val eq : t -> t -> bool
-  val hcons : t -> t
-end
-
-module HashedList (M : Hashconsed) :
-sig
-  type t = private Nil | Cons of M.t * int * t
-  val nil : t
-  val cons : M.t -> t -> t
-end =
-struct
-  type t = Nil | Cons of M.t * int * t
-  module Self =
-  struct
-    type _t = t
-    type t = _t
-    type u = (M.t -> M.t)
-    let hash = function Nil -> 0 | Cons (_, h, _) -> h
-    let eq l1 l2 = match l1, l2 with
-    | Nil, Nil -> true
-    | Cons (x1, _, l1), Cons (x2, _, l2) -> x1 == x2 && l1 == l2
-    | _ -> false
-    let hashcons hc = function
-    | Nil -> Nil
-    | Cons (x, h, l) -> Cons (hc x, h, l)
-  end
-  module Hcons = Hashcons.Make(Self)
-  let hcons = Hashcons.simple_hcons Hcons.generate Hcons.hcons M.hcons
-  (** No recursive call: the interface guarantees that all HLists from this
-      program are already hashconsed. If we get some external HList, we can
-      still reconstruct it by traversing it entirely. *)
-  let nil = Nil
-  let cons x l =
-    let h = M.hash x in
-    let hl = match l with Nil -> 0 | Cons (_, h, _) -> h in
-    let h = Hashset.Combine.combine h hl in
-    hcons (Cons (x, h, l))
-end
-
-module HList = struct
-
-  module type S = sig
-    type elt
-    type t = private Nil | Cons of elt * int * t
-    val hash : t -> int
-    val nil : t
-    val cons : elt -> t -> t
-    val tip : elt -> t
-    val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
-    val map : (elt -> elt) -> t -> t
-    val smartmap : (elt -> elt) -> t -> t
-    val exists : (elt -> bool) -> t -> bool
-    val for_all : (elt -> bool) -> t -> bool
-    val for_all2 : (elt -> elt -> bool) -> t -> t -> bool
-    val to_list : t -> elt list
-  end
-
-  module Make (H : Hashconsed) : S with type elt = H.t =
-  struct
-  type elt = H.t
-  include HashedList(H)
-
-  let hash = function Nil -> 0 | Cons (_, h, _) -> h
-
-  let tip e = cons e nil
-
-  let rec fold f l accu = match l with
-  | Nil -> accu
-  | Cons (x, _, l) -> fold f l (f x accu)
-
-  let rec map f = function
-  | Nil -> nil
-  | Cons (x, _, l) -> cons (f x) (map f l)
-
-  let smartmap = map
-  (** Apriori hashconsing ensures that the map is equal to its argument *)
-
-  let rec exists f = function
-  | Nil -> false
-  | Cons (x, _, l) -> f x || exists f l
-
-  let rec for_all f = function
-  | Nil -> true
-  | Cons (x, _, l) -> f x && for_all f l
-
-  let rec for_all2 f l1 l2 = match l1, l2 with
-  | Nil, Nil -> true
-  | Cons (x1, _, l1), Cons (x2, _, l2) -> f x1 x2 && for_all2 f l1 l2
-  | _ -> false
-
-  let rec to_list = function
-  | Nil -> []
-  | Cons (x, _, l) -> x :: to_list l
-
-  end
-end
-
 module RawLevel =
 struct
   open Names
@@ -167,24 +66,6 @@ struct
     | _, Level _ -> 1
     | Var n, Var m -> Int.compare n m
 
-  let hequal x y =
-    x == y ||
-      match x, y with
-      | Prop, Prop -> true
-      | Set, Set -> true
-      | Level (n,d), Level (n',d') ->
-        n == n' && d == d'
-      | Var n, Var n' -> n == n'
-      | _ -> false
-
-  let hcons = function
-    | Prop as x -> x
-    | Set as x -> x
-    | Level (n,d) as x -> 
-      let d' = Names.DirPath.hcons d in
-        if d' == d then x else Level (n,d')
-    | Var n as x -> x
-
   open Hashset.Combine
 
   let hash = function
@@ -216,24 +97,7 @@ module Level = struct
 
   let data x = x.data
 
-  (** Hashcons on levels + their hash *)
-
-  module Self = struct
-    type _t = t
-    type t = _t
-    type u = unit
-    let eq x y = x.hash == y.hash && RawLevel.hequal x.data y.data
-    let hash x = x.hash
-    let hashcons () x =
-      let data' = RawLevel.hcons x.data in
-      if x.data == data' then x else { x with data = data' }
-  end
-
-  let hcons =
-    let module H = Hashcons.Make(Self) in
-    Hashcons.simple_hcons H.generate H.hcons ()
-
-  let make l = hcons { hash = RawLevel.hash l; data = l }
+  let make l = { hash = RawLevel.hash l; data = l }
 
   let set = make Set
   let prop = make Prop
@@ -270,7 +134,7 @@ module Level = struct
 
   let pr u = str (to_string u)
 
-  let make m n = make (Level (n, Names.DirPath.hcons m))
+  let make m n = make (Level (n, m))
 
 end
 
@@ -303,48 +167,12 @@ struct
   module Expr = 
   struct
     type t = Level.t * int
-    type _t = t
 	
-    (* Hashing of expressions *)
-    module ExprHash = 
-    struct
-      type t = _t
-      type u = Level.t -> Level.t
-      let hashcons hdir (b,n as x) = 
-	let b' = hdir b in 
-	  if b' == b then x else (b',n)
-      let eq l1 l2 =
-        l1 == l2 || 
-        match l1,l2 with
-	| (b,n), (b',n') -> b == b' && n == n'
-
-      let hash (x, n) = n + Level.hash x
-
-    end
-
-    module HExpr =
-    struct
+    let make l = (l, 0)
 
-      module H = Hashcons.Make(ExprHash)
-
-      type t = ExprHash.t
-
-      let hcons =
-        Hashcons.simple_hcons H.generate H.hcons Level.hcons
-      let hash = ExprHash.hash
-      let eq x y = x == y ||
-        (let (u,n) = x and (v,n') = y in
-           Int.equal n n' && Level.equal u v)
-
-    end
-
-    let hcons = HExpr.hcons
-
-    let make l = hcons (l, 0)
-
-    let prop = make Level.prop
-    let set = make Level.set
-    let type1 = hcons (Level.set, 1)
+    let prop = (Level.prop, 0)
+    let set = (Level.set, 0)
+    let type1 = (Level.set, 1)
 
     let is_prop = function
       | (l,0) -> Level.is_prop l
@@ -363,13 +191,13 @@ struct
 
     let successor (u,n) =
       if Level.is_prop u then type1
-      else hcons (u, n + 1)
+      else (u, n + 1)
 
     let addn k (u,n as x) = 
       if k = 0 then x 
       else if Level.is_prop u then
-	hcons (Level.set,n+k)
-      else hcons (u,n+k)
+	(Level.set,n+k)
+      else (u,n+k)
 	
     let super (u,n as x) (v,n' as y) =
       let cmp = Level.compare u v in
@@ -394,31 +222,29 @@ struct
       let v' = f v in 
 	if v' == v then x
 	else if Level.is_prop v' && n != 0 then
-	  hcons (Level.set, n)
-	else hcons (v', n)
+	  (Level.set, n)
+	else (v', n)
 
   end
-    
-  module Huniv = HList.Make(Expr.HExpr)
-  type t = Huniv.t
-  open Huniv
-    
-  let equal x y = x == y || 
-    (Huniv.hash x == Huniv.hash y && 
-       Huniv.for_all2 Expr.equal x y)
 
-  let make l = Huniv.tip (Expr.make l)
-  let tip x = Huniv.tip x
-    
+  type t = Expr.t list
+
+  let tip u = [u]
+  let cons u v = u :: v
+
+  let equal x y = x == y || List.equal Expr.equal x y
+
+  let make l = tip (Expr.make l)
+
   let pr l = match l with
-    | Cons (u, _, Nil) -> Expr.pr u
+    | [u] -> Expr.pr u
     | _ -> 
       str "max(" ++ hov 0
-	(prlist_with_sep pr_comma Expr.pr (to_list l)) ++
+	(prlist_with_sep pr_comma Expr.pr l) ++
         str ")"
 
   let level l = match l with
-    | Cons (l, _, Nil) -> Expr.level l
+    | [l] -> Expr.level l
     | _ -> None
 
   (* The lower predicative level of the hierarchy that contains (impredicative)
@@ -438,16 +264,16 @@ struct
   (* Returns the formal universe that lies juste above the universe variable u.
      Used to type the sort u. *)
   let super l = 
-    Huniv.map (fun x -> Expr.successor x) l
+    List.map (fun x -> Expr.successor x) l
 
   let addn n l =
-    Huniv.map (fun x -> Expr.addn n x) l
+    List.map (fun x -> Expr.addn n x) l
 
   let rec merge_univs l1 l2 =
     match l1, l2 with
-    | Nil, _ -> l2
-    | _, Nil -> l1
-    | Cons (h1, _, t1), Cons (h2, _, t2) ->
+    | [], _ -> l2
+    | _, [] -> l1
+    | h1 :: t1, h2 :: t2 ->
       (match Expr.super h1 h2 with
       | Inl true (* h1 < h2 *) -> merge_univs t1 l2
       | Inl false -> merge_univs l1 t2
@@ -459,28 +285,28 @@ struct
   let sort u =
     let rec aux a l = 
       match l with
-      | Cons (b, _, l') ->
+      | 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'))
-      | Nil -> cons a l
+      | [] -> cons a l
     in 
-      fold (fun a acc -> aux a acc) u nil
+      List.fold_right (fun a acc -> aux a acc) u []
 	
   (* Returns the formal universe that is greater than the universes u and v.
      Used to type the products. *)
   let sup x y = merge_univs x y
 
-  let empty = nil
+  let empty = []
 
-  let exists = Huniv.exists
+  let exists = List.exists
 
-  let for_all = Huniv.for_all
+  let for_all = List.for_all
 
-  let smartmap = Huniv.smartmap
+  let smartmap = List.smartmap
 
 end
 
@@ -768,9 +594,9 @@ let check_equal_expr g x y =
 
 let check_eq_univs g l1 l2 =
   let f x1 x2 = check_equal_expr g x1 x2 in
-  let exists x1 l = Huniv.exists (fun x2 -> f x1 x2) l in
-    Huniv.for_all (fun x1 -> exists x1 l2) l1
-    && Huniv.for_all (fun x2 -> exists x2 l1) l2
+  let exists x1 l = List.exists (fun x2 -> f x1 x2) l in
+    List.for_all (fun x1 -> exists x1 l2) l1
+    && List.for_all (fun x2 -> exists x2 l1) l2
 
 let check_eq g u v =
   Universe.equal u v || check_eq_univs g u v
@@ -784,11 +610,11 @@ let check_smaller_expr g (u,n) (v,m) =
     | _ -> false
 
 let exists_bigger g ul l =
-  Huniv.exists (fun ul' -> 
+  Universe.exists (fun ul' -> 
     check_smaller_expr g ul ul') l
 
 let real_check_leq g u v =
-  Huniv.for_all (fun ul -> exists_bigger g ul v) u
+  Universe.for_all (fun ul -> exists_bigger g ul v) u
     
 let check_leq g u v =
   Universe.equal u v ||
@@ -1026,8 +852,8 @@ let check_univ_leq u v =
 
 let enforce_leq u v c =
   match v with
-  | Universe.Huniv.Cons (v, _, Universe.Huniv.Nil) ->
-    Universe.Huniv.fold (fun u -> constraint_add_leq u v) u c
+  | [v] ->
+    List.fold_right (fun u -> constraint_add_leq u v) u c
   | _ -> anomaly (Pp.str"A universe bound can only be a variable.")
 
 let enforce_leq u v c =
@@ -1055,14 +881,6 @@ type universe_level_subst = universe_level universe_map
 (** A full substitution might involve algebraic universes *)
 type universe_subst = universe universe_map
 
-let level_subst_of f = 
-  fun l -> 
-    try let u = f l in 
-	  match Universe.level u with
-	  | None -> l
-	  | Some l -> l
-    with Not_found -> l
-     
 module Instance : sig 
     type t = Level.t array
 
@@ -1080,63 +898,18 @@ end =
 struct
   type t = Level.t array
 
-  let empty : t = [||]
-
-  module HInstancestruct =
-  struct
-    type _t = t
-    type t = _t
-    type u = Level.t -> Level.t
-
-    let hashcons huniv a = 
-      let len = Array.length a in
-	if Int.equal len 0 then empty
-	else begin
-	  for i = 0 to len - 1 do
-	    let x = Array.unsafe_get a i in
-	    let x' = huniv x in
-	      if x == x' then ()
-	      else Array.unsafe_set a i x'
-	  done;
-	  a
-	end
-
-    let eq t1 t2 =
-      t1 == t2 ||
-	(Int.equal (Array.length t1) (Array.length t2) &&
-	   let rec aux i =
-	     (Int.equal i (Array.length t1)) || (t1.(i) == t2.(i) && aux (i + 1))
-	   in aux 0)
-	
-    let hash a = 
-      let accu = ref 0 in
-	for i = 0 to Array.length a - 1 do
-	  let l = Array.unsafe_get a i in
-	  let h = Level.hash l in
-	    accu := Hashset.Combine.combine !accu h;
-	done;
-	(* [h] must be positive. *)
-	let h = !accu land 0x3FFFFFFF in
-	  h
-
-  end
-
-  module HInstance = Hashcons.Make(HInstancestruct)
-
-  let hcons = Hashcons.simple_hcons HInstance.generate HInstance.hcons Level.hcons
-    
-  let empty = hcons [||]
+  let empty = [||]
 
   let is_empty x = Int.equal (Array.length x) 0
 
   let subst_fn fn t = 
     let t' = CArray.smartmap fn t in
-      if t' == t then t else hcons t'
+      if t' == t then t else t'
 
   let subst s t =
     let t' = 
       CArray.smartmap (fun x -> try LMap.find x s with Not_found -> x) t
-    in if t' == t then t else hcons t'
+    in if t' == t then t else t'
 
   let pr =
     prvect_with_sep spc Level.pr
@@ -1230,12 +1003,49 @@ end
 
 type abstract_universe_context = AUContext.t
 
+module Variance =
+struct
+  (** A universe position in the instance given to a cumulative
+     inductive can be the following. Note there is no Contravariant
+     case because [forall x : A, B <= forall x : A', B'] requires [A =
+     A'] as opposed to [A' <= A]. *)
+  type t = Irrelevant | Covariant | Invariant
+
+  let check_subtype x y = match x, y with
+  | (Irrelevant | Covariant | Invariant), Irrelevant -> true
+  | Irrelevant, Covariant -> false
+  | (Covariant | Invariant), Covariant -> true
+  | (Irrelevant | Covariant), Invariant -> false
+  | Invariant, Invariant -> true
+
+  let leq_constraint csts variance u u' =
+    match variance with
+    | Irrelevant -> csts
+    | Covariant -> Constraint.add (u, Le, u') csts
+    | Invariant -> Constraint.add (u, Eq, u') csts
+
+  let eq_constraint csts variance u u' =
+    match variance with
+    | Irrelevant -> csts
+    | Covariant | Invariant -> Constraint.add (u, Eq, u') csts
+
+  let leq_constraints variance u u' csts =
+    let len = Array.length u in
+    assert (len = Array.length u' && len = Array.length variance);
+    Array.fold_left3 leq_constraint csts variance u u'
+
+  let eq_constraints variance u u' csts =
+    let len = Array.length u in
+    assert (len = Array.length u' && len = Array.length variance);
+    Array.fold_left3 eq_constraint csts variance u u'
+end
+
 module CumulativityInfo =
 struct
-  type t = universe_context * universe_context
+  type t = universe_context * Variance.t array
 
   let univ_context (univcst, subtypcst) = univcst
-  let subtyp_context (univcst, subtypcst) = subtypcst
+  let variance (univs, variance) = variance
 
 end
 
@@ -1296,7 +1106,7 @@ let subst_univs_expr_opt fn (l,n) =
 
 let subst_univs_universe fn ul =
   let subst, nosubst = 
-    Universe.Huniv.fold (fun u (subst,nosubst) -> 
+    List.fold_right (fun u (subst,nosubst) -> 
       try let a' = subst_univs_expr_opt fn u in
 	    (a' :: subst, nosubst)
       with Not_found -> (subst, u :: nosubst))
@@ -1307,7 +1117,7 @@ let subst_univs_universe fn ul =
       let substs = 
 	List.fold_left Universe.merge_univs Universe.empty subst
       in
-	List.fold_left (fun acc u -> Universe.merge_univs acc (Universe.Huniv.tip u))
+	List.fold_left (fun acc u -> Universe.merge_univs acc (Universe.tip u))
 	  substs nosubst
 
 let merge_context strict ctx g =
diff --git a/checker/univ.mli b/checker/univ.mli
index 0a21019b1..32e48f593 100644
--- a/checker/univ.mli
+++ b/checker/univ.mli
@@ -150,8 +150,6 @@ type universe_level_subst_fn = universe_level -> universe_level
 type universe_subst = universe universe_map
 type universe_level_subst = universe_level universe_map
 
-val level_subst_of : universe_subst_fn -> universe_level_subst_fn
-
 (** {6 Universe instances} *)
 
 module Instance :
@@ -164,7 +162,6 @@ sig
   val is_empty : t -> bool
 
   val equal : t -> t -> bool
-  (** Equality (note: instances are hash-consed, this is O(1)) *)
 
   val subst_fn : universe_level_subst_fn -> t -> t
   (** Substitution by a level-to-level function. *)
@@ -221,12 +218,25 @@ end
 
 type abstract_universe_context = AUContext.t
 
+module Variance :
+sig
+  (** A universe position in the instance given to a cumulative
+     inductive can be the following. Note there is no Contravariant
+     case because [forall x : A, B <= forall x : A', B'] requires [A =
+     A'] as opposed to [A' <= A]. *)
+  type t = Irrelevant | Covariant | Invariant
+  val check_subtype : t -> t -> bool
+  val leq_constraints : t array -> Instance.t constraint_function
+  val eq_constraints : t array -> Instance.t constraint_function
+end
+
+
 module ACumulativityInfo :
 sig
   type t
 
   val univ_context : t -> abstract_universe_context
-  val subtyp_context : t -> abstract_universe_context
+  val variance : t -> Variance.t array
 
 end
 
diff --git a/checker/validate.ml b/checker/validate.ml
index 820040587..2624e6d49 100644
--- a/checker/validate.ml
+++ b/checker/validate.ml
@@ -49,8 +49,6 @@ let (/) (ctx:error_context) s : error_context = s::ctx
 exception ValidObjError of string * error_context * Obj.t
 let fail ctx o s = raise (ValidObjError(s,ctx,o))
 
-type func = error_context -> Obj.t -> unit
-
 (* Check that object o is a block with tag t *)
 let val_tag t ctx o =
   if Obj.is_block o && Obj.tag o = t then ()
diff --git a/checker/validate.mli b/checker/validate.mli
new file mode 100644
index 000000000..7eed692a0
--- /dev/null
+++ b/checker/validate.mli
@@ -0,0 +1,9 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+val validate : bool -> Values.value -> 'a -> unit
diff --git a/checker/values.ml b/checker/values.ml
index c95c3f1b2..283adca03 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 c802f941f368bedd96e931cda0559d67  checker/cic.mli
+MD5 79ed7b5c069b1994bf1a8d2cec22bdce checker/cic.mli
 
 *)
 
@@ -54,6 +54,7 @@ let v_enum name n = Sum(name,n,[||])
 
 let v_pair v1 v2 = v_tuple "*" [|v1; v2|]
 let v_bool = v_enum "bool" 2
+let v_unit = v_enum "unit" 1
 let v_ref v = v_tuple "ref" [|v|]
 
 let v_set v =
@@ -69,6 +70,8 @@ let v_map vk vd =
 let v_hset v = v_map Int (v_set v)
 let v_hmap vk vd = v_map Int (v_map vk vd)
 
+let v_pred v = v_pair v_bool (v_set v)
+
 (* lib/future *)
 let v_computation f =
   Annot ("Future.computation",
@@ -98,7 +101,7 @@ let v_raw_level = v_sum "raw_level" 2 (* Prop, Set *)
   [|(*Level*)[|Int;v_dp|]; (*Var*)[|Int|]|]
 let v_level = v_tuple "level" [|Int;v_raw_level|] 
 let v_expr = v_tuple "levelexpr" [|v_level;Int|]
-let rec v_univ = Sum ("universe", 1, [| [|v_expr; Int; v_univ|] |])
+let v_univ = List v_expr
 
 let v_cstrs =
   Annot
@@ -107,10 +110,12 @@ let v_cstrs =
        (v_tuple "univ_constraint"
           [|v_level;v_enum "order_request" 3;v_level|]))
 
+let v_variance = v_enum "variance" 3
+
 let v_instance = Annot ("instance", Array v_level)
 let v_context = v_tuple "universe_context" [|v_instance;v_cstrs|]
 let v_abs_context = v_context (* only for clarity *)
-let v_abs_cum_info = v_tuple "cumulativity_info" [|v_abs_context; v_context|]
+let v_abs_cum_info = v_tuple "cumulativity_info" [|v_abs_context; Array v_variance|]
 let v_context_set = v_tuple "universe_context_set" [|v_hset v_level;v_cstrs|]
 
 (** kernel/term *)
@@ -198,6 +203,17 @@ let v_lazy_constr =
 let v_impredicative_set = v_enum "impr-set" 2
 let v_engagement = v_impredicative_set
 
+let v_conv_level =
+  v_sum "conv_level" 2 [|[|Int|]|]
+
+let v_oracle =
+  v_tuple "oracle" [|
+    v_map v_id v_conv_level;
+    v_hmap v_cst v_conv_level;
+    v_pred v_id;
+    v_pred v_cst;
+  |]
+
 let v_pol_arity =
   v_tuple "polymorphic_arity" [|List(Opt v_level);v_univ|]
 
@@ -212,9 +228,9 @@ let v_projbody =
 	    v_constr|]
 
 let v_typing_flags =
-  v_tuple "typing_flags" [|v_bool; v_bool|]
+  v_tuple "typing_flags" [|v_bool; v_bool; v_oracle|]
 
-let v_const_univs = v_sum "constant_universes" 0 [|[|v_context|]; [|v_abs_context|]|]
+let v_const_univs = v_sum "constant_universes" 0 [|[|v_context_set|]; [|v_abs_context|]|]
 
 let v_cb = v_tuple "constant_body"
   [|v_section_ctxt;
@@ -264,7 +280,7 @@ let v_mind_record = Annot ("mind_record",
 
 let v_ind_pack_univs = 
   v_sum "abstract_inductive_universes" 0
-    [|[|v_context|]; [|v_abs_context|]; [|v_abs_cum_info|]|]
+    [|[|v_context_set|]; [|v_abs_context|]; [|v_abs_cum_info|]|]
 
 let v_ind_pack = v_tuple "mutual_inductive_body"
   [|Array v_one_ind;
@@ -279,16 +295,11 @@ let v_ind_pack = v_tuple "mutual_inductive_body"
     Opt v_bool;
     v_typing_flags|]
 
-let v_with =
-  Sum ("with_declaration_body",0,
-       [|[|List v_id;v_mp|];
-         [|List v_id;v_tuple "with_def" [|v_constr;v_context|]|]|])
-
 let rec v_mae =
   Sum ("module_alg_expr",0,
   [|[|v_mp|];         (* SEBident *)
     [|v_mae;v_mp|];   (* SEBapply *)
-    [|v_mae;v_with|]  (* SEBwith *)
+    [|v_mae; Any|]  (* SEBwith *)
   |])
 
 let rec v_sfb =
@@ -311,13 +322,13 @@ and v_impl =
   Sum ("module_impl",2, (* Abstract, FullStruct *)
   [|[|v_mexpr|];  (* Algebraic *)
     [|v_sign|]|])  (* Struct *)
-and v_noimpl = v_enum "no_impl" 1 (* Abstract is mandatory for mtb *)
+and v_noimpl = v_unit
 and v_module =
   Tuple ("module_body",
          [|v_mp;v_impl;v_sign;Opt v_mexpr;v_context_set;v_resolver;Any|])
 and v_modtype =
   Tuple ("module_type_body",
-         [|v_mp;v_noimpl;v_sign;Opt v_mexpr;v_context_set;v_resolver;Any|])
+         [|v_mp;v_noimpl;v_sign;Opt v_mexpr;v_context_set;v_resolver;v_unit|])
 
 (** kernel/safe_typing *)
 
@@ -371,22 +382,3 @@ let v_lib =
 let v_opaques = Array (v_computation v_constr)
 let v_univopaques =
   Opt (Tuple ("univopaques",[|Array (v_computation v_context_set);v_context_set;v_bool|]))
-
-(** Registering dynamic values *)
-
-module IntOrd =
-struct
-  type t = int
-  let compare (x : t) (y : t) = compare x y
-end
-
-module IntMap = Map.Make(IntOrd)
-
-let dyn_table : value IntMap.t ref = ref IntMap.empty
-
-let register_dyn name t =
-  dyn_table := IntMap.add name t !dyn_table
-
-let find_dyn name =
-  try IntMap.find name !dyn_table
-  with Not_found -> Any
diff --git a/checker/values.mli b/checker/values.mli
new file mode 100644
index 000000000..aad8fd5f4
--- /dev/null
+++ b/checker/values.mli
@@ -0,0 +1,26 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+type value =
+  | Any
+  | Fail of string
+  | Tuple of string * value array
+  | Sum of string * int * value array array
+  | Array of value
+  | List of value
+  | Opt of value
+  | Int
+  | String
+  | Annot of string * value
+  | Dyn
+
+val v_univopaques : value
+val v_libsum : value
+val v_lib : value
+val v_opaques : value
+val v_stm_seg : value
diff --git a/checker/votour.ml b/checker/votour.ml
index 0998bb94b..8cb97a2b1 100644
--- a/checker/votour.ml
+++ b/checker/votour.ml
@@ -10,6 +10,8 @@ open Values
 
 (** {6 Interactive visit of a vo} *)
 
+let max_string_length = 1024
+
 let rec read_num max =
   let quit () =
     Printf.printf "\nGoodbye!\n%!";
@@ -75,48 +77,51 @@ struct
 
   type obj = data
 
-  let memory = ref [||]
-  let sizes = ref [||]
+  let memory = ref LargeArray.empty
+  let sizes = ref LargeArray.empty
   (** size, in words *)
 
   let ws = Sys.word_size / 8
 
-  let rec init_size seen = function
-  | Int _ | Atm _ | Fun _ -> 0
+  let rec init_size seen k = function
+  | Int _ | Atm _ | Fun _ -> k 0
   | Ptr p ->
-    if seen.(p) then 0
+    if LargeArray.get seen p then k 0
     else
-      let () = seen.(p) <- true in
-      match (!memory).(p) with
+      let () = LargeArray.set seen p true in
+      match LargeArray.get !memory p with
       | Struct (tag, os) ->
-        let fold accu o = accu + 1 + init_size seen o in
-        let size = Array.fold_left fold 1 os in
-        let () = (!sizes).(p) <- size in
-        size
+        let len = Array.length os in
+        let rec fold i accu k =
+          if i == len then k accu
+          else
+            init_size seen (fun n -> fold (succ i) (accu + 1 + n) k) os.(i)
+        in
+        fold 0 1 (fun size -> let () = LargeArray.set !sizes p size in k size)
       | String s ->
         let size = 2 + (String.length s / ws) in
-        let () = (!sizes).(p) <- size in
-        size
+        let () = LargeArray.set !sizes p size in
+        k size
 
   let size = function
   | Int _ | Atm _ | Fun _ -> 0
-  | Ptr p -> (!sizes).(p)
+  | Ptr p -> LargeArray.get !sizes p
 
   let repr = function
   | Int i -> INT i
   | Atm t -> BLOCK (t, [||])
   | Fun _ -> OTHER
   | Ptr p ->
-    match (!memory).(p) with
+    match LargeArray.get !memory p with
     | Struct (tag, os) -> BLOCK (tag, os)
     | String s -> STRING s
 
   let input ch =
     let obj, mem = parse_channel ch in
     let () = memory := mem in
-    let () = sizes := Array.make (Array.length mem) (-1) in
-    let seen = Array.make (Array.length mem) false in
-    let _ = init_size seen obj in
+    let () = sizes := LargeArray.make (LargeArray.length mem) (-1) in
+    let seen = LargeArray.make (LargeArray.length mem) false in
+    let () = init_size seen ignore obj in
     obj
 
   let oid = function
@@ -155,7 +160,8 @@ let get_string_in_tuple o =
     for i = 0 to Array.length o - 1 do
       match Repr.repr o.(i) with
       | STRING s ->
-        raise (TupleString (Printf.sprintf " [..%s..]" s))
+        let len = min max_string_length (String.length s) in
+        raise (TupleString (Printf.sprintf " [..%s..]" (String.sub s 0 len)))
       | _ -> ()
     done;
     ""
@@ -165,7 +171,8 @@ let get_string_in_tuple o =
 
 let rec get_details v o = match v, Repr.repr o with
   | (String | Any), STRING s ->
-    Printf.sprintf " [%s]" (String.escaped s)
+    let len = min max_string_length (String.length s) in
+    Printf.sprintf " [%s]" (String.escaped (String.sub s 0 len))
   |Tuple (_,v), BLOCK (_, o) -> get_string_in_tuple o
   |(Sum _|Any), BLOCK (tag, _) ->
     Printf.sprintf " [tag=%i]" tag
@@ -192,18 +199,17 @@ let access_children vs os pos =
   else raise Exit
 
 let access_list v o pos =
-  let rec loop o pos = match Repr.repr o with
-  | INT 0 -> []
+  let rec loop o pos accu = match Repr.repr o with
+  | INT 0 -> List.rev accu
   | BLOCK (0, [|hd; tl|]) ->
-    (v, hd, 0 :: pos) :: loop tl (1 :: pos)
+    loop tl (1 :: pos) ((v, hd, 0 :: pos) :: accu)
   | _ -> raise Exit
   in
-  Array.of_list (loop o pos)
+  Array.of_list (loop o pos [])
 
 let access_block o = match Repr.repr o with
 | BLOCK (tag, os) -> (tag, os)
 | _ -> raise Exit
-let access_int o = match Repr.repr o with INT i -> i | _ -> raise Exit
 
 (** raises Exit if the object has not the expected structure *)
 exception Forbidden
@@ -227,14 +233,22 @@ let rec get_children v o pos = match v with
     | BLOCK (0, [|x|]) -> [|(v, x, 0 :: pos)|]
     | _ -> raise Exit
     end
-  |String | Int -> [||]
+  | String ->
+    begin match Repr.repr o with
+    | STRING _ -> [||]
+    | _ -> raise Exit
+    end
+  | Int ->
+    begin match Repr.repr o with
+    | INT _ -> [||]
+    | _ -> raise Exit
+    end
   |Annot (s,v) -> get_children v o pos
   |Any -> raise Exit
   |Dyn ->
     begin match Repr.repr o with
     | BLOCK (0, [|id; o|]) ->
-      let n = access_int id in
-      let tpe = find_dyn n in
+      let tpe = Any in
       [|(Int, id, 0 :: pos); (tpe, o, 1 :: pos)|]
     | _ -> raise Exit
     end
@@ -379,7 +393,7 @@ let visit_vo f =
     | None -> ()
   done
 
-let main =
+let () =
   if not !Sys.interactive then
     Arg.parse [] visit_vo
       ("votour: guided tour of a Coq .vo or .vi file\n"^
diff --git a/checker/votour.mli b/checker/votour.mli
new file mode 100644
index 000000000..e1555ba2e
--- /dev/null
+++ b/checker/votour.mli
@@ -0,0 +1,10 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(* This empty file avoids a race condition that occurs when compiling a .ml file
+   that does not have a corresponding .mli file *)
diff --git a/lib/backtrace.ml b/clib/backtrace.ml
index be9f40c1f..be9f40c1f 100644
--- a/lib/backtrace.ml
+++ b/clib/backtrace.ml
diff --git a/lib/backtrace.mli b/clib/backtrace.mli
index dd82165b6..dd82165b6 100644
--- a/lib/backtrace.mli
+++ b/clib/backtrace.mli
diff --git a/lib/bigint.ml b/clib/bigint.ml
index 4f8b95d59..4f8b95d59 100644
--- a/lib/bigint.ml
+++ b/clib/bigint.ml
diff --git a/lib/bigint.mli b/clib/bigint.mli
index 2a5a5f122..2a5a5f122 100644
--- a/lib/bigint.mli
+++ b/clib/bigint.mli
diff --git a/lib/cArray.ml b/clib/cArray.ml
index d08f24d49..013585735 100644
--- a/lib/cArray.ml
+++ b/clib/cArray.ml
@@ -334,7 +334,7 @@ let smartmap f (ar : 'a array) =
     Array.unsafe_set ans !i v;
     incr i;
     while !i < len do
-      let v = Array.unsafe_get ar !i in
+      let v = Array.unsafe_get ans !i in
       let v' = f v in
       if v != v' then Array.unsafe_set ans !i v';
       incr i
@@ -527,7 +527,7 @@ struct
       Array.unsafe_set ans !i v;
       incr i;
       while !i < len do
-        let v = Array.unsafe_get ar !i in
+        let v = Array.unsafe_get ans !i in
         let v' = f arg v in
         if v != v' then Array.unsafe_set ans !i v';
         incr i
diff --git a/lib/cArray.mli b/clib/cArray.mli
index 325ff8edc..325ff8edc 100644
--- a/lib/cArray.mli
+++ b/clib/cArray.mli
diff --git a/lib/cEphemeron.ml b/clib/cEphemeron.ml
index 8b253a790..8b253a790 100644
--- a/lib/cEphemeron.ml
+++ b/clib/cEphemeron.ml
diff --git a/lib/cEphemeron.mli b/clib/cEphemeron.mli
index d8a1f2757..d8a1f2757 100644
--- a/lib/cEphemeron.mli
+++ b/clib/cEphemeron.mli
diff --git a/lib/cList.ml b/clib/cList.ml
index ca69628af..627a3e3e0 100644
--- a/lib/cList.ml
+++ b/clib/cList.ml
@@ -62,6 +62,7 @@ sig
   val fold_right_and_left :
       ('a -> 'b -> 'b list -> 'a) -> 'b list -> 'a -> 'a
   val fold_left3 : ('a -> 'b -> 'c -> 'd -> 'a) -> 'a -> 'b list -> 'c list -> 'd list -> 'a
+  val fold_left2_set : exn -> ('a -> 'b -> 'c -> 'b list -> 'c list -> 'a) -> 'a -> 'b list -> 'c list -> 'a
   val for_all_i : (int -> 'a -> bool) -> int -> 'a list -> bool
   val except : 'a eq -> 'a -> 'a list -> 'a list
   val remove : 'a eq -> 'a -> 'a list -> 'a list
@@ -96,6 +97,8 @@ sig
   val fold_right_map : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
   val fold_left2_map : ('a -> 'b -> 'c -> 'a * 'd) -> 'a -> 'b list -> 'c list -> 'a * 'd list
   val fold_right2_map : ('b -> 'c -> 'a -> 'd * 'a) -> 'b list -> 'c list -> 'a -> 'd list * 'a
+  val fold_left3_map : ('a -> 'b -> 'c -> 'd -> 'a * 'e) -> 'a -> 'b list -> 'c list -> 'd list -> 'a * 'e list
+  val fold_left4_map : ('a -> 'b -> 'c -> 'd -> 'e -> 'a * 'r) -> 'a -> 'b list -> 'c list -> 'd list -> 'e list -> 'a * 'r list
   val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
   val fold_map' : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
   val map_assoc : ('a -> 'b) -> ('c * 'a) list -> ('c * 'b) list
@@ -446,6 +449,12 @@ let rec fold_left3 f accu l1 l2 l3 =
   | (a1::l1, a2::l2, a3::l3) -> fold_left3 f (f accu a1 a2 a3) l1 l2 l3
   | (_, _, _) -> invalid_arg "List.fold_left3"
 
+let rec fold_left4 f accu l1 l2 l3 l4 =
+  match (l1, l2, l3, l4) with
+    ([], [], [], []) -> accu
+  | (a1::l1, a2::l2, a3::l3, a4::l4) -> fold_left4 f (f accu a1 a2 a3 a4) l1 l2 l3 l4
+  | (_,_, _, _) -> invalid_arg "List.fold_left4"
+
 (* [fold_right_and_left f [a1;...;an] hd =
    f (f (... (f (f hd
                    an
@@ -464,6 +473,19 @@ let fold_right_and_left f l hd =
     | a::l -> let hd = aux (a::tl) l in f hd a tl
    in aux [] l
 
+(* Match sets as lists according to a matching function, also folding a side effect *)
+let rec fold_left2_set e f x l1 l2 =
+  match l1 with
+  | a1::l1 ->
+     let rec find seen = function
+       | [] -> raise e
+       | a2::l2 ->
+          try fold_left2_set e f (f x a1 a2 l1 l2) l1 (List.rev_append seen l2)
+          with e' when e' = e -> find (a2::seen) l2 in
+     find [] l2
+  | [] ->
+     if l2 = [] then x else raise e
+
 let iteri f l = fold_left_i (fun i _ x -> f i x) 0 () l
 
 let for_all_i p =
@@ -765,12 +787,13 @@ let share_tails l1 l2 =
   in
   shr_rev [] (List.rev l1, List.rev l2)
 
+(* Poor man's monadic map *)
 let rec fold_left_map f e = function
-  |  []  -> (e,[])
-  |  h::t ->
-       let e',h' = f e h in
-       let e'',t' = fold_left_map f e' t in
-         e'',h'::t'
+  | []  -> (e,[])
+  | h::t ->
+    let e',h' = f e h in
+    let e'',t' = fold_left_map f e' t in
+    e'',h'::t'
 
 let fold_map = fold_left_map
 
@@ -790,12 +813,26 @@ let fold_right_map f l e =
 
 let fold_map' = fold_right_map
 
+let on_snd f (x,y) = (x,f y)
+
 let fold_left2_map f e l l' =
-  List.fold_left2 (fun (e,l) x x' -> let (e,y) = f e x x' in (e,y::l)) (e,[]) l l'
+  on_snd List.rev @@
+  List.fold_left2 (fun (e,l) x x' ->
+      let (e,y) = f e x x' in
+      (e, y::l)
+    ) (e, []) l l'
 
 let fold_right2_map f l l' e =
   List.fold_right2 (fun x x' (l,e) -> let (y,e) = f x x' e in (y::l,e)) l l' ([],e)
 
+let fold_left3_map f e l l' l'' =
+  on_snd List.rev @@
+  fold_left3 (fun (e,l) x x' x'' -> let (e,y) = f e x x' x'' in (e,y::l)) (e,[]) l l' l''
+
+let fold_left4_map f e l1 l2 l3 l4 =
+  on_snd List.rev @@
+  fold_left4 (fun (e,l) x1 x2 x3 x4 -> let (e,y) = f e x1 x2 x3 x4 in (e,y::l)) (e,[]) l1 l2 l3 l4
+
 let map_assoc f = List.map (fun (x,a) -> (x,f a))
 
 let rec assoc_f f a = function
diff --git a/lib/cList.mli b/clib/cList.mli
index 8cb07da79..b3ee28548 100644
--- a/lib/cList.mli
+++ b/clib/cList.mli
@@ -121,6 +121,14 @@ sig
   val fold_right_and_left :
       ('a -> 'b -> 'b list -> 'a) -> 'b list -> 'a -> 'a
   val fold_left3 : ('a -> 'b -> 'c -> 'd -> 'a) -> 'a -> 'b list -> 'c list -> 'd list -> 'a
+
+  (** Fold sets, i.e. lists up to order; the folding function tells
+      when elements match by returning a value and raising the given
+      exception otherwise; sets should have the same size; raise the
+      given exception if no pairing of the two sets is found;;
+      complexity in O(n^2) *)
+  val fold_left2_set : exn -> ('a -> 'b -> 'c -> 'b list -> 'c list -> 'a) -> 'a -> 'b list -> 'c list -> 'a
+
   val for_all_i : (int -> 'a -> bool) -> int -> 'a list -> bool
   val except : 'a eq -> 'a -> 'a list -> 'a list
   val remove : 'a eq -> 'a -> 'a list -> 'a list
@@ -211,7 +219,14 @@ sig
   val fold_right2_map : ('b -> 'c -> 'a -> 'd * 'a) -> 'b list -> 'c list -> 'a -> 'd list * 'a
   (** Same with two lists, folding on the right *)
 
+  val fold_left3_map : ('a -> 'b -> 'c -> 'd -> 'a * 'e) -> 'a -> 'b list -> 'c list -> 'd list -> 'a * 'e list
+  (** Same with three lists, folding on the left *)
+
+  val fold_left4_map : ('a -> 'b -> 'c -> 'd -> 'e -> 'a * 'r) -> 'a -> 'b list -> 'c list -> 'd list -> 'e list -> 'a * 'r list
+  (** Same with four lists, folding on the left *)
+
   val fold_map : ('a -> 'b -> 'a * 'c) -> 'a -> 'b list -> 'a * 'c list
+  (* [@@ocaml.deprecated "Same as [fold_left_map]"] *)
   (** @deprecated Same as [fold_left_map] *)
 
   val fold_map' : ('b -> 'a -> 'c * 'a) -> 'b list -> 'a -> 'c list * 'a
diff --git a/lib/cMap.ml b/clib/cMap.ml
index 0ecb40209..b4c4aedd0 100644
--- a/lib/cMap.ml
+++ b/clib/cMap.ml
@@ -26,7 +26,7 @@ sig
   include CSig.MapS
   module Set : CSig.SetS with type elt = key
   val get : key -> 'a t -> 'a
-  val update : key -> 'a -> 'a t -> 'a t
+  val set : key -> 'a -> 'a t -> 'a t
   val modify : key -> (key -> 'a -> 'a) -> 'a t -> 'a t
   val domain : 'a t -> Set.t
   val bind : (key -> 'a) -> Set.t -> 'a t
@@ -50,7 +50,7 @@ end
 module MapExt (M : Map.OrderedType) :
 sig
   type 'a map = 'a Map.Make(M).t
-  val update : M.t -> 'a -> 'a map -> 'a map
+  val set : M.t -> 'a -> 'a map -> 'a map
   val modify : M.t -> (M.t -> 'a -> 'a) -> 'a map -> 'a map
   val domain : 'a map -> Set.Make(M).t
   val bind : (M.t -> 'a) -> Set.Make(M).t -> 'a map
@@ -93,19 +93,19 @@ struct
   let set_prj : set -> _set = Obj.magic
   let set_inj : _set -> set = Obj.magic
 
-  let rec update k v (s : 'a map) : 'a map = match map_prj s with
+  let rec set k v (s : 'a map) : 'a map = match map_prj s with
   | MEmpty -> raise Not_found
   | MNode (l, k', v', r, h) ->
     let c = M.compare k k' in
     if c < 0 then
-      let l' = update k v l in
+      let l' = set k v l in
       if l == l' then s
       else map_inj (MNode (l', k', v', r, h))
     else if c = 0 then
       if v' == v then s
       else map_inj (MNode (l, k', v, r, h))
     else
-      let r' = update k v r in
+      let r' = set k v r in
       if r == r' then s
       else map_inj (MNode (l, k', v', r', h))
 
diff --git a/lib/cMap.mli b/clib/cMap.mli
index f65036139..5e65bd200 100644
--- a/lib/cMap.mli
+++ b/clib/cMap.mli
@@ -34,7 +34,7 @@ sig
   val get : key -> 'a t -> 'a
   (** Same as {!find} but fails an assertion instead of raising [Not_found] *)
 
-  val update : key -> 'a -> 'a t -> 'a t
+  val set : key -> 'a -> 'a t -> 'a t
   (** Same as [add], but expects the key to be present, and thus faster.
       @raise Not_found when the key is unbound in the map. *)
 
diff --git a/lib/cObj.ml b/clib/cObj.ml
index 7f3ee1855..7f3ee1855 100644
--- a/lib/cObj.ml
+++ b/clib/cObj.ml
diff --git a/lib/cObj.mli b/clib/cObj.mli
index 16933a4aa..16933a4aa 100644
--- a/lib/cObj.mli
+++ b/clib/cObj.mli
diff --git a/lib/cSet.ml b/clib/cSet.ml
index ed65edf16..ed65edf16 100644
--- a/lib/cSet.ml
+++ b/clib/cSet.ml
diff --git a/lib/cSet.mli b/clib/cSet.mli
index 2eb9bce86..2eb9bce86 100644
--- a/lib/cSet.mli
+++ b/clib/cSet.mli
diff --git a/lib/cSig.mli b/clib/cSig.mli
index 151cfbdca..32e9d2af0 100644
--- a/lib/cSig.mli
+++ b/clib/cSig.mli
@@ -48,8 +48,6 @@ end
 (** Redeclaration of OCaml set signature, to preserve compatibility. See OCaml
     documentation for more information. *)
 
-module type EmptyS = sig end
-
 module type MapS =
 sig
     type key
@@ -58,6 +56,12 @@ sig
     val is_empty: 'a t -> bool
     val mem: key -> 'a t -> bool
     val add: key -> 'a -> 'a t -> 'a t
+    (* when Coq requires OCaml 4.06 or later, can add:
+
+         val update : key -> ('a option -> 'a option) -> 'a t -> 'a t
+
+       allowing Coq to use OCaml's "update"
+    *)
     val singleton: key -> 'a -> 'a t
     val remove: key -> 'a t -> 'a t
     val merge:
diff --git a/lib/cStack.ml b/clib/cStack.ml
index 4acb2930c..4acb2930c 100644
--- a/lib/cStack.ml
+++ b/clib/cStack.ml
diff --git a/lib/cStack.mli b/clib/cStack.mli
index 8dde1d1a1..8dde1d1a1 100644
--- a/lib/cStack.mli
+++ b/clib/cStack.mli
diff --git a/lib/cString.ml b/clib/cString.ml
index f2242460e..f2242460e 100644
--- a/lib/cString.ml
+++ b/clib/cString.ml
diff --git a/lib/cString.mli b/clib/cString.mli
index 29d3a4499..29d3a4499 100644
--- a/lib/cString.mli
+++ b/clib/cString.mli
diff --git a/lib/cThread.ml b/clib/cThread.ml
index 0221e690e..0221e690e 100644
--- a/lib/cThread.ml
+++ b/clib/cThread.ml
diff --git a/lib/cThread.mli b/clib/cThread.mli
index 66f039bb5..66f039bb5 100644
--- a/lib/cThread.mli
+++ b/clib/cThread.mli
diff --git a/lib/cUnix.ml b/clib/cUnix.ml
index 867f86a74..34fb660db 100644
--- a/lib/cUnix.ml
+++ b/clib/cUnix.ml
@@ -14,6 +14,11 @@ type load_path = physical_path list
 let physical_path_of_string s = s
 let string_of_physical_path p = p
 
+let escaped_string_of_physical_path p =
+  (* We assume a reasonable-enough path (typically utf8) and prevents
+     the presence of space; other escapings might be useful... *)
+  if String.contains p ' ' then "\"" ^ p ^ "\"" else p
+
 let path_to_list p =
   let sep = Str.regexp (if Sys.os_type = "Win32" then ";" else ":") in
     Str.split sep p
diff --git a/lib/cUnix.mli b/clib/cUnix.mli
index a39481404..d08dc4c40 100644
--- a/lib/cUnix.mli
+++ b/clib/cUnix.mli
@@ -14,9 +14,12 @@ type load_path = physical_path list
 val physical_path_of_string : string -> physical_path
 val string_of_physical_path : physical_path -> string
 
+(** Escape what has to be escaped (e.g. surround with quotes if with spaces) *)
+val escaped_string_of_physical_path : physical_path -> string
+
 val canonical_path_name : string -> string
 
-(** remove all initial "./" in a path *)
+(** Remove all initial "./" in a path *)
 val remove_path_dot : string -> string
 
 (** If a path [p] starts with the current directory $PWD then
@@ -61,6 +64,6 @@ val sys_command : string -> string list -> Unix.process_status
 
 val waitpid_non_intr : int -> Unix.process_status
 
-(** checks if two file names refer to the same (existing) file *)
+(** Check if two file names refer to the same (existing) file *)
 val same_file : string -> string -> bool
 
diff --git a/lib/canary.ml b/clib/canary.ml
index 0ed1d28f3..0ed1d28f3 100644
--- a/lib/canary.ml
+++ b/clib/canary.ml
diff --git a/lib/canary.mli b/clib/canary.mli
index 904b88213..904b88213 100644
--- a/lib/canary.mli
+++ b/clib/canary.mli
diff --git a/lib/clib.mllib b/clib/clib.mllib
index d5c938fe5..0b5d9826f 100644
--- a/lib/clib.mllib
+++ b/clib/clib.mllib
@@ -1,36 +1,39 @@
-Coq_config
-
-Terminal
 Canary
-Hook
+CObj
+CEphemeron
+
 Hashset
 Hashcons
+
 CSet
 CMap
+CList
+CString
+CStack
+
 Int
-Dyn
+Range
 HMap
+Bigint
+
+CArray
 Option
+CUnix
+
+Segmenttree
+Unicodetable
+Unicode
+Minisys
+CThread
+Trie
+Predicate
+Heap
+Unionfind
+
+Dyn
 Store
 Exninfo
 Backtrace
 IStream
-Flags
-Control
-Loc
-CAst
-CList
-CString
-Deque
-CObj
-CArray
-CStack
-Util
-Stateid
-Pp
-Feedback
-CUnix
-Envars
-Aux_file
+Terminal
 Monad
-CoqProject_file
diff --git a/lib/deque.ml b/clib/deque.ml
index 373269b4f..373269b4f 100644
--- a/lib/deque.ml
+++ b/clib/deque.ml
diff --git a/lib/deque.mli b/clib/deque.mli
index 23cb1e491..23cb1e491 100644
--- a/lib/deque.mli
+++ b/clib/deque.mli
diff --git a/lib/dyn.ml b/clib/dyn.ml
index 6bd43455f..64535d35f 100644
--- a/lib/dyn.ml
+++ b/clib/dyn.ml
@@ -11,6 +11,26 @@ sig
   type 'a t
 end
 
+module type MapS =
+sig
+  type t
+  type 'a obj
+  type 'a key
+  val empty : t
+  val add : 'a key -> 'a obj -> t -> t
+  val remove : 'a key -> t -> t
+  val find : 'a key -> t -> 'a obj
+  val mem : 'a key -> t -> bool
+
+  type any = Any : 'a key * 'a obj -> any
+
+  type map = { map : 'a. 'a key -> 'a obj -> 'a obj }
+  val map : map -> t -> t
+
+  val iter : (any -> unit) -> t -> unit
+  val fold : (any -> 'r -> 'r) -> t -> 'r -> 'r
+end
+
 module type PreS =
 sig
 type 'a tag
@@ -24,24 +44,7 @@ type any = Any : 'a tag -> any
 
 val name : string -> any option
 
-module Map(M : TParam) :
-sig
-  type t
-  val empty : t
-  val add : 'a tag -> 'a M.t -> t -> t
-  val remove : 'a tag -> t -> t
-  val find : 'a tag -> t -> 'a M.t
-  val mem : 'a tag -> t -> bool
-
-  type any = Any : 'a tag * 'a M.t -> any
-
-  type map = { map : 'a. 'a tag -> 'a M.t -> 'a M.t }
-  val map : map -> t -> t
-
-  val iter : (any -> unit) -> t -> unit
-  val fold : (any -> 'r -> 'r) -> t -> 'r -> 'r
-
-end
+module Map(M : TParam) : MapS with type 'a obj = 'a M.t with type 'a key = 'a tag
 
 val dump : unit -> (int * string) list
 
@@ -52,6 +55,8 @@ sig
   include PreS
 
   module Easy : sig
+
+    val make_dyn_tag : string -> ('a -> t) * (t -> 'a) * 'a tag
     val make_dyn : string -> ('a -> t) * (t -> 'a)
     val inj : 'a -> 'a tag -> t
     val prj : t -> 'a tag -> 'a option
@@ -59,7 +64,7 @@ sig
 
 end
 
-module Make(M : CSig.EmptyS) = struct
+module Make () = struct
 module Self : PreS = struct
 (* Dynamics, programmed with DANGER !!! *)
 
@@ -104,6 +109,8 @@ let dump () = Int.Map.bindings !dyntab
 module Map(M : TParam) =
 struct
 type t = Obj.t M.t Int.Map.t
+type 'a obj = 'a M.t
+type 'a key = 'a tag
 let cast : 'a M.t -> 'b M.t = Obj.magic
 let empty = Int.Map.empty
 let add tag v m = Int.Map.add tag (cast v) m
@@ -124,8 +131,9 @@ end
 include Self
 
 module Easy = struct
+
 (* now tags are opaque, we can do the trick *)
-let make_dyn (s : string) =
+let make_dyn_tag (s : string) =
  (fun (type a) (tag : a tag) ->
   let infun : (a -> t) = fun x -> Dyn (tag, x) in
   let outfun : (t -> a) = fun (Dyn (t, x)) ->
@@ -133,9 +141,12 @@ let make_dyn (s : string) =
     | None -> assert false
     | Some CSig.Refl -> x
   in
-  (infun, outfun))
+  infun, outfun, tag)
  (create s)
 
+let make_dyn (s : string) =
+  let inf, outf, _ = make_dyn_tag s in inf, outf
+
 let inj x tag = Dyn(tag,x)
 let prj : type a. t -> a tag -> a option =
     fun (Dyn(tag',x)) tag ->
diff --git a/lib/dyn.mli b/clib/dyn.mli
index e43c8a9bc..2206394e2 100644
--- a/lib/dyn.mli
+++ b/clib/dyn.mli
@@ -13,6 +13,26 @@ sig
   type 'a t
 end
 
+module type MapS =
+sig
+  type t
+  type 'a obj
+  type 'a key
+  val empty : t
+  val add : 'a key -> 'a obj -> t -> t
+  val remove : 'a key -> t -> t
+  val find : 'a key -> t -> 'a obj
+  val mem : 'a key -> t -> bool
+
+  type any = Any : 'a key * 'a obj -> any
+
+  type map = { map : 'a. 'a key -> 'a obj -> 'a obj }
+  val map : map -> t -> t
+
+  val iter : (any -> unit) -> t -> unit
+  val fold : (any -> 'r -> 'r) -> t -> 'r -> 'r
+end
+
 module type S =
 sig
 type 'a tag
@@ -26,30 +46,14 @@ type any = Any : 'a tag -> any
 
 val name : string -> any option
 
-module Map(M : TParam) :
-sig
-  type t
-  val empty : t
-  val add : 'a tag -> 'a M.t -> t -> t
-  val remove : 'a tag -> t -> t
-  val find : 'a tag -> t -> 'a M.t
-  val mem : 'a tag -> t -> bool
-
-  type any = Any : 'a tag * 'a M.t -> any
-
-  type map = { map : 'a. 'a tag -> 'a M.t -> 'a M.t }
-  val map : map -> t -> t
-
-  val iter : (any -> unit) -> t -> unit
-  val fold : (any -> 'r -> 'r) -> t -> 'r -> 'r
-
-end
+module Map(M : TParam) : MapS with type 'a obj = 'a M.t with type 'a key = 'a tag
 
 val dump : unit -> (int * string) list
 
 module Easy : sig
 
   (* To create a dynamic type on the fly *)
+  val make_dyn_tag : string -> ('a -> t) * (t -> 'a) * 'a tag
   val make_dyn : string -> ('a -> t) * (t -> 'a)
 
   (* For types declared with the [create] function above *)
@@ -59,5 +63,4 @@ end
 
 end
 
-(** FIXME: use OCaml 4.02 generative functors when available *)
-module Make(M : CSig.EmptyS) : S
+module Make () : S
diff --git a/lib/exninfo.ml b/clib/exninfo.ml
index d049dc6cf..167d3d6dc 100644
--- a/lib/exninfo.ml
+++ b/clib/exninfo.ml
@@ -10,7 +10,7 @@
     containing a pair composed of the distinguishing [token] and the backtrace
     information. We discriminate the token by pointer equality. *)
 
-module Store = Store.Make(struct end)
+module Store = Store.Make ()
 
 type 'a t = 'a Store.field
 
diff --git a/lib/exninfo.mli b/clib/exninfo.mli
index c960ac7c0..c960ac7c0 100644
--- a/lib/exninfo.mli
+++ b/clib/exninfo.mli
diff --git a/lib/hMap.ml b/clib/hMap.ml
index c69efdb71..37079af78 100644
--- a/lib/hMap.ml
+++ b/clib/hMap.ml
@@ -47,7 +47,7 @@ struct
     try
       let m = Int.Map.find h s in
       let m = Set.add x m in
-      Int.Map.update h m s
+      Int.Map.set h m s
     with Not_found ->
       let m = Set.singleton x in
       Int.Map.add h m s
@@ -65,7 +65,7 @@ struct
       if Set.is_empty m then
         Int.Map.remove h s
       else
-        Int.Map.update h m s
+        Int.Map.set h m s
     with Not_found -> s
 
   let height s = Int.Map.height s
@@ -135,7 +135,7 @@ struct
         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
+        else Int.Map.set h si accu
      with Not_found -> accu
     in
     Int.Map.fold fold s2 s1
@@ -242,11 +242,19 @@ struct
     try
       let m = Int.Map.find h s in
       let m = Map.add k x m in
-      Int.Map.update h m s
+      Int.Map.set h m s
     with Not_found ->
       let m = Map.singleton k x in
       Int.Map.add h m s
 
+  (* when Coq requires OCaml 4.06 or later, the module type
+     CSig.MapS may include the signature of OCaml's "update",
+     requiring an implementation here, which could be just:
+
+       let update k f s = assert false (* not implemented *)
+
+  *)
+
   let singleton k x =
     let h = M.hash k in
     Int.Map.singleton h (Map.singleton k x)
@@ -259,7 +267,7 @@ struct
       if Map.is_empty m then
         Int.Map.remove h s
       else
-        Int.Map.update h m s
+        Int.Map.set h m s
     with Not_found -> s
 
   let merge f s1 s2 =
@@ -359,7 +367,7 @@ struct
     let h = M.hash k in
     let m = Int.Map.find h s in
     let m = Map.modify k f m in
-    Int.Map.update h m s
+    Int.Map.set h m s
 
   let bind f s =
     let fb m = Map.bind f m in
@@ -367,11 +375,11 @@ struct
 
   let domain s = Int.Map.map Map.domain s
 
-  let update k x s =
+  let set k x s =
     let h = M.hash k in
     let m = Int.Map.find h s in
-    let m = Map.update k x m in
-    Int.Map.update h m s
+    let m = Map.set k x m in
+    Int.Map.set h m s
 
   let smartmap f s =
     let fs m = Map.smartmap f m in
diff --git a/lib/hMap.mli b/clib/hMap.mli
index c77bfced8..c77bfced8 100644
--- a/lib/hMap.mli
+++ b/clib/hMap.mli
diff --git a/lib/hashcons.ml b/clib/hashcons.ml
index ee2232581..ee2232581 100644
--- a/lib/hashcons.ml
+++ b/clib/hashcons.ml
diff --git a/lib/hashcons.mli b/clib/hashcons.mli
index fbd2ebcf9..fbd2ebcf9 100644
--- a/lib/hashcons.mli
+++ b/clib/hashcons.mli
diff --git a/lib/hashset.ml b/clib/hashset.ml
index 7f96627a6..7f96627a6 100644
--- a/lib/hashset.ml
+++ b/clib/hashset.ml
diff --git a/lib/hashset.mli b/clib/hashset.mli
index ec79205a5..ec79205a5 100644
--- a/lib/hashset.mli
+++ b/clib/hashset.mli
diff --git a/lib/heap.ml b/clib/heap.ml
index a6109972d..a6109972d 100644
--- a/lib/heap.ml
+++ b/clib/heap.ml
diff --git a/lib/heap.mli b/clib/heap.mli
index 93d504c5a..93d504c5a 100644
--- a/lib/heap.mli
+++ b/clib/heap.mli
diff --git a/lib/iStream.ml b/clib/iStream.ml
index d3a54332a..d3a54332a 100644
--- a/lib/iStream.ml
+++ b/clib/iStream.ml
diff --git a/lib/iStream.mli b/clib/iStream.mli
index cd7940e8d..cd7940e8d 100644
--- a/lib/iStream.mli
+++ b/clib/iStream.mli
diff --git a/lib/int.ml b/clib/int.ml
index 63f62154d..63f62154d 100644
--- a/lib/int.ml
+++ b/clib/int.ml
diff --git a/lib/int.mli b/clib/int.mli
index b65367f7d..b65367f7d 100644
--- a/lib/int.mli
+++ b/clib/int.mli
diff --git a/lib/minisys.ml b/clib/minisys.ml
index 706f0430c..389b18ad4 100644
--- a/lib/minisys.ml
+++ b/clib/minisys.ml
@@ -36,10 +36,15 @@ let skipped_dirnames = ref ["CVS"; "_darcs"]
 
 let exclude_directory f = skipped_dirnames := f :: !skipped_dirnames
 
+(* Note: this test is possibly used for Coq module/file names but also for
+   OCaml filenames, whose syntax as of today is more restrictive for
+   module names (only initial letter then letter, digits, _ or quote),
+   but more permissive (though disadvised) for file names  *)
+
 let ok_dirname f =
   not (f = "") && f.[0] != '.' &&
-  not (List.mem f !skipped_dirnames) (*&&
-  (match Unicode.ident_refutation f with None -> true | _ -> false)*)
+  not (List.mem f !skipped_dirnames) &&
+  match Unicode.ident_refutation f with None -> true | _ -> false
 
 (* Check directory can be opened *)
 
@@ -55,10 +60,11 @@ let exists_dir dir =
 let apply_subdir f path name =
   (* we avoid all files and subdirs starting by '.' (e.g. .svn) *)
   (* as well as skipped files like CVS, ... *)
-  if ok_dirname name then
+  let base = try Filename.chop_extension name with Invalid_argument _ -> name in
+  if ok_dirname base then
     let path = if path = "." then name else path//name in
     match try (Unix.stat path).Unix.st_kind with Unix.Unix_error _ -> Unix.S_BLK with
-    | Unix.S_DIR -> f (FileDir (path,name))
+    | Unix.S_DIR when name = base -> f (FileDir (path,name))
     | Unix.S_REG -> f (FileRegular name)
     | _ -> ()
 
diff --git a/lib/monad.ml b/clib/monad.ml
index 2e55e9698..2e55e9698 100644
--- a/lib/monad.ml
+++ b/clib/monad.ml
diff --git a/lib/monad.mli b/clib/monad.mli
index 7b0a3e600..7b0a3e600 100644
--- a/lib/monad.mli
+++ b/clib/monad.mli
diff --git a/lib/option.ml b/clib/option.ml
index 98b168035..98b168035 100644
--- a/lib/option.ml
+++ b/clib/option.ml
diff --git a/lib/option.mli b/clib/option.mli
index 66f05023f..66f05023f 100644
--- a/lib/option.mli
+++ b/clib/option.mli
diff --git a/lib/predicate.ml b/clib/predicate.ml
index 1aa7db6af..1aa7db6af 100644
--- a/lib/predicate.ml
+++ b/clib/predicate.ml
diff --git a/lib/predicate.mli b/clib/predicate.mli
index cee3b0bd3..cee3b0bd3 100644
--- a/lib/predicate.mli
+++ b/clib/predicate.mli
diff --git a/clib/range.ml b/clib/range.ml
new file mode 100644
index 000000000..86a078633
--- /dev/null
+++ b/clib/range.ml
@@ -0,0 +1,91 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+type 'a tree =
+| Leaf of 'a
+| Node of 'a * 'a tree * 'a tree
+
+type 'a t = Nil | Cons of int * 'a tree * 'a t
+
+let oob () = invalid_arg "index out of bounds"
+
+let empty = Nil
+
+let cons x l = match l with
+| Cons (h1, t1, Cons (h2, t2, rem)) ->
+  if Int.equal h1 h2 then Cons (1 + h1 + h2, Node (x, t1, t2), rem)
+  else Cons (1, Leaf x, l)
+| _ -> Cons (1, Leaf x, l)
+
+let is_empty = function
+| Nil -> true
+| _ -> false
+
+let rec tree_get h t i = match t with
+| Leaf x ->
+  if i = 0 then x else oob ()
+| Node (x, t1, t2) ->
+  if i = 0 then x
+  else
+    let h = h / 2 in
+    if i <= h then tree_get h t1 (i - 1) else tree_get h t2 (i - h - 1)
+
+let rec get l i = match l with
+| Nil -> oob ()
+| Cons (h, t, rem) ->
+  if i < h then tree_get h t i else get rem (i - h)
+
+let length l =
+  let rec length accu = function
+  | Nil -> accu
+  | Cons (h, _, l) -> length (h + accu) l
+  in
+  length 0 l
+
+let rec tree_map f = function
+| Leaf x -> Leaf (f x)
+| Node (x, t1, t2) -> Node (f x, tree_map f t1, tree_map f t2)
+
+let rec map f = function
+| Nil -> Nil
+| Cons (h, t, l) -> Cons (h, tree_map f t, map f l)
+
+let rec tree_fold_left f accu = function
+| Leaf x -> f accu x
+| Node (x, t1, t2) ->
+  tree_fold_left f (tree_fold_left f (f accu x) t1) t2
+
+let rec fold_left f accu = function
+| Nil -> accu
+| Cons (_, t, l) -> fold_left f (tree_fold_left f accu t) l
+
+let rec tree_fold_right f t accu = match t with
+| Leaf x -> f x accu
+| Node (x, t1, t2) ->
+  f x (tree_fold_right f t1 (tree_fold_right f t2 accu))
+
+let rec fold_right f l accu = match l with
+| Nil -> accu
+| Cons (_, t, l) -> tree_fold_right f t (fold_right f l accu)
+
+let hd = function
+| Nil -> failwith "hd"
+| Cons (_, Leaf x, _) -> x
+| Cons (_, Node (x, _, _), _) -> x
+
+let tl = function
+| Nil -> failwith "tl"
+| Cons (_, Leaf _, l) -> l
+| Cons (h, Node (_, t1, t2), l) ->
+  let h = h / 2 in
+  Cons (h, t1, Cons (h, t2, l))
+
+let rec skipn n l =
+  if n = 0 then l
+  else if is_empty l then failwith "List.skipn"
+  else skipn (pred n) (tl l)
diff --git a/clib/range.mli b/clib/range.mli
new file mode 100644
index 000000000..ae7684ffa
--- /dev/null
+++ b/clib/range.mli
@@ -0,0 +1,37 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(** Skewed lists
+
+    This is a purely functional datastructure isomorphic to usual lists, except
+    that it features a O(log n) lookup while preserving the O(1) cons operation.
+
+*)
+
+(** {5 Constructors} *)
+
+type +'a t
+
+val empty : 'a t
+val cons : 'a -> 'a t -> 'a t
+
+(** {5 List operations} *)
+
+val is_empty : 'a t -> bool
+val length : 'a t -> int
+val map : ('a -> 'b) -> 'a t -> 'b t
+val fold_left : ('a -> 'b -> 'a) -> 'a -> 'b t -> 'a
+val fold_right : ('a -> 'b -> 'b) -> 'a t -> 'b -> 'b
+val hd : 'a t -> 'a
+val tl : 'a t -> 'a t
+
+val skipn : int -> 'a t -> 'a t
+
+(** {5 Indexing operations} *)
+
+val get : 'a t -> int -> 'a
diff --git a/lib/segmenttree.ml b/clib/segmenttree.ml
index 9ce348a0b..d0ded4cb5 100644
--- a/lib/segmenttree.ml
+++ b/clib/segmenttree.ml
@@ -1,3 +1,11 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
 (** This module is a very simple implementation of "segment trees".
 
     A segment tree of type ['a t] represents a mapping from a union of
diff --git a/lib/segmenttree.mli b/clib/segmenttree.mli
index 3258537b9..e274a6fdc 100644
--- a/lib/segmenttree.mli
+++ b/clib/segmenttree.mli
@@ -1,3 +1,11 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
 (** This module is a very simple implementation of "segment trees".
 
     A segment tree of type ['a t] represents a mapping from a union of
diff --git a/lib/store.ml b/clib/store.ml
index a1788f7da..97a8fea08 100644
--- a/lib/store.ml
+++ b/clib/store.ml
@@ -14,10 +14,6 @@
     stores, we might want something static to avoid troubles with
     plugins order. *)
 
-module type T =
-sig
-end
-
 module type S =
 sig
   type t
@@ -30,7 +26,7 @@ sig
   val field : unit -> 'a field
 end
 
-module Make (M : T) : S =
+module Make () : S =
 struct
 
   let next =
diff --git a/lib/store.mli b/clib/store.mli
index 8eab314ed..5cc5bb859 100644
--- a/lib/store.mli
+++ b/clib/store.mli
@@ -9,11 +9,6 @@
 (*** This module implements an "untyped store", in this particular case we
         see it as an extensible record whose fields are left unspecified. ***)
 
-module type T =
-sig
-(** FIXME: Waiting for first-class modules... *)
-end
-
 module type S =
 sig
   type t
@@ -42,5 +37,5 @@ sig
 
 end
 
-module Make (M : T) : S
+module Make () : S
 (** Create a new store type. *)
diff --git a/lib/terminal.ml b/clib/terminal.ml
index 34efddfbc..34efddfbc 100644
--- a/lib/terminal.ml
+++ b/clib/terminal.ml
diff --git a/lib/terminal.mli b/clib/terminal.mli
index b1b76e6e2..b1b76e6e2 100644
--- a/lib/terminal.mli
+++ b/clib/terminal.mli
diff --git a/lib/trie.ml b/clib/trie.ml
index 0b0ba2761..0b0ba2761 100644
--- a/lib/trie.ml
+++ b/clib/trie.ml
diff --git a/lib/trie.mli b/clib/trie.mli
index a87acc8a6..a87acc8a6 100644
--- a/lib/trie.mli
+++ b/clib/trie.mli
diff --git a/lib/unicode.ml b/clib/unicode.ml
index 959ccaf73..f193c4e0f 100644
--- a/lib/unicode.ml
+++ b/clib/unicode.ml
@@ -8,13 +8,14 @@
 
 (** Unicode utilities *)
 
-type status = Letter | IdentPart | Symbol | Unknown
+type status = Letter | IdentPart | Symbol | IdentSep | Unknown
 
 (* The following table stores classes of Unicode characters that
-   are used by the lexer. There are 3 different classes so 2 bits are
-   allocated for each character. We only use 16 bits over the 31 bits
-   to simplify the masking process. (This choice seems to be a good
-   trade-off between speed and space after some benchmarks.) *)
+   are used by the lexer. There are 5 different classes so 3 bits
+   are allocated for each character. We encode the masks of 8
+   characters per word, thus using 24 bits over the 31 available
+   bits. (This choice seems to be a good trade-off between speed
+   and space after some benchmarks.) *)
 
 (* A 256 KiB table, initially filled with zeros. *)
 let table = Array.make (1 lsl 17) 0
@@ -24,14 +25,15 @@ let table = Array.make (1 lsl 17) 0
    define the position of the pattern in the word.
    Notice that pattern "00" means "undefined". *)
 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 *)
+  | Letter    -> 1 lsl ((i land 7) * 3) (* 001 *)
+  | IdentPart -> 2 lsl ((i land 7) * 3) (* 010 *)
+  | Symbol    -> 3 lsl ((i land 7) * 3) (* 011 *)
+  | IdentSep  -> 4 lsl ((i land 7) * 3) (* 100 *)
+  | Unknown   -> 0 lsl ((i land 7) * 3) (* 000 *)
 
-(* Helper to reset 2 bits in a word. *)
+(* Helper to reset 3 bits in a word. *)
 let reset_mask i =
-  lnot (3 lsl ((i land 7) lsl 1))
+  lnot (7 lsl ((i land 7) * 3))
 
 (* Initialize the lookup table from a list of segments, assigning
    a status to every character of each segment. The order of these
@@ -50,13 +52,14 @@ let mk_lookup_table_from_unicode_tables_for status tables =
 
 (* Look up into the table and interpret the found pattern. *)
 let lookup x =
-  let v = (table.(x lsr 3) lsr ((x land 7) lsl 1)) land 3 in
+  let v = (table.(x lsr 3) lsr ((x land 7) * 3)) land 7 in
     if      v = 1 then Letter
     else if v = 2 then IdentPart
     else if v = 3 then Symbol
+    else if v = 4 then IdentSep
     else Unknown
 
-(* [classify] discriminates between 3 different kinds of
+(* [classify] discriminates between 5 different kinds of
    symbols based on the standard unicode classification (extracted from
    Camomile). *)
 let classify =
@@ -67,13 +70,13 @@ let classify =
         Unicodetable.sm;           (* Symbol, maths.                    *)
         Unicodetable.sc;           (* Symbol, currency.                 *)
         Unicodetable.so;           (* Symbol, modifier.                 *)
-        Unicodetable.pd;           (* Punctation, dash.                 *)
-        Unicodetable.pc;           (* Punctation, connector.            *)
-        Unicodetable.pe;           (* Punctation, open.                 *)
-        Unicodetable.ps;           (* Punctation, close.                *)
-        Unicodetable.pi;           (* Punctation, initial quote.        *)
-        Unicodetable.pf;           (* Punctation, final quote.          *)
-        Unicodetable.po;           (* Punctation, other.                *)
+        Unicodetable.pd;           (* Punctuation, dash.                *)
+        Unicodetable.pc;           (* Punctuation, connector.           *)
+        Unicodetable.pe;           (* Punctuation, open.                *)
+        Unicodetable.ps;           (* Punctution, close.                *)
+        Unicodetable.pi;           (* Punctuation, initial quote.       *)
+        Unicodetable.pf;           (* Punctuation, final quote.         *)
+        Unicodetable.po;           (* Punctuation, other.               *)
       ];
     mk_lookup_table_from_unicode_tables_for Letter
       [
@@ -107,14 +110,14 @@ let classify =
         [(0x02074, 0x02079)];      (* Superscript 4-9.                  *)
         single 0x0002E;            (* Dot.                              *)
       ];
-    mk_lookup_table_from_unicode_tables_for Letter
+    mk_lookup_table_from_unicode_tables_for IdentSep
       [
         single 0x005F;             (* Underscore.                       *)
         single 0x00A0;             (* Non breaking space.               *)
       ];
     mk_lookup_table_from_unicode_tables_for IdentPart
       [
-        single 0x0027;             (* Special space.                    *)
+        single 0x0027;             (* Single quote.                     *)
       ];
     (* Lookup *)
     lookup
@@ -163,24 +166,75 @@ let is_utf8 s =
   in
   try check 0 with End_of_input -> true | Invalid_argument _ -> false
 
+(* Escape string if it contains non-utf8 characters *)
+
+let escaped_non_utf8 s =
+  let mk_escape x = Printf.sprintf "%%%X" x in
+  let buff = Buffer.create (String.length s * 3) in
+  let rec process_trailing_aux i j =
+    if i = j then i else
+      match String.unsafe_get s i with
+      | '\128'..'\191' -> process_trailing_aux (i+1) j
+      | _ -> i in
+  let process_trailing i n =
+    let j = if i+n-1 >= String.length s then i+1 else process_trailing_aux (i+1) (i+n) in
+    (if j = i+n then
+      Buffer.add_string buff (String.sub s i n)
+    else
+      let v = Array.init (j-i) (fun k -> mk_escape (Char.code s.[i+k])) in
+      Buffer.add_string buff (String.concat "" (Array.to_list v)));
+    j in
+  let rec process i =
+    if i >= String.length s then Buffer.contents buff else
+      let c = String.unsafe_get s i in
+      match c with
+      | '\000'..'\127' -> Buffer.add_char buff c; process (i+1)
+      | '\128'..'\191' | '\248'..'\255' -> Buffer.add_string buff (mk_escape (Char.code c)); process (i+1)
+      | '\192'..'\223' -> process (process_trailing i 2)
+      | '\224'..'\239' -> process (process_trailing i 3)
+      | '\240'..'\247' -> process (process_trailing i 4)
+  in
+  process 0
+
+let escaped_if_non_utf8 s =
+  if is_utf8 s then s else escaped_non_utf8 s
+
 (* Check the well-formedness of an identifier *)
 
+let is_valid_ident_initial = function
+  | Letter | IdentSep -> true
+  | IdentPart | Symbol | Unknown -> false
+
 let initial_refutation j n s =
-  match classify n with
-  | Letter -> None
-  | _ ->
+  if is_valid_ident_initial (classify n) then None
+  else
       let c = String.sub s 0 j in
       Some (false,
             "Invalid character '"^c^"' at beginning of identifier \""^s^"\".")
 
+let is_valid_ident_trailing = function
+  | Letter | IdentSep | IdentPart -> true
+  | Symbol | Unknown -> false
+
 let trailing_refutation i j n s =
-  match classify n with
-  | Letter | IdentPart -> None
-  | _ ->
+  if is_valid_ident_trailing (classify n) then None
+  else
       let c = String.sub s i j in
       Some (false,
             "Invalid character '"^c^"' in identifier \""^s^"\".")
 
+let is_unknown = function
+  | Unknown -> true
+  | Letter | IdentSep | IdentPart | Symbol -> false
+
+let is_ident_part = function
+  | IdentPart -> true
+  | Letter | IdentSep | Symbol | Unknown -> false
+
+let is_ident_sep = function
+  | IdentSep -> true
+  | Letter | IdentPart | Symbol | Unknown -> false
+
 let ident_refutation s =
   if s = ".." then None else try
     let j, n = next_utf8 s 0 in
@@ -198,7 +252,7 @@ let ident_refutation s =
         |x -> x
   with
   | End_of_input -> Some (true,"The empty string is not an identifier.")
-  | Invalid_argument _ -> Some (true,s^": invalid utf8 sequence.")
+  | Invalid_argument _ -> Some (true,escaped_non_utf8 s^": invalid utf8 sequence.")
 
 let lowercase_unicode =
   let tree = Segmenttree.make Unicodetable.to_lower in
@@ -214,6 +268,26 @@ let lowercase_first_char s =
   let j, n = next_utf8 s 0 in
   utf8_of_unicode (lowercase_unicode n)
 
+let split_at_first_letter s =
+  let n, v = next_utf8 s 0 in
+  if ((* optim *) n = 1 && s.[0] != '_') || not (is_ident_sep (classify v)) then None
+  else begin
+    let n = ref n in
+    let p = ref 0 in
+    while !n < String.length s &&
+          let n', v = next_utf8 s !n in
+          p := n';
+          (* Test if not letter *)
+          ((* optim *) n' = 1 && (s.[!n] = '_' || s.[!n] = '\''))
+          || let st = classify v in
+             is_ident_sep st || is_ident_part st
+    do n := !n + !p
+    done;
+    let s1 = String.sub s 0 !n in
+    let s2 = String.sub s !n (String.length s - !n) in
+    Some (s1,s2)
+  end
+
 (** For extraction, we need to encode unicode character into ascii ones *)
 
 let is_basic_ascii s =
@@ -268,9 +342,7 @@ let utf8_length s =
       | '\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 *)
+      | '\248'..'\255' -> nc := 0 (* invalid byte *)
     end ;
     incr p ;
     while !p < len && !nc > 0 do
@@ -299,9 +371,7 @@ let utf8_sub s start_u len_u =
       |	'\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 *)
+      |	'\248'..'\255' -> nc := 0 (* invalid byte *)
     end ;
     incr p ;
     while !p < len_b && !nc > 0 do
diff --git a/lib/unicode.mli b/clib/unicode.mli
index c7d742480..32ffbb8e9 100644
--- a/lib/unicode.mli
+++ b/clib/unicode.mli
@@ -8,7 +8,7 @@
 
 (** Unicode utilities *)
 
-type status = Letter | IdentPart | Symbol | Unknown
+type status
 
 (** Classify a unicode char into 3 classes or unknown. *)
 val classify : int -> status
@@ -17,10 +17,23 @@ val classify : int -> status
     Return [Some (b,s)] otherwise, where [s] is an explanation and [b] is severity. *)
 val ident_refutation : string -> (bool * string) option
 
+(** Tells if a valid initial character for an identifier *)
+val is_valid_ident_initial : status -> bool
+
+(** Tells if a valid non-initial character for an identifier *)
+val is_valid_ident_trailing : status -> bool
+
+(** Tells if a character is unclassified *)
+val is_unknown : status -> bool
+
 (** First char of a string, converted to lowercase
     @raise Assert_failure if the input string is empty. *)
 val lowercase_first_char : string -> string
 
+(** Split a string supposed to be an ident at the first letter;
+    as an optimization, return None if the first character is a letter *)
+val split_at_first_letter : string -> (string * string) option
+
 (** Return [true] if all UTF-8 characters in the input string are just plain
     ASCII characters. Returns [false] otherwise. *)
 val is_basic_ascii : string -> bool
@@ -40,3 +53,6 @@ val utf8_length : string -> int
 
 (** Variant of {!String.sub} for UTF-8 strings. *)
 val utf8_sub : string -> int -> int -> string
+
+(** Return a "%XX"-escaped string if it contains non UTF-8 characters. *)
+val escaped_if_non_utf8 : string -> string
diff --git a/lib/unicodetable.ml b/clib/unicodetable.ml
index b607058c6..b607058c6 100644
--- a/lib/unicodetable.ml
+++ b/clib/unicodetable.ml
diff --git a/lib/unionfind.ml b/clib/unionfind.ml
index f9c92d6a8..f9c92d6a8 100644
--- a/lib/unionfind.ml
+++ b/clib/unionfind.ml
diff --git a/lib/unionfind.mli b/clib/unionfind.mli
index b242232ed..b242232ed 100644
--- a/lib/unionfind.mli
+++ b/clib/unionfind.mli
diff --git a/config/coq_config.mli b/config/coq_config.mli
index b0f39e9d2..5f9ebdc1a 100644
--- a/config/coq_config.mli
+++ b/config/coq_config.mli
@@ -28,38 +28,33 @@ val ocamllex : string
 val camlbin : string    (* base directory of OCaml binaries *)
 val camllib : string    (* for Dynlink *)
 
-val camlp4 : string     (* exact name of camlp4: either "camlp4" ou "camlp5" *)
-val camlp4o : string    (* name of the camlp4o/camlp5o executable *)
-val camlp4bin : string  (* base directory for Camlp4/5 binaries *)
-val camlp4lib : string  (* where is the library of Camlp4 *)
-val camlp4compat : string (* compatibility argument to camlp4/5 *)
+val camlp5o : string    (* name of the camlp5o executable *)
+val camlp5bin : string  (* base directory for camlp5 binaries *)
+val camlp5lib : string  (* where is the library of camlp5 *)
+val camlp5compat : string (* compatibility argument to camlp5 *)
 
 val coqideincl : string (* arguments for building coqide (e.g. lablgtk) *)
 val cflags : string     (* arguments passed to gcc *)
+val caml_flags : string     (* arguments passed to ocamlc (ie. CAMLFLAGS) *)
 
 val best : string       (* byte/opt *)
 val arch : string       (* architecture *)
 val arch_is_win32 : bool
-val osdeplibs : string  (* OS dependent link options for ocamlc *)
 val vmbyteflags : string list (* -custom/-dllib -lcoqrun *)
 
-
-(* val defined : string list  (* options for lib/ocamlpp *) *)
-
 val version : string    (* version number of Coq *)
 val caml_version : string    (* OCaml version used to compile Coq *)
+val caml_version_nums : int list    (* OCaml version used to compile Coq by components *)
 val date : string       (* release date *)
 val compile_date : string (* compile date *)
 val vo_magic_number : int
 val state_magic_number : int
 
 val core_src_dirs : string list
-val api_dirs : string list
 val plugins_dirs : string list
 val all_src_dirs : string list
 
 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 overridden by environment
@@ -71,10 +66,13 @@ val gtk_platform : [`QUARTZ | `WIN32 | `X11]
 val has_natdynlink : bool
 val natdynlinkflag : string (* special cases of natdynlink (e.g. MacOS 10.5) *)
 
+val flambda_flags : string list
+
 val wwwcoq : string
 val wwwrefman : string
 val wwwbugtracker : string
 val wwwstdlib : string
 val localwwwrefman : string
 
-val no_native_compiler : bool
+val bytecode_compiler : bool
+val native_compiler : bool
diff --git a/configure.ml b/configure.ml
index b5e456779..69db9407a 100644
--- a/configure.ml
+++ b/configure.ml
@@ -16,7 +16,7 @@ let coq_macos_version = "8.7.90" (** "[...] should be a string comprised of
 three non-negative, period-separated integers [...]" *)
 let vo_magic = 8791
 let state_magic = 58791
-let distributed_exec = ["coqtop";"coqc";"coqchk";"coqdoc";"coqmktop";"coqworkmgr";
+let distributed_exec = ["coqtop";"coqc";"coqchk";"coqdoc";"coqworkmgr";
 "coqdoc";"coq_makefile";"coq-tex";"gallina";"coqwc";"csdpcert";"coqdep"]
 
 let verbose = ref false (* for debugging this script *)
@@ -178,8 +178,22 @@ let which prog =
 let program_in_path prog =
   try let _ = which prog in true with Not_found -> false
 
+(** Choose a command among a list of candidates
+    (command name, mandatory arguments, arguments for this test).
+    Chooses the first one whose execution outputs a non-empty (first) line.
+    Dies with message [msg] if none is found. *)
+
+let select_command msg candidates =
+  let rec search = function
+    | [] -> die msg
+    | (p, x, y) :: tl ->
+      if fst (tryrun p (x @ y)) <> ""
+      then List.fold_left (Printf.sprintf "%s %s") p x
+      else search tl
+  in search candidates
+
 (** 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
+    a quoted path to camlp5o via -pp.  So we only quote camlp5o 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']
@@ -206,7 +220,7 @@ let get_date () =
   let year = 1900+now.Unix.tm_year in
   let month = months.(now.Unix.tm_mon) in
   sprintf "%s %d" month year,
-  sprintf "%s %d %d %d:%d:%d" (String.sub month 0 3) now.Unix.tm_mday year
+  sprintf "%s %d %d %d:%02d:%02d" (String.sub month 0 3) now.Unix.tm_mday year
     now.Unix.tm_hour now.Unix.tm_min now.Unix.tm_sec
 
 let short_date, full_date = get_date ()
@@ -258,18 +272,17 @@ module Prefs = struct
   let macintegration = ref true
   let browser = ref (None : string option)
   let withdoc = ref false
-  let geoproof = ref false
   let byteonly = ref false
+  let flambda_flags = ref []
   let debug = ref true
   let profile = ref false
-  let annotate = ref false
-  (* Note, disabling this should be OK, but be careful with the
-     sharing invariants.
-  *)
-  let safe_string = ref true
+  let bin_annot = ref false
+  let annot = ref false
+  let bytecodecompiler = ref true
   let nativecompiler = ref (not (os_type_win32 || os_type_cygwin))
   let coqwebsite = ref "http://coq.inria.fr/"
   let force_caml_version = ref false
+  let force_findlib_version = ref false
   let warn_error = ref false
 end
 
@@ -309,6 +322,9 @@ let args_options = Arg.align [
   "-camlp5dir",
     Arg.String (fun s -> Prefs.camlp5dir:=Some s),
     "<dir> Specifies where is the Camlp5 library and tells to use it";
+  "-flambda-opts",
+    Arg.String (fun s -> Prefs.flambda_flags := string_split ' ' s),
+    "<flags> Specifies additional flags to be passed to the flambda optimizing compiler";
   "-arch", arg_string_option Prefs.arch,
     "<arch> Specifies the architecture";
   "-natdynlink", arg_bool Prefs.natdynlink,
@@ -321,22 +337,28 @@ let args_options = Arg.align [
     "<command> Use <command> to open URL %s";
   "-with-doc", arg_bool Prefs.withdoc,
     "(yes|no) Compile the documentation or not";
-  "-with-geoproof", arg_bool Prefs.geoproof,
-    "(yes|no) Use Geoproof binding or not";
   "-byte-only", Arg.Set Prefs.byteonly,
     " Compiles only bytecode version of Coq";
   "-nodebug", Arg.Clear Prefs.debug,
     " Do not add debugging information in the Coq executables";
   "-profile", Arg.Set Prefs.profile,
     " Add profiling information in the Coq executables";
-  "-annotate", Arg.Set Prefs.annotate,
-    " Dumps ml annotation files while compiling Coq";
+  "-annotate", Arg.Unit (fun () -> printf "*Warning* -annotate is deprecated. Please use -annot or -bin-annot instead.\n"),
+    " Deprecated. Please use -annot or -bin-annot instead";
+  "-annot", Arg.Set Prefs.annot,
+    " Dumps ml text annotation files while compiling Coq (e.g. for Tuareg)";
+  "-bin-annot", Arg.Set Prefs.bin_annot,
+    " Dumps ml binary annotation files while compiling Coq (e.g. for Merlin)";
+  "-bytecode-compiler", arg_bool Prefs.bytecodecompiler,
+    "(yes|no) Enable Coq's bytecode reduction machine (VM)";
   "-native-compiler", arg_bool Prefs.nativecompiler,
     "(yes|no) Compilation to native code for conversion and normalization";
   "-coqwebsite", Arg.Set_string Prefs.coqwebsite,
     " URL of the coq website";
   "-force-caml-version", Arg.Set Prefs.force_caml_version,
     " Force OCaml version";
+  "-force-findlib-version", Arg.Set Prefs.force_findlib_version,
+    " Force findlib version";
   "-warn-error", Arg.Set Prefs.warn_error,
     " Make OCaml warnings into errors";
   "-camldir", Arg.String (fun _ -> ()),
@@ -371,13 +393,12 @@ let reset_caml_find c o = c.find <- o
 
 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 "-annot"
-  else ""
+let coq_annot_flag = if !Prefs.annot then "-annot" else ""
+let coq_bin_annot_flag = if !Prefs.bin_annot then "-bin-annot" else ""
 
-let coq_safe_string =
-  if !Prefs.safe_string then "-safe-string" else ""
+(* This variable can be overriden only for debug purposes, use with
+   care. *)
+let coq_safe_string = "-safe-string"
 
 let cflags = "-Wall -Wno-unused -g -O2"
 
@@ -430,6 +451,22 @@ let vcs =
   else if dir_exists "{arch}" then "gnuarch"
   else "none"
 
+(** * Git Precommit Hook *)
+let _ =
+  let f = ".git/hooks/pre-commit" in
+  if vcs = "git" && dir_exists ".git/hooks" && not (Sys.file_exists f) then begin
+    printf "Creating pre-commit hook in %s\n" f;
+    let o = open_out f in
+    let pr s = fprintf o s in
+    pr "#!/bin/sh\n";
+    pr "\n";
+    pr "if [ -x dev/tools/pre-commit ]; then\n";
+    pr "    exec dev/tools/pre-commit\n";
+    pr "fi\n";
+    close_out o;
+    Unix.chmod f 0o775
+  end
+
 (** * Browser command *)
 
 let browser =
@@ -441,7 +478,7 @@ let browser =
 
 (** * OCaml programs *)
 
-let camlbin, caml_version, camllib =
+let camlbin, caml_version, camllib, findlib_version =
   let () = match !Prefs.ocamlfindcmd with
     | Some cmd -> reset_caml_find camlexec cmd
     | None ->
@@ -453,6 +490,7 @@ let camlbin, caml_version, camllib =
   if not (is_executable camlexec.find)
   then die ("Error: cannot find the executable '"^camlexec.find^"'.")
   else
+    let findlib_version, _ = run camlexec.find ["query"; "findlib"; "-format"; "%v"] in
     let caml_version, _ = run camlexec.find ["ocamlc";"-version"] in
     let camllib, _ = run camlexec.find ["printconf";"stdlib"] in
     let camlbin = (* TODO beurk beurk beurk *)
@@ -463,9 +501,9 @@ let camlbin, caml_version, camllib =
     let () =
       if is_executable (camlbin / "ocaml")
       then reset_caml_top camlexec (camlbin / "ocaml") in
-    camlbin, caml_version, camllib
+    camlbin, caml_version, camllib, findlib_version
 
-let camlp4compat = "-loc loc"
+let camlp5compat = "-loc loc"
 
 (** Caml version as a list of string, e.g. ["4";"00";"1"] *)
 
@@ -493,8 +531,27 @@ let check_caml_version () =
 
 let _ = check_caml_version ()
 
-let coq_debug_flag_opt =
-  if caml_version_nums >= [3;10] then coq_debug_flag else ""
+let findlib_version_list = numeric_prefix_list findlib_version
+
+let findlib_version_nums =
+  try
+    if List.length findlib_version_list < 2 then failwith "bad version";
+    List.map s2i findlib_version_list
+  with _ ->
+    die ("I found ocamlfind but cannot read its version number!\n" ^
+         "Is it installed properly?")
+
+let check_findlib_version () =
+  if findlib_version_nums >= [1;4;1] then
+    printf "You have OCamlfind %s. Good!\n" findlib_version
+  else
+    let () = printf "Your version of OCamlfind is %s.\n" findlib_version in
+    if !Prefs.force_findlib_version then
+      printf "*Warning* Your version of OCamlfind is outdated.\n"
+    else
+      die "You need OCamlfind 1.4.1 or later."
+
+let _ = check_findlib_version ()
 
 let camltag = match caml_version_list with
   | x::y::_ -> "OCAML"^x^y
@@ -512,23 +569,26 @@ let camltag = match caml_version_list with
     50: unexpected documentation comment: too common and annoying to avoid
     56: unreachable match case: the [_ -> .] syntax doesn't exist in 4.02.3
 *)
-let coq_warn_flags =
-  let warnings = "-w +a-4-9-27-41-42-44-45-48-50" in
-  let errors =
+let coq_warnings = "-w +a-4-9-27-41-42-44-45-48-50"
+let coq_warn_error =
     if !Prefs.warn_error
     then "-warn-error +a"
          ^ (if caml_version_nums > [4;2;3]
             then "-56"
             else "")
     else ""
-  in
-  warnings ^ " " ^ errors
 
+(* Flags used to compile Coq and plugins (via coq_makefile) *)
+let caml_flags =
+  Printf.sprintf "-thread -rectypes %s %s %s %s" coq_warnings coq_annot_flag coq_bin_annot_flag coq_safe_string
 
+(* Flags used to compile Coq but _not_ plugins (via coq_makefile) *)
+let coq_caml_flags =
+  coq_warn_error
 
-(** * CamlpX configuration *)
+(** * Camlp5 configuration *)
 
-(* Convention: we use camldir as a prioritary location for camlpX, if given *)
+(* Convention: we use camldir as a prioritary location for camlp5, if given *)
 (* i.e., in the case of camlp5, we search for a copy of camlp5o which *)
 (* answers the right camlp5 lib dir *)
 
@@ -544,7 +604,7 @@ let which_camlp5o_for camlp5lib =
   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 which_camlp5 base =
   let file = Filename.concat camlbin base in
   if is_executable file then file else which base
 
@@ -565,7 +625,7 @@ let check_camlp5 testcma = match !Prefs.camlp5dir with
       in die msg
   | None ->
     try
-      let camlp5o = which_camlpX "camlp5o" in
+      let camlp5o = which_camlp5 "camlp5o" in
       let dir,_ = tryrun camlp5o ["-where"] in
       dir, camlp5o
     with Not_found ->
@@ -579,15 +639,14 @@ let check_camlp5_version camlp5o =
     printf "You have Camlp5 %s. Good!\n" version; version
   | _ -> die "Error: unsupported Camlp5 (version < 6.06 or unrecognized).\n"
 
-let config_camlpX () =
+let config_camlp5 () =
     let camlp5mod = "gramlib" in
     let camlp5libdir, camlp5o = check_camlp5 (camlp5mod^".cma") in
     let camlp5_version = check_camlp5_version camlp5o in
-    "camlp5", "Camlp5", camlp5o, Filename.dirname camlp5o, camlp5libdir, camlp5mod, camlp5_version
+    camlp5o, Filename.dirname camlp5o, camlp5libdir, camlp5mod, camlp5_version
 
-let camlpX, capitalized_camlpX, camlpXo,
-    camlpXbindir, fullcamlpXlibdir,
-    camlpXmod, camlpX_version = config_camlpX ()
+let camlp5o, camlp5bindir, fullcamlp5libdir,
+    camlp5mod, camlp5_version = config_camlp5 ()
 
 let shorten_camllib s =
   if starts_with s (camllib^"/") then
@@ -595,7 +654,7 @@ let shorten_camllib s =
     "+" ^ String.sub s l (String.length s - l)
   else s
 
-let camlpXlibdir = shorten_camllib fullcamlpXlibdir
+let camlp5libdir = shorten_camllib fullcamlp5libdir
 
 (** * Native compiler *)
 
@@ -605,8 +664,8 @@ let msg_byteonly () =
 let msg_no_ocamlopt () =
   printf "Cannot find the OCaml native-code compiler.\n"; msg_byteonly ()
 
-let msg_no_camlpX_cmxa () =
-  printf "Cannot find the native-code library of %s.\n" camlpX; msg_byteonly ()
+let msg_no_camlp5_cmxa () =
+  printf "Cannot find the native-code library of camlp5.\n"; msg_byteonly ()
 
 let msg_no_dynlink_cmxa () =
   printf "Cannot find native-code dynlink library.\n"; msg_byteonly ();
@@ -618,8 +677,8 @@ let check_native () =
   let () = if !Prefs.byteonly then raise Not_found in
   let version, _ = tryrun camlexec.find ["opt";"-version"] in
   if version = "" then let () = msg_no_ocamlopt () in raise Not_found
-  else if not (Sys.file_exists (fullcamlpXlibdir/camlpXmod^".cmxa"))
-  then let () = msg_no_camlpX_cmxa () in raise Not_found
+  else if not (Sys.file_exists (fullcamlp5libdir/camlp5mod^".cmxa"))
+  then let () = msg_no_camlp5_cmxa () in raise Not_found
   else if fst (tryrun camlexec.find ["query";"dynlink"]) = ""
   then let () = msg_no_dynlink_cmxa () in raise Not_found
   else
@@ -642,18 +701,32 @@ let natdynlinkflag =
 
 (** * OS dependent libraries *)
 
-let osdeplibs = "-cclib -lunix"
-
-let operating_system, osdeplibs =
+let operating_system =
   if starts_with arch "sun4" then
     let os, _ = run "uname" ["-r"] in
     if starts_with os "5" then
-      "Sun Solaris "^os, osdeplibs^" -cclib -lnsl -cclib -lsocket"
+      "Sun Solaris "^os
     else
-      "Sun OS "^os, osdeplibs
+      "Sun OS "^os
   else
-    (try Sys.getenv "OS" with Not_found -> ""), osdeplibs
+    (try Sys.getenv "OS" with Not_found -> "")
+
+(** Num library *)
+
+(* since 4.06, the Num library is no longer distributed with OCaml (replaced
+   by Zarith)
+*)
 
+let check_for_numlib () =
+  if caml_version_nums >= [4;6;0] then
+    let numlib,_ = tryrun camlexec.find ["query";"num"] in
+    match numlib with
+    | ""  ->
+       die "Num library not installed, required for OCaml 4.06 or later"
+    | _   -> printf "You have the Num library installed. Good!\n"
+
+let numlib =
+  check_for_numlib ()
 
 (** * lablgtk2 and CoqIDE *)
 
@@ -687,11 +760,11 @@ let get_lablgtkdir () =
     else "", msg
   | None ->
     let msg = OCamlFind in
-    let d1,_ = tryrun "ocamlfind" ["query";"lablgtk2.sourceview2"] in
+    let d1,_ = tryrun camlexec.find ["query";"lablgtk2.sourceview2"] in
     if d1 <> "" && check_lablgtkdir msg d1 then d1, msg
     else
       (* In debian wheezy, ocamlfind knows only of lablgtk2 *)
-      let d2,_ = tryrun "ocamlfind" ["query";"lablgtk2"] in
+      let d2,_ = tryrun camlexec.find ["query";"lablgtk2"] in
       if d2 <> "" && d2 <> d1 && check_lablgtkdir msg d2 then d2, msg
       else
         let msg = Stdlib in
@@ -703,24 +776,22 @@ let get_lablgtkdir () =
 
 let check_lablgtk_version src dir = match src with
 | Manual | Stdlib ->
-  let test accu f =
-    if accu then
-      let test = sprintf "grep -q -w %s %S/glib.mli" f dir in
-      Sys.command test = 0
-    else false
-  in
-  let heuristics = [
-    "convert_with_fallback";
-    "wrap_poll_func"; (** Introduced in lablgtk 2.16 *)
-  ] in
-  let ans = List.fold_left test true heuristics in
-  if ans then printf "Warning: could not check the version of lablgtk2.\n";
-  (ans, "an unknown version")
+  printf "Warning: could not check the version of lablgtk2.\nMake sure your version is at least 2.18.3.\n";
+  (true, "an unknown version")
 | OCamlFind ->
-  let v, _ = tryrun "ocamlfind" ["query"; "-format"; "%v"; "lablgtk2"] in
+  let v, _ = tryrun camlexec.find ["query"; "-format"; "%v"; "lablgtk2"] in
   try
     let vi = List.map s2i (numeric_prefix_list v) in
-    ([2; 16] <= vi, v)
+    if vi < [2; 16; 0] then
+      (false, v)
+    else if vi < [2; 18; 3] then
+      begin
+        (* Version 2.18.3 is known to report incorrectly as 2.18.0, and Launchpad packages report as version 2.16.0 due to a misconfigured META file; see https://bugs.launchpad.net/ubuntu/+source/lablgtk2/+bug/1577236 *)
+        printf "Warning: Your installed lablgtk reports as %s.\n It is possible that the installed version is actually more recent\n but reports an incorrect version. If the installed version is\n actually more recent than 2.18.3, that's fine; if it is not,\n CoqIDE will compile but may be very unstable.\n" v;
+        (true, "an unknown version")
+      end
+    else
+      (true, v)
   with _ -> (false, v)
 
 let pr_ide = function No -> "no" | Byte -> "only bytecode" | Opt -> "native"
@@ -747,7 +818,7 @@ let check_coqide () =
   if dir = "" then set_ide No "LablGtk2 not found";
   let (ok, version) = check_lablgtk_version via dir in
   let found = sprintf "LablGtk2 found (%s, %s)" (get_source via) version in
-  if not ok then set_ide No (found^", but too old (required >= 2.16, found " ^ version ^ ")");
+  if not ok then set_ide No (found^", but too old (required >= 2.18.3, found " ^ version ^ ")");
   (* We're now sure to produce at least one kind of coqide *)
   lablgtkdir := shorten_camllib dir;
   if !Prefs.coqide = Some Byte then set_ide Byte (found^", bytecode requested");
@@ -774,7 +845,7 @@ let coqide_flags () =
   if !lablgtkdir <> "" then lablgtkincludes := sprintf "-I %S" !lablgtkdir;
   match coqide, arch with
     | "opt", "Darwin" when !Prefs.macintegration ->
-      let osxdir,_ = tryrun "ocamlfind" ["query";"lablgtkosx"] in
+      let osxdir,_ = tryrun camlexec.find ["query";"lablgtkosx"] in
       if osxdir <> "" then begin
         lablgtkincludes := sprintf "%s -I %S" !lablgtkincludes osxdir;
         idearchflags := "lablgtkosx.cma";
@@ -810,12 +881,6 @@ let strip =
     if strip = "" then "strip" else strip
     end
 
-(** * md5sum command *)
-
-let md5sum =
-  if List.mem arch ["Darwin"; "FreeBSD"; "OpenBSD"]
-  then "md5 -q" else "md5sum"
-
 
 (** * Documentation : do we have latex, hevea, ... *)
 
@@ -949,6 +1014,7 @@ let config_runtime () =
 
 let vmbyteflags = config_runtime ()
 
+let esc s = if String.contains s ' ' then "\"" ^ s ^ "\"" else s
 
 (** * Summary of the configuration *)
 
@@ -960,32 +1026,32 @@ let print_summary () =
     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;
   pr "  OCaml version               : %s\n" caml_version;
-  pr "  OCaml binaries in           : %s\n" camlbin;
-  pr "  OCaml library in            : %s\n" camllib;
-  pr "  %s version              : %s\n"     capitalized_camlpX camlpX_version;
-  pr "  %s binaries in          : %s\n"     capitalized_camlpX camlpXbindir;
-  pr "  %s library in           : %s\n"     capitalized_camlpX camlpXlibdir;
+  pr "  OCaml binaries in           : %s\n" (esc camlbin);
+  pr "  OCaml library in            : %s\n" (esc camllib);
+  pr "  OCaml flambda flags         : %s\n" (String.concat " " !Prefs.flambda_flags);
+  pr "  Camlp5 version              : %s\n" camlp5_version;
+  pr "  Camlp5 binaries in          : %s\n" (esc camlp5bindir);
+  pr "  Camlp5 library in           : %s\n" (esc camlp5libdir);
   if best_compiler = "opt" then
     pr "  Native dynamic link support : %B\n" hasnatdynlink;
   if coqide <> "no" then
-    pr "  Lablgtk2 library in         : %s\n" !lablgtkdir;
+    pr "  Lablgtk2 library in         : %s\n" (esc !lablgtkdir);
   if !idearchdef = "QUARTZ" then
     pr "  Mac OS integration is on\n";
   pr "  CoqIde                      : %s\n" coqide;
   pr "  Documentation               : %s\n"
     (if withdoc then "All" else "None");
   pr "  Web browser                 : %s\n" browser;
-  pr "  Coq web site                : %s\n\n" !Prefs.coqwebsite;
-  if not !Prefs.nativecompiler then
-    pr "  Native compiler for conversion and normalization disabled\n\n";
+  pr "  Coq web site                : %s\n" !Prefs.coqwebsite;
+  pr "  Bytecode VM enabled         : %B\n" !Prefs.bytecodecompiler;
+  pr "  Native Compiler enabled     : %B\n\n" !Prefs.nativecompiler;
   if !Prefs.local then
     pr "  Local build, no installation...\n"
   else
     (pr "  Paths for true installation:\n";
      List.iter
-       (fun (_,msg,dir,_) -> pr "  - %s will be copied in %s\n" msg dir)
+       (fun (_,msg,dir,_) -> pr "  - %s will be copied in %s\n" msg (esc dir))
        install_dirs);
   pr "\n";
   pr "If anything is wrong above, please restart './configure'.\n\n";
@@ -999,21 +1065,20 @@ let _ = print_summary ()
 
 let write_dbg_wrapper f =
   safe_remove f;
-  let o = open_out f in
+  let o = open_out_bin f in  (* _bin to avoid adding \r on Cygwin/Windows *)
   let pr s = fprintf o s in
   pr "#!/bin/sh\n\n";
   pr "###### ocamldebug-coq : a wrapper around ocamldebug for Coq ######\n\n";
   pr "# DO NOT EDIT THIS FILE: automatically generated by ../configure #\n\n";
   pr "export COQTOP=%S\n" coqtop;
   pr "OCAMLDEBUG=%S\n" (camlbin^"/ocamldebug");
-  pr "CAMLP4LIB=%S\n\n" camlpXlibdir;
+  pr "CAMLP5LIB=%S\n\n" camlp5libdir;
   pr ". $COQTOP/dev/ocamldebug-coq.run\n";
   close_out o;
   Unix.chmod f 0o555
 
 let _ = write_dbg_wrapper "dev/ocamldebug-coq"
 
-
 (** * Build the config/coq_config.ml file *)
 
 let write_configml f =
@@ -1024,8 +1089,9 @@ let write_configml f =
   let pr_b = pr "let %s = %B\n" in
   let pr_i = pr "let %s = %d\n" in
   let pr_p s o = pr "let %s = %S\n" s
-    (match o with Relative s -> s | Absolute s -> s)
-  in
+    (match o with Relative s -> s | Absolute s -> s) in
+  let pr_l  n l = pr "let %s = [%s]\n" n (String.concat ";" (List.map (fun s -> "\"" ^ s ^ "\"") l)) in
+  let pr_li n l = pr "let %s = [%s]\n" n (String.concat ";" (List.map string_of_int l)) in
   pr "(* DO NOT EDIT THIS FILE: automatically generated by ../configure *)\n";
   pr "(* Exact command that generated this file: *)\n";
   pr "(* %s *)\n\n" (String.concat " " (Array.to_list Sys.argv));
@@ -1044,16 +1110,16 @@ let write_configml f =
   pr_s "ocamllex" camlexec.lex;
   pr_s "camlbin" camlbin;
   pr_s "camllib" camllib;
-  pr_s "camlp4" camlpX;
-  pr_s "camlp4o" camlpXo;
-  pr_s "camlp4bin" camlpXbindir;
-  pr_s "camlp4lib" camlpXlibdir;
-  pr_s "camlp4compat" camlp4compat;
+  pr_s "camlp5o" camlp5o;
+  pr_s "camlp5bin" camlp5bindir;
+  pr_s "camlp5lib" camlp5libdir;
+  pr_s "camlp5compat" camlp5compat;
   pr_s "cflags" cflags;
+  pr_s "caml_flags" caml_flags;
   pr_s "best" best_compiler;
-  pr_s "osdeplibs" osdeplibs;
   pr_s "version" coq_version;
   pr_s "caml_version" caml_version;
+  pr_li "caml_version_nums" caml_version_nums;
   pr_s "date" short_date;
   pr_s "compile_date" full_date;
   pr_s "arch" arch;
@@ -1064,18 +1130,19 @@ let write_configml f =
   pr "let gtk_platform = `%s\n" !idearchdef;
   pr_b "has_natdynlink" hasnatdynlink;
   pr_s "natdynlinkflag" natdynlinkflag;
+  pr_l "flambda_flags" !Prefs.flambda_flags;
   pr_i "vo_magic_number" vo_magic;
   pr_i "state_magic_number" state_magic;
-  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");
-  pr_b "no_native_compiler" (not !Prefs.nativecompiler);
+  pr_b "bytecode_compiler" !Prefs.bytecodecompiler;
+  pr_b "native_compiler" !Prefs.nativecompiler;
 
-  let core_src_dirs = [ "config"; "dev"; "kernel"; "library";
+  let core_src_dirs = [ "config"; "dev"; "lib"; "clib"; "kernel"; "library";
                         "engine"; "pretyping"; "interp"; "parsing"; "proofs";
                         "tactics"; "toplevel"; "printing"; "intf";
                         "grammar"; "ide"; "stm"; "vernac" ] in
@@ -1084,7 +1151,6 @@ let write_configml f =
                                     core_src_dirs in
 
   pr "\nlet core_src_dirs = [\n%s]\n" core_src_dirs;
-  pr "\nlet api_dirs = [\"API\"; \"lib\"]\n";
   pr "\nlet plugins_dirs = [\n";
 
   let plugins = Sys.readdir "plugins" in
@@ -1096,7 +1162,7 @@ let write_configml f =
     plugins;
   pr "]\n";
 
-  pr "\nlet all_src_dirs = core_src_dirs @ api_dirs @ plugins_dirs\n";
+  pr "\nlet all_src_dirs = core_src_dirs @ plugins_dirs\n";
 
   close_out o;
   Unix.chmod f 0o444
@@ -1156,22 +1222,23 @@ let write_makefile f =
   pr "CAMLHLIB=%S\n\n" camllib;
   pr "# Caml link command and Caml make top command\n";
   pr "# Caml flags\n";
-  pr "CAMLFLAGS=-rectypes %s %s %s\n" coq_warn_flags coq_annotate_flag coq_safe_string;
+  pr "CAMLFLAGS=%s %s\n" caml_flags coq_caml_flags;
   pr "# User compilation flag\n";
   pr "USERFLAGS=\n\n";
+  (* XXX make this configurable *)
+  pr "FLAMBDA_FLAGS=%s\n" (String.concat " " !Prefs.flambda_flags);
   pr "# Flags for GCC\n";
   pr "CFLAGS=%s\n\n" cflags;
   pr "# Compilation debug flags\n";
   pr "CAMLDEBUG=%s\n" coq_debug_flag;
-  pr "CAMLDEBUGOPT=%s\n\n" coq_debug_flag_opt;
+  pr "CAMLDEBUGOPT=%s\n\n" coq_debug_flag;
   pr "# Compilation profile flag\n";
   pr "CAMLTIMEPROF=%s\n\n" coq_profile_flag;
-  pr "# Camlp4 : flavor, binaries, libraries ...\n";
-  pr "# NB : avoid using CAMLP4LIB (conflict under Windows)\n";
-  pr "CAMLP4=%s\n" camlpX;
-  pr "CAMLP4O=%s\n" (win_aware_quote_executable camlpXo);
-  pr "CAMLP4COMPAT=%s\n" camlp4compat;
-  pr "MYCAMLP4LIB=%S\n\n" camlpXlibdir;
+  pr "# Camlp5 : flavor, binaries, libraries ...\n";
+  pr "# NB : avoid using CAMLP5LIB (conflict under Windows)\n";
+  pr "CAMLP5O=%s\n" (win_aware_quote_executable camlp5o);
+  pr "CAMLP5COMPAT=%s\n" camlp5compat;
+  pr "MYCAMLP5LIB=%S\n\n" camlp5libdir;
   pr "# Your architecture\n";
   pr "# Can be obtain by UNIX command arch\n";
   pr "ARCH=%s\n" arch;
@@ -1179,7 +1246,6 @@ let write_makefile f =
   pr "# Supplementary libs for some systems, currently:\n";
   pr "#  . Sun Solaris: -cclib -lunix -cclib -lnsl -cclib -lsocket\n";
   pr "#  . others     : -cclib -lunix\n";
-  pr "OSDEPLIBS=%s\n\n" osdeplibs;
   pr "# executable files extension, currently:\n";
   pr "#  Unix systems:\n";
   pr "#  Win32 systems : .exe\n";
@@ -1191,8 +1257,6 @@ let write_makefile f =
   pr "# Unix systems and profiling: true\n";
   pr "# Unix systems and no profiling: strip\n";
   pr "STRIP=%s\n\n" strip;
-  pr "#the command md5sum\n";
-  pr "MD5SUM=%s\n\n" md5sum;
   pr "# LablGTK\n";
   pr "COQIDEINCLUDES=%s\n\n" !lablgtkincludes;
   pr "# CoqIde (no/byte/opt)\n";
diff --git a/default.nix b/default.nix
new file mode 100644
index 000000000..af2a13a84
--- /dev/null
+++ b/default.nix
@@ -0,0 +1,73 @@
+# How to use?
+
+# If you have Nix installed, you can get in an environment with everything
+# needed to compile Coq and CoqIDE by running:
+# $ nix-shell
+# at the root of the Coq repository.
+
+# How to tweak default arguments?
+
+# nix-shell supports the --arg option (see Nix doc) that allows you for
+# instance to do this:
+# $ nix-shell --arg ocamlPackages "(import <nixpkgs> {}).ocamlPackages_latest" --arg buildIde false
+
+# You can also compile Coq and "install" it by running:
+# $ make clean # (only needed if you have left-over compilation files)
+# $ nix-build
+# at the root of the Coq repository.
+# nix-build also supports the --arg option, so you will be able to do:
+# $ nix-build --arg doCheck false
+# if you want to speed up things by not running the test-suite.
+# Once the build is finished, you will find, in the current directory,
+# a symlink to where Coq was installed.
+
+{ pkgs ? (import <nixpkgs> {}), ocamlPackages ? pkgs.ocamlPackages,
+  buildIde ? true, doCheck ? true }:
+
+with pkgs;
+
+stdenv.mkDerivation rec {
+
+  name = "coq";
+
+  buildInputs = (with ocamlPackages; [
+
+    # Coq dependencies
+    ocaml
+    findlib
+    camlp5_strict
+    num
+
+  ]) ++ (if buildIde then [
+
+    # CoqIDE dependencies
+    ocamlPackages.lablgtk
+
+  ] else []) ++ (if doCheck then
+
+    # Test-suite dependencies
+    let inherit (stdenv.lib) versionAtLeast optional; in
+    /* ncurses is required to build an OCaml REPL */
+    optional (!versionAtLeast ocaml.version "4.07") ncurses
+    ++ [
+    python
+    rsync
+    which
+
+  ] else []) ++ (if lib.inNixShell then [
+    ocamlPackages.merlin
+    ocamlPackages.ocpIndent
+    ocamlPackages.ocp-index
+  ] else []);
+
+  src =
+    if lib.inNixShell then null
+    else
+      with builtins; filterSource
+        (path: _: !elem (baseNameOf path) [".git" "result" "bin"]) ./.;
+
+  prefixKey = "-prefix ";
+
+  inherit doCheck;
+
+}
diff --git a/dev/Bugzilla_Coq_autolink.user.js b/dev/Bugzilla_Coq_autolink.user.js
new file mode 100644
index 000000000..ed056021b
--- /dev/null
+++ b/dev/Bugzilla_Coq_autolink.user.js
@@ -0,0 +1,25 @@
+// ==UserScript==
+// @name        Bugzilla Coq autolink
+// @namespace   CoqScript
+// @include     https://coq.inria.fr/bugs/*
+// @description Makes #XXXX into links to Github Coq PRs
+// @version     1
+// @grant       none
+// ==/UserScript==
+
+var regex = /#(\d+)/g;
+var substr = '<a href="https://github.com/coq/coq/pull/$1">$&</a>';
+
+function doNode(node)
+{
+    node.innerHTML = node.innerHTML.replace(regex,substr);
+}
+
+var comments = document.getElementsByClassName("bz_comment_table")[0];
+var pars = comments.getElementsByClassName("bz_comment_text");
+
+for(var j=0; j<pars.length; j++)
+{
+    doNode(pars[j]);
+}
+
diff --git a/dev/Coq_Bugzilla_autolink.user.js b/dev/Coq_Bugzilla_autolink.user.js
new file mode 100644
index 000000000..5ff618a83
--- /dev/null
+++ b/dev/Coq_Bugzilla_autolink.user.js
@@ -0,0 +1,68 @@
+// ==UserScript==
+// @name        Coq Bugzilla autolink
+// @namespace   SkySkimmer
+// @include     https://github.com/coq/coq/*
+// @description Makes BZ#XXXX into links to bugzilla for GitHub
+// @version     1
+// @grant       none
+// ==/UserScript==
+
+var regex = /BZ#(\d+)/g;
+var substr = '<a href="https://coq.inria.fr/bugs/show_bug.cgi?id=$1">$&</a>';
+
+function doTitle(node)
+{
+    node.innerHTML = node.innerHTML.replace(regex,substr);
+}
+
+function filter(node)
+{
+  if (node.nodeName == '#text')
+    {
+      return NodeFilter.FILTER_ACCEPT;
+    }
+  else if(node.nodeName == 'A')
+    {
+      return NodeFilter.FILTER_REJECT;
+    }
+  return NodeFilter.FILTER_SKIP;
+}
+var comments = document.getElementsByClassName("comment-body");
+
+function doNode(parent)
+{
+    var nodes = document.createTreeWalker(parent,NodeFilter.SHOW_ALL,{ acceptNode : filter },false);
+    var node;
+    while(node=nodes.nextNode())
+    {
+      var content = node.textContent;
+      var matches = regex.exec(content);
+
+      if(matches && matches.length > 1)
+      {
+        var range = document.createRange();
+        var start = content.search(regex);
+        var end = start + matches[0].length;
+        range.setStart(node, start);
+        range.setEnd(node, end);
+        var linkNode = document.createElement("a");
+        linkNode.href = "https://coq.inria.fr/bugs/show_bug.cgi?id=" + matches[1];
+        range.surroundContents(linkNode);
+
+        //handle multiple matches in one text node
+        doNode(linkNode.parentNode);
+      }
+    }
+}
+
+for(var i=0; i<comments.length; i++)
+{
+  doNode(comments[i]);
+}
+
+// usually 1 or 0 titles...
+var titles = document.getElementsByClassName("js-issue-title");
+for(var i=0; i<titles.length; i++)
+{
+    doTitle(titles[i]);
+}
diff --git a/dev/README b/dev/README
index b446c3e97..453f85f0d 100644
--- a/dev/README
+++ b/dev/README
@@ -1,4 +1,4 @@
-This directory contains informations and tools to help developing the
+This directory contains information and tools to help develop the
                              Coq system
                        ======================
 
@@ -6,30 +6,30 @@ This directory contains informations and tools to help developing the
 Debugging and profiling (in current directory - see doc/debugging.txt)
 -----------------------
 
-ocamldebug-coq: to launch ocaml debugger
+ocamldebug-coq: to launch ocaml debugger (generated by the configure script)
 
-db:      to install pretty-printers from ocaml debugger
-base_db: to install raw pretty-printers from ocaml debugger
+db:           to install pretty-printers from ocaml debugger
+base_db:      to install raw pretty-printers from ocaml debugger
 
-include:      to install pretty-printers from ocaml toplevel
+include:      to install pretty-printers from ocaml toplevel (use with the coq Drop command)
 base_include: to install raw pretty-printers from ocaml toplevel
 
-vm_printers.ml, dev_printers.ml: ML pretty-printers for debugging
+vm_printers.ml, top_printers.ml: ML pretty-printers for debugging
 
 
-Miscellaneous informations about the code (directory doc)
+Miscellaneous information about the code (directory doc)
 -----------------------------------------
 
-changes.txt:   (partial) per-version summary of the evolutions of Coq ML source
-style.txt:     a few style recommendations for writing Coq ML files
-debugging.txt: help for debugging or profiling
-universes.txt: help to debug universes
-translate.txt: help to use coq translator
+changes.md:     (partial) per-version summary of the evolution of Coq ML source
+style.txt:      a few style recommendations for writing Coq ML files
+debugging.md:   help for debugging or profiling
+universes.txt:  help for debugging universes
+translate.txt:  help for using coq translator
 extensions.txt: some help about TACTIC EXTEND
 
-header:        standard header for Coq ML files
-perf-analysis: analysis of perfs measured on the compilation of user contribs
-cic.dtd:       official dtd of the calc. of ind. constr. for im/ex-portation
+header:         standard header for Coq ML files
+perf-analysis:  analysis of perfs measured on the compilation of user contribs
+cic.dtd:        official dtd of the calc. of ind. constr. for im/ex-portation
 
 
 Documentation of ML interfaces using ocamldoc (directory ocamldoc/html)
@@ -40,7 +40,11 @@ Documentation of ML interfaces using ocamldoc (directory ocamldoc/html)
 Other development tools (directory tools)
 -----------------------
 
+coqdev.el: helper customizations for everyday Coq development, eg
+  making `compile' work in subdirectories
+
 objects.el: various development utilities at emacs level
+
 anomaly-traces-parser.el: a .emacs-ready elisp snippet to parse
   location of Anomaly backtraces and jump to them conveniently from
   the Emacs *compilation* output.
diff --git a/dev/base_include b/dev/base_include
index 79ecd73e0..350ccaa10 100644
--- a/dev/base_include
+++ b/dev/base_include
@@ -18,12 +18,9 @@
 #directory "intf";;
 #directory "stm";;
 #directory "vernac";;
-#directory "../API";;
 
-#directory "+camlp4";; (* lazy solution: add both of camlp4/5 so that *)
 #directory "+camlp5";; (* Gramext is found in top_printers.ml *)
 
-#load "API.cma";;
 #use "top_printers.ml";;
 #use "vm_printers.ml";;
 
@@ -54,7 +51,7 @@
 #install_printer ppvblock;;
 #install_printer  (* bigint *) ppbigint;;
 #install_printer  (* loc *) pploc;;
-#install_printer  (* substitution *) prsubst;;
+#install_printer  (* substitution *) ppsubst;;
 
 (* Open main files *)
 
@@ -130,7 +127,6 @@ open Reserve
 open Syntax_def
 open Constrexpr
 open Constrexpr_ops
-open Topconstr
 open Notation_term
 open Notation_ops
 open Prettyp
@@ -171,7 +167,7 @@ open Eqschemes
 
 open ExplainErr
 open Class
-open Command
+open ComDefinition
 open Indschemes
 open Ind_tables
 open Auto_ind_decl
@@ -194,8 +190,8 @@ let qid = Libnames.qualid_of_string;;
 (* parsing of terms *)
 
 let parse_constr = Pcoq.parse_string Pcoq.Constr.constr;;
-let parse_vernac = Pcoq.parse_string Pcoq.Vernac_.vernac;;
-let parse_tac    = API.Pcoq.parse_string Ltac_plugin.Pltac.tactic;;
+let parse_vernac = Pcoq.parse_string Pcoq.Vernac_.vernac_control;;
+let parse_tac    = Pcoq.parse_string Ltac_plugin.Pltac.tactic;;
 
 (* build a term of type glob_constr without type-checking or resolution of 
    implicit syntax *)
@@ -231,10 +227,9 @@ let pf_e gl s =
 let _ = Flags.in_debugger := false
 let _ = Flags.in_toplevel := true
 let _ = Constrextern.set_extern_reference
-  (fun ?loc _ r -> Libnames.Qualid (loc,Nametab.shortest_qualid_of_global Idset.empty r));;
+  (fun ?loc _ r -> Libnames.Qualid (loc,Nametab.shortest_qualid_of_global Id.Set.empty r));;
 
-open Coqloop
-let go = loop
+let go () = Coqloop.loop ~time:false ~state:Option.(get !Coqtop.drop_last_doc)
 
 let _ =
  print_string
diff --git a/dev/bugzilla2github_stripped.csv b/dev/bugzilla2github_stripped.csv
new file mode 100644
index 000000000..3f5cbfd71
--- /dev/null
+++ b/dev/bugzilla2github_stripped.csv
@@ -0,0 +1,501 @@
+2, 1156
+3, 1157
+4, 1158
+7, 1160
+8, 1161
+10, 1163
+12, 1164
+13, 1165
+14, 1169
+16, 1171
+17, 1184
+18, 1190
+19, 1191
+20, 1193
+21, 1200
+23, 1201
+24, 1203
+25, 1208
+26, 1210
+27, 1212
+28, 1216
+30, 1217
+31, 1223
+34, 1227
+35, 1232
+36, 1235
+38, 1238
+39, 1244
+40, 1245
+41, 1246
+42, 1247
+44, 1248
+45, 1249
+46, 1250
+47, 1252
+48, 1253
+49, 1254
+50, 1256
+52, 1262
+54, 1263
+55, 1264
+56, 1265
+59, 1266
+60, 1267
+61, 1268
+63, 1270
+64, 1272
+65, 1274
+66, 1275
+69, 1276
+70, 1279
+71, 1283
+72, 1284
+73, 1285
+74, 1286
+75, 1287
+78, 1288
+79, 1291
+80, 1292
+82, 1293
+83, 1295
+84, 1296
+85, 1297
+86, 1299
+88, 1301
+89, 1303
+90, 1304
+91, 1305
+92, 1307
+93, 1308
+94, 1310
+95, 1312
+96, 1313
+97, 1314
+98, 1316
+99, 1318
+100, 1319
+101, 1320
+102, 1321
+103, 1323
+105, 1324
+106, 1327
+107, 1328
+108, 1330
+109, 1334
+112, 1335
+115, 1336
+119, 1337
+121, 1341
+123, 1342
+124, 1343
+125, 1344
+126, 1345
+127, 1346
+128, 1348
+129, 1349
+134, 1350
+135, 1351
+136, 1352
+137, 1353
+138, 1354
+139, 1355
+140, 1356
+142, 1357
+143, 1358
+144, 1359
+145, 1360
+147, 1361
+148, 1362
+149, 1363
+150, 1365
+152, 1366
+154, 1368
+155, 1369
+160, 1370
+161, 1371
+162, 1372
+164, 1373
+165, 1374
+166, 1376
+167, 1377
+169, 1378
+170, 1380
+178, 1382
+179, 1383
+180, 1384
+181, 1385
+182, 1386
+183, 1387
+184, 1390
+185, 1391
+186, 1392
+187, 1393
+189, 1394
+190, 1398
+191, 1401
+192, 1402
+194, 1403
+195, 1404
+196, 1405
+197, 1407
+198, 1409
+199, 1410
+202, 1412
+204, 1413
+205, 1421
+207, 1422
+209, 1423
+210, 1426
+212, 1427
+213, 1428
+214, 1429
+215, 1433
+216, 1435
+219, 1436
+220, 1437
+221, 1440
+222, 1444
+224, 1445
+225, 1450
+228, 1452
+229, 1453
+235, 1457
+236, 1458
+238, 1459
+239, 1460
+240, 1462
+242, 1465
+243, 1466
+244, 1470
+245, 1471
+248, 1472
+250, 1473
+253, 1474
+254, 1475
+259, 1476
+261, 1478
+262, 1479
+263, 1480
+264, 1481
+265, 1484
+266, 1485
+267, 1486
+268, 1488
+269, 1489
+270, 1490
+271, 1492
+272, 1493
+273, 1494
+274, 1498
+275, 1500
+277, 1503
+278, 1504
+279, 1505
+282, 1506
+283, 1511
+289, 1513
+290, 1514
+291, 1516
+292, 1517
+294, 1520
+295, 1521
+299, 1523
+301, 1524
+302, 1525
+303, 1527
+305, 1529
+311, 1530
+315, 1531
+316, 1532
+317, 1534
+320, 1535
+322, 1539
+324, 1541
+328, 1542
+329, 1543
+330, 1544
+331, 1545
+333, 1546
+335, 1547
+336, 1548
+338, 1549
+343, 1550
+348, 1551
+350, 1552
+351, 1553
+352, 1554
+353, 1555
+356, 1556
+363, 1557
+368, 1558
+371, 1559
+372, 1560
+413, 1561
+418, 1562
+420, 1563
+426, 1564
+431, 1565
+444, 1566
+447, 1567
+452, 1569
+459, 1570
+462, 1571
+463, 1573
+468, 1574
+472, 1575
+473, 1577
+509, 1578
+519, 1579
+529, 1580
+540, 1581
+541, 1583
+545, 1584
+546, 1585
+547, 1589
+550, 1590
+552, 1591
+553, 1592
+554, 1593
+574, 1594
+592, 1595
+602, 1597
+603, 1598
+606, 1599
+607, 1600
+667, 1601
+668, 1602
+686, 1603
+690, 1605
+699, 1606
+705, 1607
+708, 1609
+711, 1610
+728, 1611
+739, 1612
+742, 1613
+743, 1615
+774, 1617
+775, 1619
+776, 1623
+777, 1624
+778, 1625
+779, 1627
+780, 1628
+781, 1629
+782, 1630
+783, 1631
+784, 1632
+785, 1633
+786, 1636
+787, 1637
+788, 1638
+789, 1639
+790, 1640
+793, 1641
+794, 1642
+795, 1644
+797, 1645
+798, 1646
+803, 1647
+804, 1649
+805, 1650
+808, 1652
+813, 1653
+815, 1655
+816, 1656
+818, 1657
+820, 1658
+821, 1659
+822, 1660
+823, 1661
+826, 1662
+828, 1663
+829, 1664
+830, 1665
+831, 1666
+832, 1667
+834, 1668
+835, 1669
+836, 1670
+837, 5689
+839, 5791
+840, 5792
+841, 5793
+842, 5794
+843, 5795
+844, 5796
+846, 5797
+849, 5798
+850, 5799
+854, 5800
+855, 5801
+856, 5802
+857, 5803
+860, 5804
+861, 5805
+862, 5806
+863, 5807
+864, 5808
+865, 5809
+867, 5810
+868, 5811
+869, 5812
+870, 5813
+871, 5814
+872, 5815
+874, 5816
+875, 5817
+878, 5818
+879, 5819
+881, 5820
+883, 5821
+884, 5822
+885, 5823
+886, 5824
+888, 5825
+889, 5826
+890, 5827
+891, 5828
+892, 5829
+893, 5830
+894, 5831
+896, 5832
+898, 5833
+901, 5834
+903, 5835
+905, 5836
+906, 5837
+909, 5838
+914, 5839
+915, 5840
+922, 5841
+923, 5842
+925, 5843
+927, 5844
+931, 5845
+932, 5846
+934, 5847
+935, 5848
+936, 5849
+937, 5850
+938, 5851
+939, 5852
+940, 5853
+941, 5854
+945, 5855
+946, 5856
+947, 5857
+949, 5858
+950, 5859
+951, 5860
+952, 5861
+953, 5862
+954, 5863
+957, 5864
+960, 5865
+963, 5866
+965, 5867
+967, 5868
+968, 5869
+969, 5870
+972, 5871
+973, 5872
+974, 5873
+975, 5874
+976, 5875
+977, 5876
+979, 5877
+983, 5878
+984, 5879
+985, 5880
+986, 5881
+987, 5882
+988, 5883
+990, 5884
+991, 5885
+993, 5886
+996, 5887
+997, 5888
+1000, 5889
+1001, 5890
+1002, 5891
+1003, 5892
+1004, 5893
+1005, 5894
+1006, 5895
+1007, 5896
+1010, 5897
+1012, 5898
+1013, 5899
+1014, 5900
+1015, 5901
+1016, 5902
+1017, 5903
+1018, 5904
+1025, 5905
+1028, 5906
+1029, 5907
+1030, 5908
+1031, 5909
+1033, 5910
+1035, 5911
+1036, 5912
+1037, 5913
+1039, 5914
+1041, 5915
+1042, 5916
+1044, 5917
+1045, 5918
+1052, 5919
+1053, 5920
+1054, 5921
+1055, 5922
+1056, 5923
+1060, 5924
+1064, 5925
+1067, 5926
+1070, 5927
+1072, 5928
+1075, 5929
+1076, 5930
+1085, 5931
+1086, 5932
+1087, 5933
+1089, 5934
+1091, 5935
+1096, 5936
+1097, 5937
+1098, 5938
+1099, 5939
+1100, 5940
+1101, 5941
+1102, 5942
+1104, 5943
+1107, 5944
+1108, 5945
+1111, 5946
+1113, 5947
+1114, 5948
+1115, 5949
+1116, 5950
+1118, 5951
+1119, 5952
+1120, 5953
+1122, 5954
+1123, 5955
+1124, 5956
+1128, 5957
+1129, 5958
+1132, 5959
+1136, 5960
+1137, 5961
+1138, 5962
+1140, 5963
+1141, 5964
+1142, 5965
+1144, 5966
+1145, 5967
+1149, 5968
+1151, 5969
+1153, 5970
diff --git a/dev/build/osx/make-macos-dmg.sh b/dev/build/osx/make-macos-dmg.sh
index cbe2a5186..dc33838f1 100755
--- a/dev/build/osx/make-macos-dmg.sh
+++ b/dev/build/osx/make-macos-dmg.sh
@@ -9,15 +9,12 @@ DMGDIR=$PWD/_dmg
 VERSION=$(sed -n -e '/^let coq_version/ s/^[^"]*"\([^"]*\)"$/\1/p' configure.ml)
 APP=bin/CoqIDE_${VERSION}.app
 
-# Create a .app file with CoqIDE
-make -j $NJOBS -l2 $APP
+# Create a .app file with CoqIDE, without signing it
+make PRIVATEBINARIES=$APP -j $NJOBS -l2 $APP
 
 # Add Coq to the .app file
 make OLDROOT=$OUTDIR COQINSTALLPREFIX=$APP/Contents/Resources/ install-coq install-ide-toploop
 
-# Sign the .app file
-codesign -f -s - $APP
-
 # Create the dmg bundle
 mkdir -p $DMGDIR
 ln -sf /Applications $DMGDIR/Applications
@@ -28,4 +25,4 @@ mkdir -p _build
 # Temporary countermeasure to hdiutil error 5341
 # head -c9703424 /dev/urandom > $DMGDIR/.padding
 
-hdiutil create -imagekey zlib-level=9 -volname CoqIDE_$VERSION -srcfolder $DMGDIR -ov -format UDZO _build/CoqIDE_$VERSION.dmg
+hdiutil create -imagekey zlib-level=9 -volname coq-$VERSION-installer-macos -srcfolder $DMGDIR -ov -format UDZO _build/coq-$VERSION-installer-macos.dmg
diff --git a/dev/build/windows/MakeCoq_MinGW.bat b/dev/build/windows/MakeCoq_MinGW.bat
index b2efe2ddd..665d54176 100644
--- a/dev/build/windows/MakeCoq_MinGW.bat
+++ b/dev/build/windows/MakeCoq_MinGW.bat
@@ -328,12 +328,6 @@ 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
 
@@ -344,6 +338,15 @@ IF EXIST "%CYGWIN_INSTALLDIR_WFMT%\etc\setup\installed.db" (
 IF NOT "%CYGWIN_QUIET%" == "Y" (
   SET RUNSETUP=Y
 )
+IF "%COQREGTESTING%" == "Y" (
+  SET RUNSETUP=Y
+)
+
+SET "EXTRAPACKAGES= "
+
+IF NOT "%APPVEYOR%" == "True" (
+  SET EXTRAPACKAGES=-P wget,curl,git,gcc-core,gcc-g++,automake1.5
+)
 
 IF "%RUNSETUP%"=="Y" (
   %SETUP% ^
@@ -353,10 +356,9 @@ IF "%RUNSETUP%"=="Y" (
     --local-package-dir "%CYGWIN_LOCAL_CACHE_WFMT%" ^
     --no-shortcuts ^
     %CYGWIN_OPT% ^
-    -P wget,curl,git,make,unzip ^
-    -P gcc-core,gcc-g++ ^
+    -P make,unzip ^
     -P gdb,liblzma5 ^
-    -P patch,automake1.14,automake1.15 ^
+    -P patch,automake1.14 ^
     -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 ^
@@ -366,12 +368,11 @@ IF "%RUNSETUP%"=="Y" (
     -P gtk-update-icon-cache ^
     -P libtool,automake ^
     -P intltool ^
-    > "%LOGFILE%" ^
+    %EXTRAPACKAGES% ^
     || GOTO ErrorExit
 
   MKDIR "%CYGWIN_INSTALLDIR_WFMT%\build"
   MKDIR "%CYGWIN_INSTALLDIR_WFMT%\build\buildlogs"
-  MOVE  "%LOGFILE%" "%CYGWIN_INSTALLDIR_WFMT%\build\buildlogs\cygwinsetup.log" || GOTO ErrorExit
 )
 
 
diff --git a/dev/build/windows/MakeCoq_regtest_noproxy.bat b/dev/build/windows/MakeCoq_regtest_noproxy.bat
index 7b17e721b..7140a7c61 100644
--- a/dev/build/windows/MakeCoq_regtest_noproxy.bat
+++ b/dev/build/windows/MakeCoq_regtest_noproxy.bat
@@ -25,5 +25,5 @@ call MakeCoq_MinGW.bat ^
   -cygquiet=Y ^

   -destcyg   %ROOTPATH%\cygwin_coq64_85pl2_abs ^

   -destcoq   %ROOTPATH%\coq64_85pl2_abs

-
-pause
\ No newline at end of file
+

+pause

diff --git a/dev/build/windows/ReadMe.txt b/dev/build/windows/ReadMe.txt
index a6d8e4462..7e80e33c6 100644
--- a/dev/build/windows/ReadMe.txt
+++ b/dev/build/windows/ReadMe.txt
@@ -418,7 +418,6 @@ 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
@@ -438,7 +437,6 @@ 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
diff --git a/dev/build/windows/configure_profile.sh b/dev/build/windows/configure_profile.sh
index 0b61a31e7..16c972e80 100644
--- a/dev/build/windows/configure_profile.sh
+++ b/dev/build/windows/configure_profile.sh
@@ -40,4 +40,4 @@ if [ ! -f $donefile ] ; then
     echo unset OCAMLLIB >> $rcfile
 
     touch $donefile
-fi
\ No newline at end of file
+fi
diff --git a/dev/build/windows/makecoq_mingw.sh b/dev/build/windows/makecoq_mingw.sh
index e17923951..d8cde39f8 100644
--- a/dev/build/windows/makecoq_mingw.sh
+++ b/dev/build/windows/makecoq_mingw.sh
@@ -794,8 +794,8 @@ function make_ocaml {
     # TODO: this might not work if PREFIX contains spaces
     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:
+    # We don't want to mess up Coq's directory structure so put the OCaml library in a separate folder
+    # If we refer to the make variable ${PREFIX} below, camlp5 ends up having the 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
@@ -910,6 +910,10 @@ function make_camlp5 {
     log2 make install
     # For some reason gramlib.a is not copied, but it is required by Coq
     cp lib/gramlib.a "$PREFIXOCAML/libocaml/camlp5/"
+    # For some reason META is not copied, but it is required by coq_makefile
+    log2 make -C etc META
+    mkdir -p "$PREFIXOCAML/libocaml/site-lib/camlp5/"
+    cp etc/META "$PREFIXOCAML/libocaml/site-lib/camlp5/"
     log2 make clean
     build_post
   fi
@@ -1058,13 +1062,18 @@ function copq_coq_gtk {
     install_rec  "$PREFIX/share/themes/" '*'                          "$PREFIXCOQ/share/themes"
     
     # This below item look like a bug in make install
+    if [ -d "$PREFIXCOQ/share/coq/" ] ; then
+      COQSHARE="$PREFIXCOQ/share/coq/"
+    else
+      COQSHARE="$PREFIXCOQ/share/"
+    fi
     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"
+      mv "$COQSHARE"*.lang "$PREFIXCOQ/share/gtksourceview-2.0/language-specs"
+      mv "$COQSHARE"*.xml  "$PREFIXCOQ/share/gtksourceview-2.0/styles"
     fi
     mkdir -p "$PREFIXCOQ/ide"
-    mv "$PREFIXCOQ/share/coq/"*.png  "$PREFIXCOQ/ide"
-    rmdir "$PREFIXCOQ/share/coq"
+    mv "$COQSHARE"*.png  "$PREFIXCOQ/ide"
+    rmdir "$PREFIXCOQ/share/coq" || true
   fi
 }
 
@@ -1078,7 +1087,7 @@ function copy_coq_license {
     install -D README                         "$PREFIXCOQ/license_readme/coq/ReadMe.txt" || true
     install -D README.md                      "$PREFIXCOQ/license_readme/coq/ReadMe.md" || true
     install -D README.win                     "$PREFIXCOQ/license_readme/coq/ReadMeWindows.txt" || true
-    install -D README.doc                     "$PREFIXCOQ/license_readme/coq/ReadMeDoc.txt"
+    install -D README.doc                     "$PREFIXCOQ/license_readme/coq/ReadMeDoc.txt" || true
     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"
@@ -1119,11 +1128,11 @@ function make_coq {
   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
+      ./configure -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"
+      ./configure -with-doc no -prefix "$PREFIXCOQ" -libdir "$PREFIXCOQ/lib" -mandir "$PREFIXCOQ/man"
     else
-      logn configure ./configure -debug -with-doc no -prefix "$PREFIXCOQ"
+      ./configure -with-doc no -prefix "$PREFIXCOQ"
     fi
 
     # The windows resource compiler binary name is hard coded
@@ -1134,17 +1143,17 @@ function make_coq {
     if [[ $COQ_VERSION == 8.4* ]] ; then
       log1 make
     else
-      log1 make $MAKE_OPT
+      make $MAKE_OPT
     fi
     
     if [ "$INSTALLMODE" == "relocatable" ]; then
-      logn reconfigure ./configure -debug -with-doc no -prefix "$PREFIXCOQ" -libdir "$PREFIXCOQ/lib" -mandir "$PREFIXCOQ/man"
+      ./configure -with-doc no -prefix "$PREFIXCOQ" -libdir "$PREFIXCOQ/lib" -mandir "$PREFIXCOQ/man"
     fi
 
-    log2 make install
-    log1 copy_coq_dlls
+    make install
+    copy_coq_dlls
     if [ "$INSTALLOCAML" == "Y" ]; then
-      log1 copy_coq_objects
+      copy_coq_objects
     fi
     
     copq_coq_gtk
@@ -1165,7 +1174,7 @@ 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
+    cp /usr/bin/${ARCH}-w64-mingw32-gcc-6.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
@@ -1267,7 +1276,7 @@ function get_cygwin_mingw_sources {
 function make_coq_installer {
   make_coq
   make_mingw_make
-  # get_cygwin_mingw_sources
+  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
diff --git a/dev/build/windows/patches_coq/coq_new.nsi b/dev/build/windows/patches_coq/coq_new.nsi
index b88aa066d..2c2f0fa47 100644
--- a/dev/build/windows/patches_coq/coq_new.nsi
+++ b/dev/build/windows/patches_coq/coq_new.nsi
@@ -15,7 +15,7 @@
 SetCompressor lzma
 
 !define MY_PRODUCT "Coq" ;Define your own software name here
-!define OUTFILE "coq-installer-${VERSION}-${ARCH}.exe"
+!define OUTFILE "coq-${VERSION}-installer-windows-${ARCH}.exe"
 
 !include "MUI2.nsh"
 !include "FileAssociation.nsh"
@@ -188,7 +188,7 @@ SectionEnd
 Section "Uninstall"
   ; Files and folders
   RMDir /r "$INSTDIR\bin"
-  RMDir /r "$INSTDIR\dev"
+  RMDir /r "$INSTDIR\doc"
   RMDir /r "$INSTDIR\etc"
   RMDir /r "$INSTDIR\lib"
   RMDir /r "$INSTDIR\libocaml"
diff --git a/dev/build/windows/patches_coq/ln.c b/dev/build/windows/patches_coq/ln.c
index 5e02c72bb..41f64f98b 100644
--- a/dev/build/windows/patches_coq/ln.c
+++ b/dev/build/windows/patches_coq/ln.c
@@ -134,4 +134,4 @@ int WINAPI WinMain( HINSTANCE hInstance, HINSTANCE hPrevInstance, LPSTR lpCmdLin
     
     // Everything is fine
     return 0;
-}
\ No newline at end of file
+}
diff --git a/dev/ci/README.md b/dev/ci/README.md
new file mode 100644
index 000000000..bb13587e9
--- /dev/null
+++ b/dev/ci/README.md
@@ -0,0 +1,132 @@
+Continuous Integration for the Coq Proof Assistant
+==================================================
+
+Changes to Coq are systematically tested for regression and compatibility
+breakage on our Continuous Integration (CI) platforms *before* integration,
+so as to ensure better robustness and catch problems as early as possible.
+These tests include the compilation of several external libraries / plugins.
+
+This document contains information for both external library / plugin authors,
+who might be interested in having their development tested, and for Coq
+developers / contributors, who must ensure that they don't break these
+external developments accidentally.
+
+*Remark:* the CI policy outlined in this document is susceptible to evolve and
+specific accommodations are of course possible.
+
+Information for external library / plugin authors
+-------------------------------------------------
+
+You are encouraged to consider submitting your development for addition to
+our CI. This means that:
+
+- Any time that a proposed change is breaking your development, Coq developers
+  will send you patches to adapt it or, at the very least, will work with you
+  to see how to adapt it.
+
+On the condition that:
+
+- At the time of the submission, your development works with Coq master branch.
+
+- Your development is publicly available in a git repository and we can easily
+  send patches to you (e.g. through pull / merge requests).
+
+- You react in a timely manner to discuss / integrate those patches.
+
+- You do not push, to the branches that we test, commits that haven't been
+  first tested to compile with the corresponding branch(es) of Coq.
+
+- Your development compiles in less than 35 minutes with just two threads.
+  If this is not the case, consider adding a "lite" target that compiles just
+  part of it.
+
+In case you forget to comply with these last three conditions, we would reach
+out to you and give you a 30-day grace period during which your development
+would be moved into our "allow failure" category. At the end of the grace
+period, in the absence of progress, the development would be removed from our
+CI.
+
+### Add your development by submitting a pull request
+
+Add a new `ci-mydev.sh` script to [`dev/ci`](/dev/ci) (have a look at
+[`ci-coq-dpdgraph.sh`](/dev/ci/ci-coq-dpdgraph.sh) or
+[`ci-fiat-parsers.sh`](/dev/ci/ci-fiat-parsers.sh) for simple examples);
+set the corresponding variables in
+[`ci-basic-overlay.sh`](/dev/ci/ci-basic-overlay.sh); add the corresponding
+target to [`Makefile.ci`](/Makefile.ci); add new jobs to
+[`.travis.yml`](/.travis.yml) and [`.gitlab-ci.yml`](/.gitlab-ci.yml) so that
+this new target is run. **Do not hesitate to submit an incomplete pull request
+if you need help to finish it.**
+
+You may also be interested in having your development tested in our
+performance benchmark. Currently this is done by providing an OPAM package
+in https://github.com/coq/opam-coq-archive and opening an issue at
+https://github.com/coq/coq-bench/issues.
+
+
+Information for developers
+--------------------------
+
+When you submit a pull request (PR) on Coq GitHub repository, this will
+automatically launch a battery of CI tests. The PR will not be integrated
+unless these tests pass.
+
+Currently, we have two CI platforms:
+
+- Travis is the main CI platform. It tests the compilation of Coq, of the
+  documentation, and of CoqIDE on Linux with several versions of OCaml /
+  camlp5, and with warnings as errors; it runs the test-suite and tests the
+  compilation of several external developments. It also tests the compilation
+  of Coq on OS X.
+
+- AppVeyor is used to test the compilation of Coq and run the test-suite on
+  Windows.
+
+You can anticipate the results of these tests prior to submitting your PR
+by having them run of your fork of Coq, on GitHub or GitLab. This can be
+especially helpful given that our Travis platform is often overloaded and
+therefore there can be a significant delay before these tests are actually
+run on your PR. To take advantage of this, simply create a Travis account
+and link it to your GitHub account, or activate the pipelines on your GitLab
+fork.
+
+You can also run one CI target locally (using `make ci-somedev`).
+
+Whenever your PR breaks tested developments, you should either adapt it
+so that it doesn't, or provide a branch fixing these developments (or at
+least work with the author of the development / other Coq developers to
+prepare these fixes). Then, add an overlay in
+[`dev/ci/user-overlays`](/dev/ci/user-overlays) (see the README there)
+in a separate commit in your PR.
+
+The process to merge your PR is then to submit PRs to the external
+development repositories, merge the latter first (if the fixes are
+backward-compatible), drop the overlay commit and merge the PR on Coq then.
+
+See also [`test-suite/README.md`](/test-suite/README.md) for information about adding new tests to the test-suite.
+
+
+Travis specific information
+---------------------------
+
+Travis rebuilds all of Coq's executables and stdlib for each job. Coq
+is built with `./configure -local`, then used for the job's test.
+
+
+GitLab specific information
+---------------------------
+
+GitLab is set up to use the "build artifact" feature to avoid
+rebuilding Coq. In one job, Coq is built with `./configure -prefix
+install` and `make install` is run, then the `install` directory
+persists to and is used by the next jobs.
+
+Artifacts can also be downloaded from the GitLab repository.
+Currently, available artifacts are:
+- the Coq executables and stdlib, in three copies varying in
+  architecture and Ocaml version used to build Coq.
+- the Coq documentation, in two different copies varying in the OCaml
+  version used to build Coq
+
+As an exception to the above, jobs testing that compilation triggers
+no Ocaml warnings build Coq in parallel with other tests.
diff --git a/dev/ci/appveyor.bat b/dev/ci/appveyor.bat
new file mode 100644
index 000000000..dec6f0d18
--- /dev/null
+++ b/dev/ci/appveyor.bat
@@ -0,0 +1,41 @@
+REM This script either runs the test suite with OPAM (if USEOPAM is true) or
+REM builds the Coq binary packages for windows (if USEOPAM is false).
+
+if %ARCH% == 32 (
+  SET ARCHLONG=i686
+  SET CYGROOT=C:\cygwin
+  SET SETUP=setup-x86.exe
+)
+
+if %ARCH% == 64 (
+  SET ARCHLONG=x86_64
+  SET CYGROOT=C:\cygwin64
+  SET SETUP=setup-x86_64.exe
+)
+
+SET CYGCACHE=%CYGROOT%\var\cache\setup
+SET APPVEYOR_BUILD_FOLDER_MFMT=%APPVEYOR_BUILD_FOLDER:\=/%
+SET APPVEYOR_BUILD_FOLDER_CFMT=%APPVEYOR_BUILD_FOLDER_MFMT:C:/=/cygdrive/c/%
+SET DESTCOQ=C:\coq%ARCH%_inst
+SET COQREGTESTING=Y
+
+if %USEOPAM% == false (
+  call %APPVEYOR_BUILD_FOLDER%\dev\build\windows\MakeCoq_MinGW.bat -threads=1 ^
+    -arch=%ARCH% -installer=Y -coqver=%APPVEYOR_BUILD_FOLDER_CFMT% ^
+    -destcyg=%CYGROOT% -destcoq=%DESTCOQ% -cygcache=%CYGCACHE% ^
+    -setup %CYGROOT%\%SETUP% || GOTO ErrorExit
+  copy "%CYGROOT%\build\coq-local\dev\nsis\*.exe" dev\nsis || GOTO ErrorExit
+  7z a coq-opensource-archive-windows-%ARCHLONG%.zip %CYGROOT%\build\tarballs\* || GOTO ErrorExit
+)
+
+if %USEOPAM% == true (
+  %CYGROOT%\%SETUP% -qnNdO -R %CYGROOT% -l %CYGCACHE% -s %CYGMIRROR% ^
+    -P rsync -P patch -P diffutils -P make -P unzip -P m4 -P findutils -P time
+  %CYGROOT%/bin/bash -l %APPVEYOR_BUILD_FOLDER%/dev/ci/appveyor.sh || GOTO ErrorExit
+)
+
+GOTO :EOF
+
+:ErrorExit
+  ECHO ERROR %0 failed
+  EXIT /b 1
diff --git a/dev/build/windows/appveyor.sh b/dev/ci/appveyor.sh
index 53f7a2346..524a55a42 100644
--- a/dev/build/windows/appveyor.sh
+++ b/dev/ci/appveyor.sh
@@ -1,8 +1,9 @@
 #!/bin/bash
 set -e -x
-wget $opam_url
+wget https://github.com/fdopen/opam-repository-mingw/releases/download/0.0.0.1/opam64.tar.xz
 tar -xf opam64.tar.xz
 bash opam64/install.sh
 opam init -a mingw https://github.com/fdopen/opam-repository-mingw.git --comp 4.02.3+mingw64c --switch 4.02.3+mingw64c
 eval $(opam config env)
 opam install -y ocamlfind camlp5
+cd $APPVEYOR_BUILD_FOLDER && ./configure -local && make && make byte && make -C test-suite all INTERACTIVE= && make validate
diff --git a/dev/ci/ci-basic-overlay.sh b/dev/ci/ci-basic-overlay.sh
index 43525dcd4..48e01e9e9 100644
--- a/dev/ci/ci-basic-overlay.sh
+++ b/dev/ci/ci-basic-overlay.sh
@@ -4,128 +4,149 @@
 
 # Maybe we should just use Ruby to have real objects...
 
+# : "${foo:=bar}" sets foo to "bar" if it is unset or null
+
 ########################################################################
 # MathComp
 ########################################################################
-: ${mathcomp_CI_BRANCH:=master}
-: ${mathcomp_CI_GITURL:=https://github.com/math-comp/math-comp.git}
+: "${mathcomp_CI_BRANCH:=master}"
+: "${mathcomp_CI_GITURL:=https://github.com/math-comp/math-comp.git}"
 
 ########################################################################
 # UniMath
 ########################################################################
-: ${UniMath_CI_BRANCH:=master}
-: ${UniMath_CI_GITURL:=https://github.com/UniMath/UniMath.git}
+: "${UniMath_CI_BRANCH:=master}"
+: "${UniMath_CI_GITURL:=https://github.com/UniMath/UniMath.git}"
 
 ########################################################################
 # Unicoq + Metacoq
 ########################################################################
-: ${unicoq_CI_BRANCH:=master}
-: ${unicoq_CI_GITURL:=https://github.com/unicoq/unicoq.git}
+: "${unicoq_CI_BRANCH:=master}"
+: "${unicoq_CI_GITURL:=https://github.com/unicoq/unicoq.git}"
 
-: ${metacoq_CI_BRANCH:=master}
-: ${metacoq_CI_GITURL:=https://github.com/MetaCoq/MetaCoq.git}
+: "${metacoq_CI_BRANCH:=master}"
+: "${metacoq_CI_GITURL:=https://github.com/MetaCoq/MetaCoq.git}"
 
 ########################################################################
 # Mathclasses + Corn
 ########################################################################
-: ${math_classes_CI_BRANCH:=external-bignums}
-: ${math_classes_CI_GITURL:=https://github.com/letouzey/math-classes.git}
+: "${math_classes_CI_BRANCH:=master}"
+: "${math_classes_CI_GITURL:=https://github.com/math-classes/math-classes.git}"
 
-: ${Corn_CI_BRANCH:=external-bignums}
-: ${Corn_CI_GITURL:=https://github.com/letouzey/corn.git}
+: "${Corn_CI_BRANCH:=master}"
+: "${Corn_CI_GITURL:=https://github.com/c-corn/corn.git}"
 
 ########################################################################
 # Iris
 ########################################################################
-: ${stdpp_CI_BRANCH:=master}
-: ${stdpp_CI_GITURL:=https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp.git}
+: "${stdpp_CI_BRANCH:=master}"
+: "${stdpp_CI_GITURL:=https://gitlab.mpi-sws.org/robbertkrebbers/coq-stdpp.git}"
+
+: "${Iris_CI_BRANCH:=master}"
+: "${Iris_CI_GITURL:=https://gitlab.mpi-sws.org/FP/iris-coq.git}"
 
-: ${Iris_CI_BRANCH:=master}
-: ${Iris_CI_GITURL:=https://gitlab.mpi-sws.org/FP/iris-coq.git}
+: "${lambdaRust_CI_BRANCH:=master}"
+: "${lambdaRust_CI_GITURL:=https://gitlab.mpi-sws.org/FP/LambdaRust-coq.git}"
 
 ########################################################################
 # HoTT
 ########################################################################
-# Temporary overlay
-: ${HoTT_CI_BRANCH:=ocaml.4.02.3}
-: ${HoTT_CI_GITURL:=https://github.com/ejgallego/HoTT.git}
-# : ${HoTT_CI_BRANCH:=master}
-# : ${HoTT_CI_GITURL:=https://github.com/HoTT/HoTT.git}
+: "${HoTT_CI_BRANCH:=master}"
+: "${HoTT_CI_GITURL:=https://github.com/HoTT/HoTT.git}"
+
+########################################################################
+# Ltac2
+########################################################################
+: "${ltac2_CI_BRANCH:=master}"
+: "${ltac2_CI_GITURL:=https://github.com/ppedrot/ltac2.git}"
 
 ########################################################################
 # GeoCoq
 ########################################################################
-: ${GeoCoq_CI_BRANCH:=master}
-: ${GeoCoq_CI_GITURL:=https://github.com/GeoCoq/GeoCoq.git}
+: "${GeoCoq_CI_BRANCH:=master}"
+: "${GeoCoq_CI_GITURL:=https://github.com/GeoCoq/GeoCoq.git}"
 
 ########################################################################
 # Flocq
 ########################################################################
-: ${Flocq_CI_BRANCH:=master}
-: ${Flocq_CI_GITURL:=https://scm.gforge.inria.fr/anonscm/git/flocq/flocq.git}
+: "${Flocq_CI_BRANCH:=master}"
+: "${Flocq_CI_GITURL:=https://gitlab.inria.fr/flocq/flocq.git}"
 
 ########################################################################
 # Coquelicot
 ########################################################################
-: ${Coquelicot_CI_BRANCH:=master}
-: ${Coquelicot_CI_GITURL:=https://scm.gforge.inria.fr/anonscm/git/coquelicot/coquelicot.git}
+: "${Coquelicot_CI_BRANCH:=master}"
+: "${Coquelicot_CI_GITURL:=https://scm.gforge.inria.fr/anonscm/git/coquelicot/coquelicot.git}"
 
 ########################################################################
 # CompCert
 ########################################################################
-: ${CompCert_CI_BRANCH:=less_init_plugins}
-: ${CompCert_CI_GITURL:=https://github.com/letouzey/CompCert.git}
+: "${CompCert_CI_BRANCH:=master}"
+: "${CompCert_CI_GITURL:=https://github.com/AbsInt/CompCert.git}"
 
 ########################################################################
 # VST
 ########################################################################
-: ${VST_CI_BRANCH:=master}
-: ${VST_CI_GITURL:=https://github.com/Zimmi48/VST.git}
+: "${VST_CI_BRANCH:=master}"
+: "${VST_CI_GITURL:=https://github.com/PrincetonUniversity/VST.git}"
 
 ########################################################################
 # fiat_parsers
 ########################################################################
-: ${fiat_parsers_CI_BRANCH:=master}
-: ${fiat_parsers_CI_GITURL:=https://github.com/mit-plv/fiat.git}
+: "${fiat_parsers_CI_BRANCH:=master}"
+: "${fiat_parsers_CI_GITURL:=https://github.com/mit-plv/fiat.git}"
 
 ########################################################################
 # fiat_crypto
 ########################################################################
-: ${fiat_crypto_CI_BRANCH:=master}
-: ${fiat_crypto_CI_GITURL:=https://github.com/mit-plv/fiat-crypto.git}
+: "${fiat_crypto_CI_BRANCH:=master}"
+: "${fiat_crypto_CI_GITURL:=https://github.com/mit-plv/fiat-crypto.git}"
 
 ########################################################################
 # formal-topology
 ########################################################################
-: ${formal_topology_CI_BRANCH:=ci}
-: ${formal_topology_CI_GITURL:=https://github.com/bmsherman/topology.git}
+: "${formal_topology_CI_BRANCH:=ci}"
+: "${formal_topology_CI_GITURL:=https://github.com/bmsherman/topology.git}"
 
 ########################################################################
 # coq-dpdgraph
 ########################################################################
-: ${coq_dpdgraph_CI_BRANCH:=coq-trunk}
-: ${coq_dpdgraph_CI_GITURL:=https://github.com/Karmaki/coq-dpdgraph.git}
+: "${coq_dpdgraph_CI_BRANCH:=coq-trunk}"
+: "${coq_dpdgraph_CI_GITURL:=https://github.com/Karmaki/coq-dpdgraph.git}"
 
 ########################################################################
 # CoLoR
 ########################################################################
-: ${Color_CI_SVNURL:=https://scm.gforge.inria.fr/anonscm/svn/color/trunk/color}
+: "${CoLoR_CI_BRANCH:=master}"
+: "${CoLoR_CI_GITURL:=https://github.com/fblanqui/color.git}"
 
 ########################################################################
 # SF
 ########################################################################
-: ${sf_lf_CI_TARURL:=https://www.cis.upenn.edu/~bcpierce/sf/lf-current/lf.tgz}
-: ${sf_plf_CI_TARURL:=https://www.cis.upenn.edu/~bcpierce/sf/plf-current/plf.tgz}
-: ${sf_vfa_CI_TARURL:=https://www.cis.upenn.edu/~bcpierce/sf/vfa-current/vfa.tgz}
+: "${sf_lf_CI_TARURL:=https://www.cis.upenn.edu/~bcpierce/sf/lf-current/lf.tgz}"
+: "${sf_plf_CI_TARURL:=https://www.cis.upenn.edu/~bcpierce/sf/plf-current/plf.tgz}"
+: "${sf_vfa_CI_TARURL:=https://www.cis.upenn.edu/~bcpierce/sf/vfa-current/vfa.tgz}"
 
 ########################################################################
 # TLC
 ########################################################################
-: ${tlc_CI_BRANCH:=master}
-: ${tlc_CI_GITURL:=https://gforge.inria.fr/git/tlc/tlc.git}
+: "${tlc_CI_BRANCH:=master}"
+: "${tlc_CI_GITURL:=https://gforge.inria.fr/git/tlc/tlc.git}"
 
 ########################################################################
 # Bignums
 ########################################################################
-: ${bignums_CI_BRANCH:=master}
-: ${bignums_CI_GITURL:=https://github.com/coq/bignums.git}
+: "${bignums_CI_BRANCH:=master}"
+: "${bignums_CI_GITURL:=https://github.com/coq/bignums.git}"
+
+########################################################################
+# Equations
+########################################################################
+: "${Equations_CI_BRANCH:=8.8+alpha}"
+: "${Equations_CI_GITURL:=https://github.com/mattam82/Coq-Equations.git}"
+
+########################################################################
+# Elpi
+########################################################################
+: "${Elpi_CI_BRANCH:=coq-master}"
+: "${Elpi_CI_GITURL:=https://github.com/LPCIC/coq-elpi.git}"
diff --git a/dev/ci/ci-bignums.sh b/dev/ci/ci-bignums.sh
index ff5935d4c..c90e516ae 100755
--- a/dev/ci/ci-bignums.sh
+++ b/dev/ci/ci-bignums.sh
@@ -4,7 +4,7 @@ ci_dir="$(dirname "$0")"
 
 # This script could be included inside other ones
 # Let's avoid to source ci-common twice in this case
-if [ -z "${CI_BUILD_DIR}"];
+if [ -z "${CI_BUILD_DIR}" ];
 then
     source ${ci_dir}/ci-common.sh
 fi
@@ -13,4 +13,4 @@ bignums_CI_DIR=${CI_BUILD_DIR}/Bignums
 
 git_checkout ${bignums_CI_BRANCH} ${bignums_CI_GITURL} ${bignums_CI_DIR}
 
-( cd ${bignums_CI_DIR} && make -j ${NJOBS} && make install)
+( cd ${bignums_CI_DIR} && make && make install)
diff --git a/dev/ci/ci-color.sh b/dev/ci/ci-color.sh
index 309050057..558e8cbb8 100755
--- a/dev/ci/ci-color.sh
+++ b/dev/ci/ci-color.sh
@@ -3,33 +3,8 @@
 ci_dir="$(dirname "$0")"
 source ${ci_dir}/ci-common.sh
 
-Color_CI_DIR=${CI_BUILD_DIR}/color
+CoLoR_CI_DIR=${CI_BUILD_DIR}/color
 
-# Setup Bignums
-
-source ${ci_dir}/ci-bignums.sh
-
-# Compiles CoLoR
-
-svn checkout ${Color_CI_SVNURL} ${Color_CI_DIR}
-
-sed -i -e "s/From Coq Require Import BigN/From Bignums Require Import BigN/" ${Color_CI_DIR}/Util/*/*.v
-sed -i -e "s/From Coq Require Export BigN/From Bignums Require Export BigN/" ${Color_CI_DIR}/Util/*/*.v
-sed -i -e "s/From Coq Require Import BigZ/From Bignums Require Import BigZ/" ${Color_CI_DIR}/Util/*/*.v
-sed -i -e "s/From Coq Require Export BigZ/From Bignums Require Export BigZ/" ${Color_CI_DIR}/Util/*/*.v
-
-# Adapt to PR #220 (FunInd not loaded in Prelude anymore)
-sed -i -e "15i From Coq Require Import FunInd." ${Color_CI_DIR}/Coccinelle/basis/ordered_set.v
-sed -i -e "8i From Coq Require Import FunInd." ${Color_CI_DIR}/Coccinelle/examples/cime_trace/equational_extension.v
-sed -i -e "6i From Coq Require Import FunInd." ${Color_CI_DIR}/Coccinelle/examples/cime_trace/more_list_extention.v
-sed -i -e "6i From Coq Require Import FunInd." ${Color_CI_DIR}/Coccinelle/examples/cime_trace/ring_extention.v
-sed -i -e "27i From Coq Require Import FunInd." ${Color_CI_DIR}/Coccinelle/list_extensions/dickson.v
-sed -i -e "26i From Coq Require Import FunInd." ${Color_CI_DIR}/Coccinelle/list_extensions/list_permut.v
-sed -i -e "23i From Coq Require Import FunInd." ${Color_CI_DIR}/Coccinelle/list_extensions/list_set.v
-sed -i -e "25i From Coq Require Import FunInd." ${Color_CI_DIR}/Coccinelle/list_extensions/list_sort.v
-sed -i -e "21i From Coq Require Import FunInd." ${Color_CI_DIR}/Coccinelle/list_extensions/more_list.v
-sed -i -e "21i From Coq Require Import FunInd." ${Color_CI_DIR}/Util/List/ListUtil.v
-sed -i -e "17i From Coq Require Import FunInd." ${Color_CI_DIR}/Util/Multiset/MultisetOrder.v
-sed -i -e "13i From Coq Require Import FunInd." ${Color_CI_DIR}/Util/Set/SetUtil.v
-
-( cd ${Color_CI_DIR} && make )
+# Compile CoLoR
+git_checkout ${CoLoR_CI_BRANCH} ${CoLoR_CI_GITURL} ${CoLoR_CI_DIR}
+( cd ${CoLoR_CI_DIR} && make )
diff --git a/dev/ci/ci-common.sh b/dev/ci/ci-common.sh
index 238960948..d7a356930 100644
--- a/dev/ci/ci-common.sh
+++ b/dev/ci/ci-common.sh
@@ -2,11 +2,27 @@
 
 set -xe
 
+# default value for NJOBS
+: "${NJOBS:=1}"
+export NJOBS
+
 if [ -n "${GITLAB_CI}" ];
 then
-    export COQBIN=`pwd`/install/bin
+    export COQBIN="$PWD/_install_ci/bin"
+    export CI_BRANCH="$CI_COMMIT_REF_NAME"
 else
-    export COQBIN=`pwd`/bin
+    if [ -n "${TRAVIS}" ];
+    then
+        export CI_PULL_REQUEST="$TRAVIS_PULL_REQUEST"
+        export CI_BRANCH="$TRAVIS_BRANCH"
+    elif [ -n "${CIRCLECI}" ];
+    then
+        export CI_PULL_REQUEST="$CIRCLE_PR_NUMBER"
+        export CI_BRANCH="$CIRCLE_BRANCH"
+    else # assume local
+        export CI_BRANCH="$(git rev-parse --abbrev-ref HEAD)"
+    fi
+    export COQBIN="$PWD/bin"
 fi
 export PATH="$COQBIN:$PATH"
 
@@ -16,14 +32,16 @@ export COQBIN="$COQBIN/"
 ls "$COQBIN"
 
 # Where we clone and build external developments
-CI_BUILD_DIR=`pwd`/_build_ci
+CI_BUILD_DIR="$PWD/_build_ci"
 
-for overlay in ${ci_dir}/user-overlays/*.sh; do
-  source ${overlay}
+# shellcheck source=ci-basic-overlay.sh
+source "${ci_dir}/ci-basic-overlay.sh"
+for overlay in "${ci_dir}"/user-overlays/*.sh; do
+    # shellcheck source=/dev/null
+    source "${overlay}"
 done
-source ${ci_dir}/ci-basic-overlay.sh
 
-mathcomp_CI_DIR=${CI_BUILD_DIR}/math-comp
+mathcomp_CI_DIR="${CI_BUILD_DIR}/math-comp"
 
 # git_checkout branch url dest will create a git repository
 # in <dest> (if it does not exist already) and checkout the
@@ -36,15 +54,16 @@ git_checkout()
 
   # Allow an optional 4th argument for the commit
   local _COMMIT=${4:-FETCH_HEAD}
-  local _DEPTH=$(if [ -z "${4}" ]; then echo "--depth 1"; fi)
-
-  mkdir -p ${_DEST}
-  ( cd ${_DEST}                                                && \
-    if [ ! -d .git ] ; then git clone ${_DEPTH} ${_URL} . ; fi && \
-    echo "Checking out ${_DEST}"                               && \
-    git fetch ${_URL} ${_BRANCH}                               && \
-    git checkout ${_COMMIT}                                    && \
-    echo "${_DEST}: `git log -1 --format='%s | %H | %cd | %aN'`" )
+  local _DEPTH=()
+  if [ -z "${4}" ]; then _DEPTH=(--depth 1); fi
+
+  mkdir -p "${_DEST}"
+  ( cd "${_DEST}"                                                     && \
+    if [ ! -d .git ] ; then git clone "${_DEPTH[@]}" "${_URL}" . ; fi && \
+    echo "Checking out ${_DEST}"                                      && \
+    git fetch "${_URL}" "${_BRANCH}"                                  && \
+    git checkout "${_COMMIT}"                                         && \
+    echo "${_DEST}: $(git log -1 --format='%s | %H | %cd | %aN')" )
 }
 
 checkout_mathcomp()
@@ -52,13 +71,25 @@ checkout_mathcomp()
   git_checkout ${mathcomp_CI_BRANCH} ${mathcomp_CI_GITURL} ${1}
 }
 
+make()
+{
+    # +x: add x only if defined
+    if [ -z "${MAKEFLAGS+x}" ] && [ -n "${NJOBS}" ];
+    then
+        # Not submake and parallel make requested
+        command make -j "$NJOBS" "$@"
+    else
+        command make "$@"
+    fi
+}
+
 # this installs just the ssreflect library of math-comp
 install_ssreflect()
 {
   echo 'Installing ssreflect' && echo -en 'travis_fold:start:ssr.install\\r'
 
-  checkout_mathcomp ${mathcomp_CI_DIR}
-  ( cd ${mathcomp_CI_DIR}/mathcomp   && \
+  checkout_mathcomp "${mathcomp_CI_DIR}"
+  ( cd "${mathcomp_CI_DIR}/mathcomp" && \
     sed -i.bak '/ssrtest/d'     Make && \
     sed -i.bak '/odd_order/d'   Make && \
     sed -i.bak '/all\/all.v/d'  Make && \
diff --git a/dev/ci/ci-compcert.sh b/dev/ci/ci-compcert.sh
index 4cfe0911b..6a0ce2aef 100755
--- a/dev/ci/ci-compcert.sh
+++ b/dev/ci/ci-compcert.sh
@@ -5,9 +5,7 @@ source ${ci_dir}/ci-common.sh
 
 CompCert_CI_DIR=${CI_BUILD_DIR}/CompCert
 
-opam install -j ${NJOBS} -y menhir
+opam install -j "$NJOBS" -y menhir
 git_checkout ${CompCert_CI_BRANCH} ${CompCert_CI_GITURL} ${CompCert_CI_DIR}
 
-# Patch to avoid the upper version limit
-( cd ${CompCert_CI_DIR} && ./configure -ignore-coq-version x86_32-linux && make )
-
+( cd ${CompCert_CI_DIR} && ./configure -ignore-coq-version x86_32-linux && make && make check-proof )
diff --git a/dev/ci/ci-coq-dpdgraph.sh b/dev/ci/ci-coq-dpdgraph.sh
index b610f7000..5d6bd6a36 100755
--- a/dev/ci/ci-coq-dpdgraph.sh
+++ b/dev/ci/ci-coq-dpdgraph.sh
@@ -7,4 +7,4 @@ coq_dpdgraph_CI_DIR=${CI_BUILD_DIR}/coq-dpdgraph
 
 git_checkout ${coq_dpdgraph_CI_BRANCH} ${coq_dpdgraph_CI_GITURL} ${coq_dpdgraph_CI_DIR}
 
-( cd ${coq_dpdgraph_CI_DIR} && autoconf && ./configure && make -j ${NJOBS} && make test-suite )
+( cd ${coq_dpdgraph_CI_DIR} && autoconf && ./configure && make && make test-suite )
diff --git a/dev/ci/ci-corn.sh b/dev/ci/ci-corn.sh
new file mode 100755
index 000000000..54cad5df4
--- /dev/null
+++ b/dev/ci/ci-corn.sh
@@ -0,0 +1,10 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+Corn_CI_DIR=${CI_BUILD_DIR}/corn
+
+git_checkout ${Corn_CI_BRANCH} ${Corn_CI_GITURL} ${Corn_CI_DIR}
+
+( cd ${Corn_CI_DIR} && make && make install )
diff --git a/dev/ci/ci-elpi.sh b/dev/ci/ci-elpi.sh
new file mode 100755
index 000000000..c44e0a655
--- /dev/null
+++ b/dev/ci/ci-elpi.sh
@@ -0,0 +1,10 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+Elpi_CI_DIR=${CI_BUILD_DIR}/elpi
+
+git_checkout ${Elpi_CI_BRANCH} ${Elpi_CI_GITURL} ${Elpi_CI_DIR}
+
+( cd ${Elpi_CI_DIR} && make && make install )
diff --git a/dev/ci/ci-equations.sh b/dev/ci/ci-equations.sh
new file mode 100755
index 000000000..62854afac
--- /dev/null
+++ b/dev/ci/ci-equations.sh
@@ -0,0 +1,10 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+Equations_CI_DIR=${CI_BUILD_DIR}/Equations
+
+git_checkout ${Equations_CI_BRANCH} ${Equations_CI_GITURL} ${Equations_CI_DIR}
+
+( cd ${Equations_CI_DIR} && coq_makefile -f _CoqProject -o Makefile && make && make test-suite && make examples && make install)
diff --git a/dev/ci/ci-formal-topology.sh b/dev/ci/ci-formal-topology.sh
index 2556f84a5..53eb55fc4 100755
--- a/dev/ci/ci-formal-topology.sh
+++ b/dev/ci/ci-formal-topology.sh
@@ -3,30 +3,8 @@
 ci_dir="$(dirname "$0")"
 source ${ci_dir}/ci-common.sh
 
-math_classes_CI_DIR=${CI_BUILD_DIR}/math-classes
-
-Corn_CI_DIR=${CI_BUILD_DIR}/corn
-
 formal_topology_CI_DIR=${CI_BUILD_DIR}/formal-topology
 
-# Setup Bignums
-
-source ${ci_dir}/ci-bignums.sh
-
-# Setup Math-Classes
-
-git_checkout ${math_classes_CI_BRANCH} ${math_classes_CI_GITURL} ${math_classes_CI_DIR}
-
-( cd ${math_classes_CI_DIR} && make && make install )
-
-# Setup Corn
-
-git_checkout ${Corn_CI_BRANCH} ${Corn_CI_GITURL} ${Corn_CI_DIR}
-
-( cd ${Corn_CI_DIR} && make && make install )
-
-# Setup formal-topology
-
 git_checkout ${formal_topology_CI_BRANCH} ${formal_topology_CI_GITURL} ${formal_topology_CI_DIR}
 
 ( cd ${formal_topology_CI_DIR} && make )
diff --git a/dev/ci/ci-geocoq.sh b/dev/ci/ci-geocoq.sh
index eadeb7c38..8e6448e76 100755
--- a/dev/ci/ci-geocoq.sh
+++ b/dev/ci/ci-geocoq.sh
@@ -8,9 +8,5 @@ GeoCoq_CI_DIR=${CI_BUILD_DIR}/GeoCoq
 git_checkout ${GeoCoq_CI_BRANCH} ${GeoCoq_CI_GITURL} ${GeoCoq_CI_DIR}
 
 ( cd ${GeoCoq_CI_DIR}                                     && \
-  ./configure.sh                                          && \
-  sed -i.bak '/Ch16_coordinates_with_functions\.v/d' Make && \
-  sed -i.bak '/Elements\/Book_1\.v/d'                Make && \
-  sed -i.bak '/Elements\/Book_3\.v/d'                Make && \
-  coq_makefile -f Make -o Makefile                        && \
+  ./configure-ci.sh                                       && \
   make )
diff --git a/dev/ci/ci-hott.sh b/dev/ci/ci-hott.sh
index 1bf6e9a87..693135a4c 100755
--- a/dev/ci/ci-hott.sh
+++ b/dev/ci/ci-hott.sh
@@ -7,4 +7,4 @@ HoTT_CI_DIR=${CI_BUILD_DIR}/HoTT
 
 git_checkout ${HoTT_CI_BRANCH} ${HoTT_CI_GITURL} ${HoTT_CI_DIR}
 
-( cd ${HoTT_CI_DIR} && ./autogen.sh && ./configure && make -j ${NJOBS} )
+( cd ${HoTT_CI_DIR} && ./autogen.sh && ./configure && make )
diff --git a/dev/ci/ci-iris-coq.sh b/dev/ci/ci-iris-coq.sh
deleted file mode 100755
index 2d127ddc1..000000000
--- a/dev/ci/ci-iris-coq.sh
+++ /dev/null
@@ -1,26 +0,0 @@
-#!/usr/bin/env bash
-
-ci_dir="$(dirname "$0")"
-source ${ci_dir}/ci-common.sh
-
-stdpp_CI_DIR=${CI_BUILD_DIR}/coq-stdpp
-
-Iris_CI_DIR=${CI_BUILD_DIR}/iris-coq
-
-install_ssreflect
-
-# Setup Iris first, as it is needed to compute the dependencies
-
-git_checkout ${Iris_CI_BRANCH} ${Iris_CI_GITURL} ${Iris_CI_DIR}
-read -a IRIS_DEP < ${Iris_CI_DIR}/opam.pins
-
-# Setup stdpp
-stdpp_CI_GITURL=${IRIS_DEP[1]}.git
-stdpp_CI_COMMIT=${IRIS_DEP[2]}
-
-git_checkout ${stdpp_CI_BRANCH} ${stdpp_CI_GITURL} ${stdpp_CI_DIR} ${stdpp_CI_COMMIT}
-
-( cd ${stdpp_CI_DIR} && make && make install )
-
-# Build iris now
-( cd ${Iris_CI_DIR} && make )
diff --git a/dev/ci/ci-iris-lambda-rust.sh b/dev/ci/ci-iris-lambda-rust.sh
new file mode 100755
index 000000000..267e13359
--- /dev/null
+++ b/dev/ci/ci-iris-lambda-rust.sh
@@ -0,0 +1,41 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+stdpp_CI_DIR=${CI_BUILD_DIR}/coq-stdpp
+Iris_CI_DIR=${CI_BUILD_DIR}/iris-coq
+lambdaRust_CI_DIR=${CI_BUILD_DIR}/lambdaRust
+
+install_ssreflect
+
+# Add or update the opam repo we need for dependency resolution
+opam repo add iris-dev https://gitlab.mpi-sws.org/FP/opam-dev.git -p 0 || opam update iris-dev
+
+# Setup lambdaRust first
+git_checkout ${lambdaRust_CI_BRANCH} ${lambdaRust_CI_GITURL} ${lambdaRust_CI_DIR}
+
+# Extract required version of Iris
+Iris_VERSION=$(cat ${lambdaRust_CI_DIR}/opam | fgrep coq-iris | egrep 'dev\.([0-9.-]+)' -o)
+Iris_URL=$(opam show coq-iris.$Iris_VERSION -f upstream-url)
+read -a Iris_URL_PARTS <<< $(echo $Iris_URL | tr '#' ' ')
+
+# Setup Iris
+git_checkout ${Iris_CI_BRANCH} ${Iris_URL_PARTS[0]} ${Iris_CI_DIR} ${Iris_URL_PARTS[1]}
+
+# Extract required version of std++
+stdpp_VERSION=$(cat ${Iris_CI_DIR}/opam | fgrep coq-stdpp | egrep 'dev\.([0-9.-]+)' -o)
+stdpp_URL=$(opam show coq-stdpp.$stdpp_VERSION -f upstream-url)
+read -a stdpp_URL_PARTS <<< $(echo $stdpp_URL | tr '#' ' ')
+
+# Setup std++
+git_checkout ${stdpp_CI_BRANCH} ${stdpp_URL_PARTS[0]} ${stdpp_CI_DIR} ${stdpp_URL_PARTS[1]}
+
+# Build std++
+( cd ${stdpp_CI_DIR} && make && make install )
+
+# Build and validate (except on Travis, i.e., skip if TRAVIS is non-empty) Iris
+( cd ${Iris_CI_DIR} && make && (test -n "${TRAVIS}" || make validate) && make install )
+
+# Build lambdaRust
+( cd ${lambdaRust_CI_DIR} && make && make install )
diff --git a/dev/ci/ci-ltac2.sh b/dev/ci/ci-ltac2.sh
new file mode 100755
index 000000000..820ff89ee
--- /dev/null
+++ b/dev/ci/ci-ltac2.sh
@@ -0,0 +1,10 @@
+#!/usr/bin/env bash
+
+ci_dir="$(dirname "$0")"
+source ${ci_dir}/ci-common.sh
+
+ltac2_CI_DIR=${CI_BUILD_DIR}/ltac2
+
+git_checkout ${ltac2_CI_BRANCH} ${ltac2_CI_GITURL} ${ltac2_CI_DIR}
+
+( cd ${ltac2_CI_DIR} && make && make tests && make install )
diff --git a/dev/ci/ci-math-classes.sh b/dev/ci/ci-math-classes.sh
index 2837dee96..db4a31e54 100755
--- a/dev/ci/ci-math-classes.sh
+++ b/dev/ci/ci-math-classes.sh
@@ -5,20 +5,6 @@ source ${ci_dir}/ci-common.sh
 
 math_classes_CI_DIR=${CI_BUILD_DIR}/math-classes
 
-Corn_CI_DIR=${CI_BUILD_DIR}/corn
-
-# Setup Bignums
-
-source ${ci_dir}/ci-bignums.sh
-
-# Setup Math-Classes
-
 git_checkout ${math_classes_CI_BRANCH} ${math_classes_CI_GITURL} ${math_classes_CI_DIR}
 
 ( cd ${math_classes_CI_DIR} && make && make install )
-
-# Setup Corn
-
-git_checkout ${Corn_CI_BRANCH} ${Corn_CI_GITURL} ${Corn_CI_DIR}
-
-( cd ${Corn_CI_DIR} && make )
diff --git a/dev/ci/ci-sf.sh b/dev/ci/ci-sf.sh
index 272041205..4e8c7e145 100755
--- a/dev/ci/ci-sf.sh
+++ b/dev/ci/ci-sf.sh
@@ -3,17 +3,33 @@
 ci_dir="$(dirname "$0")"
 source ${ci_dir}/ci-common.sh
 
-# XXX: Needs fixing to properly set the build directory.
-wget ${sf_lf_CI_TARURL}
-wget ${sf_plf_CI_TARURL}
-wget ${sf_vfa_CI_TARURL}
-tar xvfz lf.tgz
-tar xvfz plf.tgz
-tar xvfz vfa.tgz
+mkdir -p ${CI_BUILD_DIR} && cd ${CI_BUILD_DIR}
+wget -qO- ${sf_lf_CI_TARURL}  | tar xvz
+wget -qO- ${sf_plf_CI_TARURL} | tar xvz
+wget -qO- ${sf_vfa_CI_TARURL} | tar xvz
 
 sed -i.bak '1i From Coq Require Extraction.' lf/Extraction.v
 sed -i.bak '1i From Coq Require Extraction.' vfa/Extract.v
 
+# Delete useless calls to try omega; unfold
+patch vfa/SearchTree.v <<EOF
+*** SearchTree.v.bak	2017-09-06 19:12:59.000000000 +0200
+--- SearchTree.v	2017-11-21 16:34:41.000000000 +0100
+***************
+*** 674,683 ****
+     forall i j : key, ~ (i > j) -> ~ (i < j) -> i=j.
+  Proof.
+  intros.
+- try omega.  (* Oops! [omega] cannot solve this one.
+-     The problem is that [i] and [j] have type [key] instead of type [nat].
+-     The solution is easy enough: *)
+- unfold key in *.
+  omega.
+
+  (** So, if you get stuck on an [omega] that ought to work,
+--- 674,679 ----
+EOF
+
 ( cd lf && make clean && make )
 
 ( cd plf && sed -i.bak 's/(K,N)/((K,N))/' LibTactics.v && make clean && make )
diff --git a/dev/ci/ci-vst.sh b/dev/ci/ci-vst.sh
index 5bfc408e9..5760fbafb 100755
--- a/dev/ci/ci-vst.sh
+++ b/dev/ci/ci-vst.sh
@@ -8,6 +8,6 @@ VST_CI_DIR=${CI_BUILD_DIR}/VST
 # opam install -j ${NJOBS} -y menhir
 git_checkout ${VST_CI_BRANCH} ${VST_CI_GITURL} ${VST_CI_DIR}
 
-# Targets are: msl veric floyd
+# Targets are: msl veric floyd progs , we remove progs to save time
 # Patch to avoid the upper version limit
-( cd ${VST_CI_DIR} && make IGNORECOQVERSION=true )
+( cd ${VST_CI_DIR} && make IGNORECOQVERSION=true .loadpath version.vo msl veric floyd )
diff --git a/dev/ci/ci-wrapper.sh b/dev/ci/ci-wrapper.sh
new file mode 100755
index 000000000..12a70176c
--- /dev/null
+++ b/dev/ci/ci-wrapper.sh
@@ -0,0 +1,27 @@
+#!/usr/bin/env bash
+
+# Use this script to preserve the exit code of $CI_SCRIPT when piping
+# it to `tee time-of-build.log`.  We have a separate script, because
+# this only works in bash, which we don't require project-wide.
+
+set -eo pipefail
+
+function travis_fold {
+    if [ -n "${TRAVIS}" ];
+    then
+	echo "travis_fold:$1:$2"
+    fi
+}
+
+CI_NAME="$1"
+CI_SCRIPT="ci-${CI_NAME}.sh"
+
+DIR="$( cd "$( dirname "${BASH_SOURCE[0]}" )" && pwd )"
+# assume this script is in dev/ci/, cd to the root Coq directory
+cd "${DIR}/../.."
+
+export TIMED=1
+"${DIR}/${CI_SCRIPT}" 2>&1 | tee time-of-build.log
+travis_fold 'start' 'coq.test.timing' && echo 'Aggregating timing log...'
+python ./tools/make-one-time-file.py time-of-build.log
+travis_fold 'end' 'coq.test.timing'
diff --git a/dev/ci/user-overlays/00669-maximedenes-ssr-merge.sh b/dev/ci/user-overlays/00669-maximedenes-ssr-merge.sh
index af4a96f4a..7716bcb59 100644
--- a/dev/ci/user-overlays/00669-maximedenes-ssr-merge.sh
+++ b/dev/ci/user-overlays/00669-maximedenes-ssr-merge.sh
@@ -1,4 +1,4 @@
-if [ "$TRAVIS_PULL_REQUEST" = "669" ] || [ "$TRAVIS_BRANCH" = "ssr-merge" ]; then
+if [ "$CI_PULL_REQUEST" = "669" ] || [ "$CI_BRANCH" = "ssr-merge" ]; then
     mathcomp_CI_BRANCH=ssr-merge
     mathcomp_CI_GITURL=https://github.com/maximedenes/math-comp.git
 fi
diff --git a/dev/ci/user-overlays/06405-maximedenes-rm-local-polymorphic-flag.sh b/dev/ci/user-overlays/06405-maximedenes-rm-local-polymorphic-flag.sh
new file mode 100644
index 000000000..c2e367038
--- /dev/null
+++ b/dev/ci/user-overlays/06405-maximedenes-rm-local-polymorphic-flag.sh
@@ -0,0 +1,4 @@
+if [ "$CI_PULL_REQUEST" = "6405" ] || [ "$CI_BRANCH" = "rm-local-polymorphic-flag" ]; then
+    Equations_CI_BRANCH=rm-local-polymorphic-flag
+    Equations_CI_GITURL=https://github.com/maximedenes/Coq-Equations
+fi
diff --git a/dev/ci/user-overlays/06482-ppedrot-check-poly-effects.sh b/dev/ci/user-overlays/06482-ppedrot-check-poly-effects.sh
new file mode 100644
index 000000000..78789a6fc
--- /dev/null
+++ b/dev/ci/user-overlays/06482-ppedrot-check-poly-effects.sh
@@ -0,0 +1,4 @@
+if [ "$TRAVIS_PULL_REQUEST" = "6483" ] || [ "$TRAVIS_BRANCH" = "check-poly-effects" ]; then
+    HoTT_CI_BRANCH=check-poly-effects
+    HoTT_CI_GITURL=https://github.com/ppedrot/HoTT.git
+fi
diff --git a/dev/ci/user-overlays/06493-gares-API-remove-big-file.sh b/dev/ci/user-overlays/06493-gares-API-remove-big-file.sh
new file mode 100644
index 000000000..9677b3525
--- /dev/null
+++ b/dev/ci/user-overlays/06493-gares-API-remove-big-file.sh
@@ -0,0 +1,8 @@
+if [ "$CI_PULL_REQUEST" = "6493" ] || [ "$CI_BRANCH" = "API/remove-big-file" ]; then
+    Equations_CI_BRANCH=API-removal
+    Equations_CI_GITURL=https://github.com/gares/Coq-Equations.git
+    coq_dpdgraph_CI_BRANCH=API-removal
+    coq_dpdgraph_CI_GITURL=https://github.com/gares/coq-dpdgraph.git
+    ltac2_CI_BRANCH=API-removal
+    ltac2_CI_GITURL=https://github.com/gares/ltac2.git
+fi
diff --git a/dev/ci/user-overlays/06535-fix-push-rel-to-named.sh b/dev/ci/user-overlays/06535-fix-push-rel-to-named.sh
new file mode 100644
index 000000000..8a50fb111
--- /dev/null
+++ b/dev/ci/user-overlays/06535-fix-push-rel-to-named.sh
@@ -0,0 +1,4 @@
+if [ "$CI_PULL_REQUEST" = "6535" ] || [ "$CI_BRANCH" = "fix-push-rel-to-named" ]; then
+    Equations_CI_BRANCH=fix-6535
+    Equations_CI_GITURL=https://github.com/ppedrot/Coq-Equations
+fi
diff --git a/dev/ci/user-overlays/06686-ccnv-no-proj.sh b/dev/ci/user-overlays/06686-ccnv-no-proj.sh
new file mode 100644
index 000000000..3a3ab44e0
--- /dev/null
+++ b/dev/ci/user-overlays/06686-ccnv-no-proj.sh
@@ -0,0 +1,4 @@
+if [ "$CI_PULL_REQUEST" = "6686" ] || [ "$CI_BRANCH" = "ccnv-no-proj" ]; then
+    Equations_CI_BRANCH=ccnv-fixes
+    Equations_CI_GITURL=https://github.com/SkySkimmer/Coq-Equations
+fi
diff --git a/dev/ci/user-overlays/06745-ejgallego-located+vernac.sh b/dev/ci/user-overlays/06745-ejgallego-located+vernac.sh
new file mode 100644
index 000000000..d1d61fec2
--- /dev/null
+++ b/dev/ci/user-overlays/06745-ejgallego-located+vernac.sh
@@ -0,0 +1,13 @@
+if [ "$CI_PULL_REQUEST" = "6745" ] || [ "$CI_BRANCH" = "located+vernac" ]; then
+    ltac2_CI_BRANCH=located+vernac
+    ltac2_CI_GITURL=https://github.com/ejgallego/ltac2
+
+    Equations_CI_BRANCH=located+vernac
+    Equations_CI_GITURL=https://github.com/ejgallego/Coq-Equations
+
+    fiat_parsers_CI_BRANCH=located+vernac
+    fiat_parsers_CI_GITURL=https://github.com/ejgallego/fiat
+
+    Elpi_CI_BRANCH=located+vernac
+    Elpi_CI_GITURL=https://github.com/ejgallego/coq-elpi.git
+fi
diff --git a/dev/ci/user-overlays/README.md b/dev/ci/user-overlays/README.md
index 9146d3d52..9f0377cee 100644
--- a/dev/ci/user-overlays/README.md
+++ b/dev/ci/user-overlays/README.md
@@ -7,8 +7,10 @@ The name of your overlay file should be of the form `five_digit_PR_number-GitHub
 Example: `00669-maximedenes-ssr-merge.sh` containing
 
 ```
-if [ "$TRAVIS_PULL_REQUEST" = "669" ] || [ "$TRAVIS_BRANCH" = "ssr-merge" ]; then
+if [ "$CI_PULL_REQUEST" = "669" ] || [ "$CI_BRANCH" = "ssr-merge" ]; then
     mathcomp_CI_BRANCH=ssr-merge
     mathcomp_CI_GITURL=https://github.com/maximedenes/math-comp.git
 fi
 ```
+
+(`CI_PULL_REQUEST` and `CI_BRANCH` are set in [`ci-common.sh`](/dev/ci/ci-common.sh))
diff --git a/dev/core.dbg b/dev/core.dbg
index 71d06cdb0..57c136900 100644
--- a/dev/core.dbg
+++ b/dev/core.dbg
@@ -1,4 +1,4 @@
-source camlp4.dbg
+source camlp5.dbg
 load_printer threads.cma
 load_printer str.cma
 load_printer clib.cma
@@ -16,7 +16,5 @@ load_printer tactics.cma
 load_printer vernac.cma
 load_printer stm.cma
 load_printer toplevel.cma
-load_printer highparsing.cma
 load_printer intf.cma
-load_printer API.cma
 load_printer ltac_plugin.cmo
diff --git a/dev/db b/dev/db
index a5518e3c4..2f8c13485 100644
--- a/dev/db
+++ b/dev/db
@@ -1,37 +1,67 @@
 source core.dbg
 load_printer top_printers.cmo
 
+install_printer Top_printers.pP
 install_printer Top_printers.ppfuture
-
 install_printer Top_printers.ppid
-install_printer Top_printers.ppidset
-install_printer Top_printers.ppevar
-install_printer Top_printers.ppevarsubst
-install_printer Top_printers.ppexistentialfilter
-install_printer Top_printers.ppexistentialset
-install_printer Top_printers.ppintset
 install_printer Top_printers.pplab
-install_printer Top_printers.ppdir
 install_printer Top_printers.ppmbid
+install_printer Top_printers.ppdir
 install_printer Top_printers.ppmp
-install_printer Top_printers.ppkn
 install_printer Top_printers.ppcon
-install_printer Top_printers.ppwf_paths
+install_printer Top_printers.ppproj
+install_printer Top_printers.ppkn
 install_printer Top_printers.ppmind
+install_printer Top_printers.ppind
 install_printer Top_printers.ppsp
 install_printer Top_printers.ppqualid
 install_printer Top_printers.ppclindex
-install_printer Top_printers.ppbigint
-install_printer Top_printers.pp_transparent_state
-
-install_printer Top_printers.pppattern
-install_printer Top_printers.ppglob_constr
-
+install_printer Top_printers.ppscheme
+install_printer Top_printers.ppwf_paths
+install_printer Top_printers.ppevar
 install_printer Top_printers.ppconstr
+install_printer Top_printers.ppsconstr
 install_printer Top_printers.ppeconstr
+install_printer Top_printers.ppconstr_expr
+install_printer Top_printers.ppglob_constr
+install_printer Top_printers.pppattern
+install_printer Top_printers.ppfconstr
+install_printer Top_printers.ppbigint
+install_printer Top_printers.ppintset
+install_printer Top_printers.ppidset
+install_printer Top_printers.ppidmapgen
+install_printer Top_printers.ppididmap
+install_printer Top_printers.ppconstrunderbindersidmap
+install_printer Top_printers.ppevarsubst
+install_printer Top_printers.ppunbound_ltac_var_map
+install_printer Top_printers.ppclosure
+install_printer Top_printers.ppclosedglobconstr
+install_printer Top_printers.ppclosedglobconstridmap
+install_printer Top_printers.ppglobal
+install_printer Top_printers.ppconst
+install_printer Top_printers.ppvar
+install_printer Top_printers.ppj
+install_printer Top_printers.ppsubst
+install_printer Top_printers.ppdelta
+install_printer Top_printers.pp_idpred
+install_printer Top_printers.pp_cpred
+install_printer Top_printers.pp_transparent_state
+install_printer Top_printers.pp_stack_t
+install_printer Top_printers.pp_cst_stack_t
+install_printer Top_printers.pp_state_t
+install_printer Top_printers.ppmetas
+install_printer Top_printers.ppevm
+install_printer Top_printers.ppexistentialset
+install_printer Top_printers.ppexistentialfilter
+install_printer Top_printers.ppclenv
+install_printer Top_printers.ppgoalgoal
+install_printer Top_printers.ppgoal
+install_printer Top_printers.pphintdb
+install_printer Top_printers.ppproofview
+install_printer Top_printers.ppopenconstr
+install_printer Top_printers.pproof
 install_printer Top_printers.ppuni
-install_printer Top_printers.ppuniverses
-install_printer Top_printers.ppconstraints
+install_printer Top_printers.ppuni_level
 install_printer Top_printers.ppuniverse_set
 install_printer Top_printers.ppuniverse_instance
 install_printer Top_printers.ppuniverse_context
@@ -40,33 +70,19 @@ install_printer Top_printers.ppuniverse_subst
 install_printer Top_printers.ppuniverse_opt_subst
 install_printer Top_printers.ppuniverse_level_subst
 install_printer Top_printers.ppevar_universe_context
+install_printer Top_printers.ppconstraints
+install_printer Top_printers.ppuniverseconstraints
+install_printer Top_printers.ppuniverse_context_future
 install_printer Top_printers.ppcumulativity_info
 install_printer Top_printers.ppabstract_cumulativity_info
-install_printer Top_printers.pptype
-install_printer Top_printers.ppj
-install_printer Top_printers.ppenv
+install_printer Top_printers.ppuniverses
 install_printer Top_printers.ppnamedcontextval
-install_printer Top_printers.pp_stack_t
-install_printer Top_printers.pp_cst_stack_t
-
-install_printer Top_printers.ppmetas
-install_printer Top_printers.ppevm
-install_printer Top_printers.ppgoalgoal
-install_printer Top_printers.ppgoal
-install_printer Top_printers.ppproofview
-install_printer Top_printers.pphintdb
-
+install_printer Top_printers.ppenv
 install_printer Top_printers.pptac
 install_printer Top_printers.ppobj
 install_printer Top_printers.pploc
-install_printer Top_printers.prsubst
-install_printer Top_printers.prdelta
-install_printer Top_printers.ppfconstr
+install_printer Top_printers.pp_argument_type
+install_printer Top_printers.pp_generic_argument
 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
-install_printer Top_printers.ppididmap
-install_printer Top_printers.ppclosure
-install_printer Top_printers.ppclosedglobconstr
diff --git a/COMPATIBILITY b/dev/doc/COMPATIBILITY
index 78dfabaa3..a81afca32 100644
--- a/COMPATIBILITY
+++ b/dev/doc/COMPATIBILITY
@@ -1,3 +1,6 @@
+Note: this file isn't used anymore. Incompatibilities are documented
+as part of CHANGES.
+
 Potential sources of incompatibilities between Coq V8.6 and V8.7
 ----------------------------------------------------------------
 
diff --git a/dev/doc/build-system.dev.txt b/dev/doc/build-system.dev.txt
index f3fc13e96..abba13428 100644
--- a/dev/doc/build-system.dev.txt
+++ b/dev/doc/build-system.dev.txt
@@ -46,7 +46,7 @@ see build-system.txt .
 .ml4 files
 ----------
 
-.ml4 are converted to .ml by camlp4. By default, they are produced
+.ml4 are converted to .ml by camlp5. By default, they are produced
 in the binary ast format understood by ocamlc/ocamlopt/ocamldep.
 Pros:
  - faster than parsing clear-text source file.
diff --git a/dev/doc/build-system.txt b/dev/doc/build-system.txt
index 873adc1b2..fd3101613 100644
--- a/dev/doc/build-system.txt
+++ b/dev/doc/build-system.txt
@@ -88,7 +88,7 @@ bootstrapped. The dependencies of a file FOO are in FOO.d . This
 enables partial recalculation of dependencies (only the dependencies
 of changed files are recomputed).
 
-If you add a dependency to a Coq camlp4 extension (grammar.cma or
+If you add a dependency to a Coq camlp5 extension (grammar.cma or
 q_constr.cmo), then see sections ".ml4 files" and "new files".
 
 Cleaning Targets
@@ -127,7 +127,7 @@ of a grammar extension via a line of the form:
 
 The use of (*i camlp4use: ... i*) to mention uses of standard
 extension such as IFDEF has also been discontinued, the Makefile now
-always calls camlp4 with pa_macros.cmo and a few others by default.
+always calls camlp5 with pa_macros.cmo and a few others by default.
 
 For debugging a Coq grammar extension, it could be interesting
 to use the READABLE_ML4=1 option, otherwise the generated .ml are
@@ -143,7 +143,9 @@ file list(s):
    These files are also used by the experimental ocamlbuild plugin,
    which is quite touchy about them : be careful with order,
    duplicated entries, whitespace errors, and do not mention .mli there.
- - For .v, in the corresponding vo.itarget (e.g theories/Init/vo.itarget)
+   If module B depends on module A, then B should be after A in the .mllib
+   file.
+- For .v, in the corresponding vo.itarget (e.g theories/Init/vo.itarget)
  - The definitions in Makefile.common might have to be adapted too.
  - If your file needs a specific rule, add it to Makefile.build
 
diff --git a/dev/doc/changes.txt b/dev/doc/changes.md
index 0f1a28028..ab78b0956 100644
--- a/dev/doc/changes.txt
+++ b/dev/doc/changes.md
@@ -1,141 +1,209 @@
-=========================================
-= CHANGES BETWEEN COQ V8.7 AND COQ V8.8 =
-=========================================
+## Changes between Coq 8.7 and Coq 8.8
 
-* ML API *
+### Bug tracker
+
+As of 18/10/2017, Coq uses [GitHub issues](https://github.com/coq/coq/issues)
+as bug tracker.
+Old bug reports were migrated from Bugzilla to GitHub issues using
+[this migration script](https://gist.github.com/Zimmi48/d923e52f64fe17c72852d9c148bfcdc6#file-bugzilla2github)
+as detailed in [this blog post](https://www.theozimmermann.net/2017/10/bugzilla-to-github/).
+
+All the bugs with a number below 1154 had to be renumbered, you can find
+a correspondence table [here](/dev/bugzilla2github_stripped.csv).
+All the other bugs kept their number.
+
+### ML API
+
+General deprecation
+
+- All functions marked [@@ocaml.deprecated] in 8.7 have been
+  removed. Please, make sure your plugin is warning-free in 8.7 before
+  trying to port it over 8.8.
+
+Proof engine
+
+  Due to the introduction of `EConstr` in 8.7, it is not necessary to
+  track "goal evar normal form status" anymore, thus the type `'a
+  Proofview.Goal.t` loses its ghost argument. This may introduce some
+  minor incompatibilities at the typing level. Code-wise, things
+  should remain the same.
 
 We removed the following functions:
 
-- Universes.unsafe_constr_of_global: use Global.constr_of_global_in_context
+- `Universes.unsafe_constr_of_global`: use `Global.constr_of_global_in_context`
   instead. The returned term contains De Bruijn universe variables. If you don't
   depend on universes being instantiated, simply drop the context.
-- Universes.unsafe_type_of_global: same as above with
-  Global.type_of_global_in_context
+
+- `Universes.unsafe_type_of_global`: same as above with
+  `Global.type_of_global_in_context`
 
 We changed the type of the following functions:
 
-- Global.body_of_constant_body: now also returns the abstract universe context.
+- `Global.body_of_constant_body`: now also returns the abstract universe context.
   The returned term contains De Bruijn universe variables.
-- Global.body_of_constant: same as above.
 
-We renamed the following datatypes:
+- `Global.body_of_constant`: same as above.
 
-  Pp.std_ppcmds -> Pp.t
+- `Constrinterp.*` generally, many functions that used to take an
+  `evar_map ref` have been now switched to functions that will work in
+  a functional way. The old style of passing `evar_map`s as references
+  is not supported anymore.
 
-=========================================
-= CHANGES BETWEEN COQ V8.6 AND COQ V8.7 =
-=========================================
+Changes in the abstract syntax tree:
 
-* Ocaml *
+- The practical totality of the AST has been nodified using
+  `CAst.t`. This means that all objects coming from parsing will be
+  indeed wrapped in a `CAst.t`. `Loc.located` is on its way to
+  deprecation. Some minor interfaces changes have resulted from
+  this.
 
-Coq is compiled with -safe-string enabled and requires plugins to do
-the same. This means that code using `String` in an imperative way
-will fail to compile now. They should switch to `Bytes.t`
+We have changed the representation of the following types:
+
+- `Lib.object_prefix` is now a record instead of a nested tuple.
+
+Some tactics and related functions now support static configurability, e.g.:
+
+- injectable, dEq, etc. takes an argument ~keep_proofs which,
+  - if None, tells to behave as told with the flag Keep Proof Equalities
+  - if Some b, tells to keep proof equalities iff b is true
+
+Declaration of printers for arguments used only in vernac command
 
-* Plugin API *
+- It should now use "declare_extra_vernac_genarg_pprule" rather than
+  "declare_extra_genarg_pprule", otherwise, a failure at runtime might
+  happen. An alternative is to register the corresponding argument as
+  a value, using "Geninterp.register_val0 wit None".
 
-Coq 8.7 offers a new module overlay containing a proposed plugin API
-in `API/API.ml`; this overlay is enabled by adding the `-open API`
-flag to the OCaml compiler; this happens automatically for
-developments in the `plugin` folder and `coq_makefile`.
+### STM API
 
-However, `coq_makefile` can be instructed not to enable this flag by
-passing `-bypass-API`.
+The STM API has seen a general overhaul. The main change is the
+introduction of a "Coq document" type, which all operations now take
+as a parameter. This effectively functionalize the STM API and will
+allow in the future to handle several documents simultaneously.
 
-* ML API *
+The main remarkable point is that key implicit global parameters such
+as load-paths and required modules are now arguments to the document
+creation function. This helps enforcing some key invariants.
 
-Added two functions for declaring hooks to be executed in reduction
+### XML IDE Protocol
+
+- Before 8.8, `Query` only executed the first command present in the
+ `query` string; starting with 8.8, the caller may include several
+ statements. This is useful for instance for temporarily setting an
+ option and then executing a command.
+
+## Changes between Coq 8.6 and Coq 8.7
+
+### Ocaml
+
+Coq is compiled with `-safe-string` enabled and requires plugins to do
+the same. This means that code using `String` in an imperative way
+will fail to compile now. They should switch to `Bytes.t`
+
+Configure supports passing flambda options, use `-flambda-opts OPTS`
+with a flambda-enabled Ocaml to tweak the compilation to your taste.
+
+### ML API
+
+- Added two functions for declaring hooks to be executed in reduction
 functions when some given constants are traversed:
 
-  declare_reduction_effect: to declare a hook to be applied when some
+  * `declare_reduction_effect`: to declare a hook to be applied when some
   constant are visited during the execution of some reduction functions
   (primarily cbv).
 
-  set_reduction_effect: to declare a constant on which a given effect
+  * `set_reduction_effect`: to declare a constant on which a given effect
   hook should be called.
 
-We renamed the following functions:
+- 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:
+- 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
+  * `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:
+- We renamed the following modules:
 
-  Context.ListNamed -> Context.Compacted
+  * `Context.ListNamed` -> `Context.Compacted`
 
-The following type aliases where removed
+- The following type aliases where removed
 
-  Context.section_context    ... it was just an alias for "Context.Named.t" which is still available
+  * `Context.section_context`: it was just an alias for `Context.Named.t` which is still available.
 
-The module Constrarg was merged into Stdarg.
+- The module `Constrarg` was merged into `Stdarg`.
 
-The following types have been moved and modified:
+- The following types have been moved and modified:
 
-  local_binder -> local_binder_expr
-  glob_binder merged with glob_decl
+  * `local_binder` -> `local_binder_expr`
+  * `glob_binder` merged with `glob_decl`
 
-The following constructors have been renamed:
+- The following constructors have been renamed:
 
+  ```
   LocalRawDef -> CLocalDef
   LocalRawAssum -> CLocalAssum
   LocalPattern -> CLocalPattern
+  ```
 
-In Constrexpr_ops:
+- In `Constrexpr_ops`:
 
-  Deprecating abstract_constr_expr in favor of mkCLambdaN, and
-  prod_constr_expr in favor of mkCProdN. Note: the first ones were
-  interpreting "(x y z:_)" as "(x:_) (y:_) (z:_)" while the second
+  Deprecating `abstract_constr_expr` in favor of `mkCLambdaN`, and
+  `prod_constr_expr` in favor of `mkCProdN`. Note: the first ones were
+  interpreting `(x y z:_)` as `(x:_) (y:_) (z:_)` while the second
   ones were preserving the original sharing of the type.
 
-In Nameops:
+- In `Nameops`:
 
   The API has been made more uniform. New combinators added in the
-  "Name" space name. Function "out_name" now fails with IsAnonymous
-  rather than with Failure "Nameops.out_name".
+  `Name` space name. Function `out_name` now fails with `IsAnonymous`
+  rather than with `Failure "Nameops.out_name"`.
 
-Location handling and AST attributes:
+- Location handling and AST attributes:
 
-  Location handling has been reworked. First, Loc.ghost has been
+  Location handling has been reworked. First, `Loc.ghost` has been
   removed in favor of an option type, all objects carrying an optional
   source code location have been switched to use `Loc.t option`.
 
   Storage of location information has been also refactored. The main
-  datatypes representing Coq AST (constrexpr, glob_expr) have been
+  datatypes representing Coq AST (`constrexpr`, `glob_expr`) have been
   switched to a generic "node with attributes" representation `'a
   CAst.ast`, which is a record of the form:
 
-```ocaml
-type 'a ast = private {
-  v   : 'a;
-  loc : Loc.t option;
-  ...
-}
-```
+  ```ocaml
+  type 'a ast = private {
+    v   : 'a;
+    loc : Loc.t option;
+    ...
+  }
+  ```
   consumers of AST nodes are recommended to use accessor-based pattern
   matching `{ v; loc }` to destruct `ast` object. Creation is done
   with `CAst.make ?loc obj`, where the attributes are optional. Some
   convenient combinators are provided in the module. A typical match:
-```
-| CCase(loc, a1) -> CCase(loc, f a1)
-```
+
+  ```ocaml
+  | CCase(loc, a1) -> CCase(loc, f a1)
+  ```
+
   is now done as:
-```
-| { v = CCase(a1); loc } -> CAst.make ?loc @@ CCase(f a1)
-```
+  ```ocaml
+  | { v = CCase(a1); loc } -> CAst.make ?loc @@ CCase(f a1)
+
+  ```
   or even better, if plan to preserve the attributes you can wrap your
   top-level function in `CAst.map` to have:
 
-```
-| CCase(a1) -> CCase(f a1)
-```
+  ```ocaml
+  | CCase(a1) -> CCase(f a1)
+  ```
 
   This scheme based on records enables easy extensibility of the AST
   node type without breaking compatibility.
@@ -151,14 +219,14 @@ type 'a ast = private {
   implemented in the whole code base. Matching a located object hasn't
   changed, however, `Loc.tag ?loc obj` must be used to build one.
 
-In GOption:
+- In `GOption`:
 
   Support for non-synchronous options has been removed. Now all
   options are handled as a piece of normal document state, and thus
   passed to workers, etc... As a consequence, the field
   `Goptions.optsync` has been removed.
 
-In Coqlib / reference location:
+- In `Coqlib` / reference location:
 
   We have removed from Coqlib functions returning `constr` from
   names. Now it is only possible to obtain references, that must be
@@ -175,65 +243,67 @@ In Coqlib / reference location:
   `pf_constr_of_global` in tactics and `Evarutil.new_global` variants
   when constructing terms in ML (see univpoly.txt for more information).
 
-** Tactic API **
+### Tactic API
 
-- pf_constr_of_global now returns a tactic instead of taking a continuation.
+- `pf_constr_of_global` now returns a tactic instead of taking a continuation.
   Thus it only generates one instance of the global reference, and it is the
   caller's responsibility to perform a focus on the goal.
 
-- pf_global, construct_reference, global_reference,
-  global_reference_in_absolute_module now return a global_reference
-  instead of a constr.
+- `pf_global`, `construct_reference`, `global_reference`,
+  `global_reference_in_absolute_module` now return a `global_reference`
+  instead of a `constr`.
 
-- The tclWEAK_PROGRESS and tclNOTSAMEGOAL tacticals were removed. Their usecase
-  was very specific. Use tclPROGRESS instead.
+- The `tclWEAK_PROGRESS` and `tclNOTSAMEGOAL` tacticals were removed. Their usecase
+  was very specific. Use `tclPROGRESS` instead.
 
 - New (internal) tactical `tclINDEPENDENTL` that combined with enter_one allows
   to iterate a non-unit tactic on all goals and access their returned values.
 
-- The unsafe flag of the Refine.refine function and its variants has been
+- The unsafe flag of the `Refine.refine` function and its variants has been
   renamed and dualized into typecheck and has been made mandatory.
 
-** Ltac API **
+### 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
+- `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
-- The TacFun tactic expression constructor now takes a `Name.t list` for the 
+- Some printing functions were moved from `Pptactic` to `Pputils`
+- A part of `Tacexpr` has been moved to `Tactypes`
+- The `TacFun` tactic expression constructor now takes a `Name.t list` for the
   variable list rather than an `Id.t option list`.
 
 The folder itself has been turned into a plugin. This does not change much,
 but because it is a packed plugin, it may wreak havoc for third-party plugins
-depending on any module defined in the ltac/ directory. Namely, even if
+depending on any module defined in the `ltac/` directory. Namely, even if
 everything looks OK at compile time, a plugin can fail to load at link time
-because it mistakenly looks for a module Foo instead of Ltac_plugin.Foo, with
+because it mistakenly looks for a module `Foo` instead of `Ltac_plugin.Foo`, with
 an error of the form:
 
+```
 Error: while loading myplugin.cmxs, no implementation available for Foo.
+```
 
-In particular, most EXTEND macros will trigger this problem even if they
+In particular, most `EXTEND` macros will trigger this problem even if they
 seemingly do not use any Ltac module, as their expansion do.
 
-The solution is simple, and consists in adding a statement "open Ltac_plugin"
+The solution is simple, and consists in adding a statement `open Ltac_plugin`
 in each file using a Ltac module, before such a module is actually called. An
 alternative solution would be to fully qualify Ltac modules, e.g. turning any
-call to Tacinterp into Ltac_plugin.Tacinterp. Note that this solution does not
-work for EXTEND macros though.
+call to Tacinterp into `Ltac_plugin.Tacinterp`. Note that this solution does not
+work for `EXTEND` macros though.
 
-** Additional changes in tactic extensions **
+### Additional changes in tactic extensions
 
-Entry "constr_with_bindings" has been renamed into
-"open_constr_with_bindings". New entry "constr_with_bindings" now
+Entry `constr_with_bindings` has been renamed into
+`open_constr_with_bindings`. New entry `constr_with_bindings` now
 uses type classes and rejects terms with unresolved holes.
 
-** Error handling **
+### 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
@@ -243,14 +313,14 @@ uses type classes and rejects terms with unresolved holes.
 
 - The header parameter to `user_err` has been made optional.
 
-** Pretty printing **
+### Pretty printing
 
 Some functions have been removed, see pretty printing below for more
 details.
 
-* Pretty Printing and XML protocol *
+#### Pretty Printing and XML protocol
 
-The type std_cmdpps has been reworked and made the canonical "Coq rich
+The type `std_cmdpps` has been reworked and made the canonical "Coq rich
 document type". This allows for a more uniform handling of printing
 (specially in IDEs). The main consequences are:
 
@@ -267,12 +337,13 @@ document type". This allows for a more uniform handling of printing
  - `Pp_control` has removed. The new module `Topfmt` implements
    console control for the toplevel.
 
- - The impure tag system in Pp has been removed. This also does away
+ - The impure tag system in `Pp` has been removed. This also does away
    with the printer signatures and functors. Now printers tag
    unconditionally.
 
  - The following functions have been removed from `Pp`:
 
+   ```ocaml
    val stras : int * string -> std_ppcmds
    val tbrk  : int * int -> std_ppcmds
    val tab   : unit -> std_ppcmds
@@ -294,8 +365,9 @@ document type". This allows for a more uniform handling of printing
    val msg_with  : ...
 
    module Tag
+   ```
 
-** Stm API **
+### Stm API
 
 - We have streamlined the `Stm` API, now `add` and `query` take a
   `coq_parsable` instead a `string` so clients can have more control
@@ -312,7 +384,7 @@ document type". This allows for a more uniform handling of printing
 
 - A few unused hooks were removed due to cleanups, no clients known.
 
-** Toplevel and Vernacular API **
+### Toplevel and Vernacular API
 
 - The components related to vernacular interpretation have been moved
   to their own folder `vernac/` whereas toplevel now contains the
@@ -321,39 +393,41 @@ document type". This allows for a more uniform handling of printing
 - Coq's toplevel has been ported to directly use the common `Stm`
   API. The signature of a few functions has changed as a result.
 
-** XML Protocol **
+### XML Protocol
 
 - The legacy `Interp` call has been turned into a noop.
 
 - The `query` call has been modified, now it carries a mandatory
-  "route_id" integer parameter, that associated the result of such
+  `route_id` integer parameter, that associated the result of such
   query with its generated feedback.
 
-=========================================
-= CHANGES BETWEEN COQ V8.5 AND COQ V8.6 =
-=========================================
+## Changes between Coq 8.5 and Coq 8.6
 
-** Parsing **
+### Parsing
 
-Pcoq.parsable now takes an extra optional filename argument so as to
+`Pcoq.parsable` now takes an extra optional filename argument so as to
 bind locations to a file name when relevant.
 
-** Files **
+### 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/
+All IDE-specific files, including the XML protocol have been moved to `ide/`
 
-** Reduction functions **
+### Reduction functions
 
-In closure.ml, we introduced the more precise reduction flags fMATCH, fFIX,
-fCOFIX.
+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
@@ -380,9 +454,11 @@ 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
@@ -392,15 +468,16 @@ 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.
+In `intf/genredexpr.mli`, `fIota` was replaced by `FMatch`, `FFix` and
+`FCofix`. Similarly, `rIota` was replaced by `rMatch`, `rFix` and `rCofix`.
 
-** Notation_ops **
+### Notation_ops
 
-Use Glob_ops.glob_constr_eq instead of Notation_ops.eq_glob_constr.
+Use `Glob_ops.glob_constr_eq` instead of `Notation_ops.eq_glob_constr`.
 
-** Logging and Pretty Printing: **
+### Logging and Pretty Printing
 
 * Printing functions have been removed from `Pp.mli`, which is now a
   purely pretty-printing interface. Functions affected are:
@@ -429,7 +506,7 @@ val message     : string -> unit
 
 * 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:
+  level. Functions moved from `Pp` to `Feedback` are:
 
 ```` ocaml
 val set_logger      : logger -> unit
@@ -474,12 +551,13 @@ 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 **
+### Kernel API changes
 
-- The interface of the Context module was changed.
+- 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:
 
+    ```
     Context.named_declaration            --->  Context.Named.Declaration.t
     Context.named_list_declaration       --->  Context.NamedList.Declaration.t
     Context.rel_declaration              --->  Context.Rel.Declaration.t
@@ -521,123 +599,148 @@ val get_id_for_feedback : unit -> edit_or_state_id * route_id
     Context.rel_context_length           --->  Context.Rel.length
     Context.rel_context_nhyps            --->  Context.Rel.nhyps
     Context.rel_context_tags             --->  Context.Rel.to_tags
+    ```
 
 - Originally, rel-context was represented as:
 
-    Context.rel_context = Names.Name.t * Constr.t option * Constr.t
+    ```ocaml
+    type Context.rel_context = Names.Name.t * Constr.t option * Constr.t
+    ```
 
   Now it is represented as:
 
-    Context.Rel.Declaration.t = LocalAssum of Names.Name.t * Constr.t
-	                      | LocalDef of Names.Name.t * Constr.t * Constr.t
- 
+    ```ocaml
+    type 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:
 
-    Context.named_context = Names.Id.t * Constr.t option * Constr.t
+    ```ocaml
+    type Context.named_context = Names.Id.t * Constr.t option * Constr.t
+    ```
 
   Now it is represented as:
 
-    Context.Named.Declaration.t = LocalAssum of Names.Id.t * Constr.t
-	                        | LocalDef of Names.Id.t * Constr.t * Constr.t
+    ```ocaml
+    type 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
+- 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
-  of the ML code. The parsing rules (VERNAC) ARGUMENT EXTEND will look for
-  variables "$name" of type Gram.entry, while the parsing rules of
-  (VERNAC COMMAND | TACTIC) EXTEND, as well as the various TYPED AS clauses will
-  look for variables "wit_$name" of type Genarg.genarg_type. The small DSL
+  of the ML code. The parsing rules (`VERNAC`) `ARGUMENT EXTEND` will look for
+  variables `$name` of type `Gram.entry`, while the parsing rules of
+  (`VERNAC COMMAND` | `TACTIC`) `EXTEND`, as well as the various `TYPED AS` clauses will
+  look for variables `wit_$name` of type `Genarg.genarg_type`. The small DSL
   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
+  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.
+  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.
+- `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.
+- The `Refine` module was moved out of `Proofview`.
 
+    ```
     Proofview.Refine.* --->  Refine.*
+    ```
 
-- A statically monotonous evarmap type was introduced in Sigma. Not all the API
+- A statically monotonic 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
+  `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:
 
+  ```ocaml
   let (sigma, x1) = ... in
   ...
   let (sigma, xn) = ... in
   (sigma, ans)
+  ```
 
   should be turned into:
 
+  ```ocaml
   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
+- The `Proofview.Goal.`*`enter` family of functions now takes a polymorphic
   continuation given as a record as an argument.
 
+  ```ocaml
   Proofview.Goal.enter begin fun gl -> ... end
+  ```
 
   should be turned into
 
+  ```ocaml
   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`)
+- `Global.named_context`                                         ---> `Global.named_context_val`
+- `Context.Named.lookup`                                         ---> `Environ.lookup_named_val`
 
-** Search API **
+### 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 =
-=========================================
+### XML Protocol
 
-** Refactoring : more mli interfaces and simpler grammar.cma **
+- In several places, flat text wrapped in `<string>` tags now appears as structured text inside `<richpp>` tags.
+
+- The "errormsg" feedback has been replaced by a "message" feedback which contains `<feedback\_content>` tag, with a message_level attribute of "error".
+
+## Changes between Coq 8.4 and Coq 8.5
+
+### Refactoring : more mli interfaces and simpler grammar.cma
 
 - A new directory intf/ now contains mli-only interfaces :
 
- Constrexpr : definition of constr_expr, was in Topconstr
- Decl_kinds : now contains binding_kind = Explicit | Implicit
- Evar_kinds : type Evar_kinds.t was previously Evd.hole_kind
- Extend : was parsing/extend.mli
- Genredexpr : regroup Glob_term.red_expr_gen and Tacexpr.glob_red_flag
- Glob_term  : definition of glob_constr
- Locus : definition of occurrences and stuff about clauses
- Misctypes : intro_pattern_expr, glob_sort, cast_type, or_var, ...
- Notation_term : contains notation_constr, was Topconstr.aconstr
- Pattern : contains constr_pattern
- Tacexpr : was tactics/tacexpr.ml
- Vernacexpr : was toplevel/vernacexpr.ml
+  * `Constrexpr` : definition of `constr_expr`, was in `Topconstr`
+  * `Decl_kinds` : now contains `binding_kind = Explicit | Implicit`
+  * `Evar_kinds` : type `Evar_kinds.t` was previously `Evd.hole_kind`
+  * `Extend` : was `parsing/extend.mli`
+  * `Genredexpr` : regroup `Glob_term.red_expr_gen` and `Tacexpr.glob_red_flag`
+  * `Glob_term`  : definition of `glob_constr`
+  * `Locus` : definition of occurrences and stuff about clauses
+  * `Misctypes` : `intro_pattern_expr`, `glob_sort`, `cast_type`, `or_var`, ...
+  * `Notation_term` : contains `notation_constr`, was `Topconstr.aconstr`
+  * `Pattern` : contains `constr_pattern`
+  * `Tacexpr` : was `tactics/tacexpr.ml`
+  * `Vernacexpr` : was `toplevel/vernacexpr.ml`
 
 - Many files have been divided :
 
- vernacexpr: vernacexpr.mli + Locality
- decl_kinds: decl_kinds.mli + Kindops
- evd: evar_kinds.mli + evd
- tacexpr: tacexpr.mli + tacops
- glob_term: glob_term.mli + glob_ops + genredexpr.mli + redops
- topconstr: constrexpr.mli + constrexpr_ops
-            + notation_expr.mli + notation_ops + topconstr
- pattern: pattern.mli + patternops
- libnames: libnames (qualid, reference) + globnames (global_reference)
- egrammar: egramml + egramcoq
+  * vernacexpr: vernacexpr.mli + Locality
+  * decl_kinds: decl_kinds.mli + Kindops
+  * evd: evar_kinds.mli + evd
+  * tacexpr: tacexpr.mli + tacops
+  * glob_term: glob_term.mli + glob_ops + genredexpr.mli + redops
+  * topconstr: constrexpr.mli + constrexpr_ops
+              + notation_expr.mli + notation_ops + topconstr
+  * pattern: pattern.mli + patternops
+  * libnames: libnames (qualid, reference) + globnames (global_reference)
+  * egrammar: egramml + egramcoq
 
 - New utility files : miscops (cf. misctypes.mli) and
   redops (cf genredexpr.mli).
@@ -686,11 +789,11 @@ printing.
   letin_pat_tac do not accept a type anymore
 
 - New file find_subterm.ml for gathering former functions
-  subst_closed_term_occ_modulo, subst_closed_term_occ_decl (which now
-  take and outputs also an evar_map), and
-  subst_closed_term_occ_modulo, subst_closed_term_occ_decl_modulo (now
-  renamed into replace_term_occ_modulo and
-  replace_term_occ_decl_modulo).
+  `subst_closed_term_occ_modulo`, `subst_closed_term_occ_decl` (which now
+  take and outputs also an `evar_map`), and
+  `subst_closed_term_occ_modulo`, `subst_closed_term_occ_decl_modulo` (now
+  renamed into `replace_term_occ_modulo` and
+  `replace_term_occ_decl_modulo`).
 
 - API of Inductiveops made more uniform (see commit log or file itself).
 
@@ -704,36 +807,34 @@ printing.
 - All functions taking an env and a sigma (or an evdref) now takes the
   env first.
 
-=========================================
-= CHANGES BETWEEN COQ V8.3 AND COQ V8.4 =
-=========================================
+## Changes between Coq 8.3 and Coq 8.4
 
-** Functions in unification.ml have now the evar_map coming just after the env
+- Functions in unification.ml have now the evar_map coming just after the env
 
-** Removal of Tacinterp.constr_of_id **
+- Removal of Tacinterp.constr_of_id
 
 Use instead either global_reference or construct_reference in constrintern.ml.
 
-** Optimizing calls to Evd functions **
+- Optimizing calls to Evd functions
 
 Evars are split into defined evars and undefined evars; for
 efficiency, when an evar is known to be undefined, it is preferable to
 use specific functions about undefined evars since these ones are
 generally fewer than the defined ones.
 
-** Type changes in TACTIC EXTEND rules **
+- Type changes in TACTIC EXTEND rules
 
 Arguments bound with tactic(_) in TACTIC EXTEND rules are now of type
 glob_tactic_expr, instead of glob_tactic_expr * tactic. Only the first
 component is kept, the second one can be obtained via
 Tacinterp.eval_tactic.
 
-** ARGUMENT EXTEND **
+- ARGUMENT EXTEND
 
 It is now forbidden to use TYPED simultaneously with {RAW,GLOB}_TYPED
 in ARGUMENT EXTEND statements.
 
-** Renaming of rawconstr to glob_constr **
+- Renaming of rawconstr to glob_constr
 
 The "rawconstr" type has been renamed to "glob_constr" for
 consistency. The "raw" in everything related to former rawconstr has
@@ -743,62 +844,67 @@ scripts to migrate code using Coq's internals, see commits 13743,
 2010) in Subversion repository. Contribs have been fixed too, and
 commit messages there might also be helpful for migrating.
 
-=========================================
-= CHANGES BETWEEN COQ V8.2 AND COQ V8.3 =
-=========================================
+## Changes between Coq 8.2 and Coq 8.3
 
-** Light cleaning in evarutil.ml **
+### Light cleaning in evaruil.ml
 
 whd_castappevar is now whd_head_evar
 obsolete whd_ise disappears
 
-** Restructuration of the syntax of binders **
+### Restructuration of the syntax of binders
 
+```
 binders_let -> binders
 binders_let_fixannot -> binders_fixannot
 binder_let -> closed_binder (and now covers only bracketed binders)
 binder was already obsolete and has been removed
+```
 
-** Semantical change of h_induction_destruct **
+### Semantical change of h_induction_destruct
 
 Warning, the order of the isrec and evar_flag was inconsistent and has
 been permuted. Tactic induction_destruct in tactics.ml is unchanged.
 
-** Internal tactics renamed
+### Internal tactics renamed
 
 There is no more difference between bindings and ebindings. The
 following tactics are therefore renamed
 
+```
 apply_with_ebindings_gen -> apply_with_bindings_gen
 left_with_ebindings -> left_with_bindings
 right_with_ebindings -> right_with_bindings
 split_with_ebindings -> split_with_bindings
+```
 
 and the following tactics are removed
 
-apply_with_ebindings (use instead apply_with_bindings)
-eapply_with_ebindings (use instead eapply_with_bindings)
+ - apply_with_ebindings (use instead apply_with_bindings)
+ - eapply_with_ebindings (use instead eapply_with_bindings)
 
-** Obsolete functions in typing.ml
+### Obsolete functions in typing.ml
 
 For mtype_of, msort_of, mcheck, now use type_of, sort_of, check
 
-** Renaming functions renamed
+### Renaming functions renamed
 
+```
 concrete_name -> compute_displayed_name_in
 concrete_let_name -> compute_displayed_let_name_in
 rename_rename_bound_var -> rename_bound_vars_as_displayed
 lookup_name_as_renamed -> lookup_name_as_displayed
 next_global_ident_away true -> next_ident_away_in_goal
 next_global_ident_away false -> next_global_ident_away
+```
 
-** Cleaning in commmand.ml
+### Cleaning in commmand.ml
 
 Functions about starting/ending a lemma are in lemmas.ml
 Functions about inductive schemes are in indschemes.ml
 
 Functions renamed:
 
+```
 declare_one_assumption -> declare_assumption
 declare_assumption -> declare_assumptions
 Command.syntax_definition -> Metasyntax.add_syntactic_definition
@@ -815,15 +921,17 @@ instantiate_type_indrec_scheme -> weaken_sort_scheme
 instantiate_indrec_scheme -> modify_sort_scheme
 make_case_dep, make_case_nodep -> build_case_analysis_scheme
 make_case_gen -> build_case_analysis_scheme_default
+```
 
 Types:
 
 decl_notation -> decl_notation option
 
-** Cleaning in libnames/nametab interfaces
+### Cleaning in libnames/nametab interfaces
 
 Functions:
 
+```
 dirpath_prefix -> pop_dirpath
 extract_dirpath_prefix pop_dirpath_n
 extend_dirpath -> add_dirpath_suffix
@@ -837,17 +945,19 @@ absolute_reference -> global_of_path
 locate_syntactic_definition -> locate_syndef
 path_of_syntactic_definition -> path_of_syndef
 push_syntactic_definition -> push_syndef
+```
 
 Types:
 
 section_path -> full_path
 
-** Cleaning in parsing extensions (commit 12108)
+### Cleaning in parsing extensions (commit 12108)
 
 Many moves and renamings, one new file (Extrawit, that contains wit_tactic).
 
-** Cleaning in tactical.mli
+### Cleaning in tactical.mli
 
+```
 tclLAST_HYP -> onLastHyp
 tclLAST_DECL -> onLastDecl
 tclLAST_NHYPS -> onNLastHypsId
@@ -857,24 +967,21 @@ onLastHyp -> onLastHypId
 onNLastHyps -> onNLastDecls
 onClauses -> onClause
 allClauses -> allHypsAndConcl
+```
 
-+ removal of various unused combinators on type "clause"
-
-=========================================
-= CHANGES BETWEEN COQ V8.1 AND COQ V8.2 =
-=========================================
+and removal of various unused combinators on type "clause"
 
-A few differences in Coq ML interfaces between Coq V8.1 and V8.2
-================================================================
+## Changes between Coq 8.1 and Coq 8.2
 
-** Datatypes
+### Datatypes
 
 List of occurrences moved from "int list" to "Termops.occurrences" (an
   alias to "bool * int list")
 ETIdent renamed to ETName
 
-** Functions
+### Functions
 
+```
 Eauto: e_resolve_constr, vernac_e_resolve_constr -> simplest_eapply
 Tactics: apply_with_bindings -> apply_with_bindings_wo_evars
 Eauto.simplest_apply -> Hiddentac.h_simplest_apply
@@ -884,98 +991,93 @@ Tactics.true_cut renamed into Tactics.assert_tac
 Constrintern.interp_constrpattern -> intern_constr_pattern
 Hipattern.match_with_conjunction is a bit more restrictive
 Hipattern.match_with_disjunction is a bit more restrictive
+```
 
-** Universe names (univ.mli)
+### Universe names (univ.mli)
 
+ ```ocaml
  base_univ -> type0_univ  (* alias of Set is the Type hierarchy *)
  prop_univ -> type1_univ  (* the type of Set in the Type hierarchy *)
  neutral_univ -> lower_univ (* semantic alias of Prop in the Type hierarchy *)
  is_base_univ -> is_type1_univ
  is_empty_univ -> is_lower_univ
+ ```
 
-** Sort names (term.mli)
+### Sort names (term.mli)
 
+  ```
   mk_Set -> set_sort
   mk_Prop -> prop_sort
   type_0 -> type1_sort
-
-=========================================
-= CHANGES BETWEEN COQ V8.0 AND COQ V8.1 =
-=========================================
-
-A few differences in Coq ML interfaces between Coq V8.0 and V8.1
-================================================================
-
-** Functions
-
-Util: option_app -> option_map
-Term: substl_decl -> subst_named_decl
-Lib: library_part -> remove_section_part
-Printer: prterm -> pr_lconstr
-Printer: prterm_env -> pr_lconstr_env
-Ppconstr: pr_sort -> pr_rawsort
-Evd: in_dom, etc got standard ocaml names (i.e. mem, etc)
-Pretyping: 
- - understand_gen_tcc and understand_gen_ltac merged into understand_ltac
- - type_constraints can now say typed by a sort (use OfType to get the
-   previous behavior)
-Library: import_library -> import_module
-
-** Constructors
-
-Declarations: mind_consnrealargs -> mind_consnrealdecls
-NoRedun -> NoDup
-Cast and RCast have an extra argument: you can recover the previous
+  ```
+
+## Changes between Coq 8.0 and Coq 8.1
+
+### Functions
+
+- Util: option_app -> option_map
+- Term: substl_decl -> subst_named_decl
+- Lib: library_part -> remove_section_part
+- Printer: prterm -> pr_lconstr
+- Printer: prterm_env -> pr_lconstr_env
+- Ppconstr: pr_sort -> pr_rawsort
+- Evd: in_dom, etc got standard ocaml names (i.e. mem, etc)
+- Pretyping:
+   - understand_gen_tcc and understand_gen_ltac merged into understand_ltac
+   - type_constraints can now say typed by a sort (use OfType to get the
+     previous behavior)
+- Library: import_library -> import_module
+
+### Constructors
+
+ * Declarations: mind_consnrealargs -> mind_consnrealdecls
+ * NoRedun -> NoDup
+ * Cast and RCast have an extra argument: you can recover the previous
   behavior by setting the extra argument to "CastConv DEFAULTcast" and
   "DEFAULTcast" respectively
-Names: "kernel_name" is now "constant" when argument of Term.Const
-Tacexpr: TacTrueCut and TacForward(false,_,_) merged into new TacAssert
-Tacexpr: TacForward(true,_,_) branched to TacLetTac
+ * Names: "kernel_name" is now "constant" when argument of Term.Const
+ * Tacexpr: TacTrueCut and TacForward(false,_,_) merged into new TacAssert
+ * Tacexpr: TacForward(true,_,_) branched to TacLetTac
 
-** Modules
+### Modules
 
-module Decl_kinds: new interface
-module Bigint: new interface
-module Tacred spawned module Redexpr
-module Symbols -> Notation
-module Coqast, Ast, Esyntax, Termast, and all other modules related to old
-  syntax are removed
-module Instantiate: integrated to Evd
-module Pretyping now a functor: use Pretyping.Default instead
+ * module Decl_kinds: new interface
+ * module Bigint: new interface
+ * module Tacred spawned module Redexpr
+ * module Symbols -> Notation
+ * module Coqast, Ast, Esyntax, Termast, and all other modules related to old
+   syntax are removed
+ * module Instantiate: integrated to Evd
+ * module Pretyping now a functor: use Pretyping.Default instead
 
-** Internal names
+### Internal names
 
 OBJDEF and OBJDEF1 -> CANONICAL-STRUCTURE
 
-** Tactic extensions
+### Tactic extensions
 
-- printers have an extra parameter which is a constr printer at high precedence
-- the tactic printers have an extra arg which is the expected precedence 
-- level is now a precedence in declare_extra_tactic_pprule
-- "interp" functions now of types the actual arg type, not its encapsulation
-  as a generic_argument
+ * printers have an extra parameter which is a constr printer at high precedence
+ *  the tactic printers have an extra arg which is the expected precedence
+ *  level is now a precedence in declare_extra_tactic_pprule
+ * "interp" functions now of types the actual arg type, not its encapsulation
+    as a generic_argument
 
-=========================================
-= CHANGES BETWEEN COQ V7.4 AND COQ V8.0 =
-=========================================
+## Changes between Coq 7.4 and Coq 8.0
 
 See files in dev/syntax-v8
 
 
-==============================================
-= MAIN CHANGES BETWEEN COQ V7.3 AND COQ V7.4 =
-==============================================
+## Main changes between Coq 7.4 and Coq 8.0
 
-CHANGES DUE TO INTRODUCTION OF MODULES
-======================================
+### Changes due to introduction of modules
 
-1.Kernel
---------
+#### Kernel
 
   The module level has no effect on constr except for the structure of
 section_path. The type of unique names for constructions (what
 section_path served) is now called a kernel name and is defined by
  
+```ocaml
 type uniq_ident = int * string * dir_path (* int may be enough *)
 type module_path =
   | MPfile of dir_path    (* reference to physical module, e.g. file *)
@@ -1002,7 +1104,8 @@ type kernel_name = module_path * dir_path * label
          Def u = ...
        end
        Def x := ... <M>.t ... <N>.O.u ... X.T.b ... L.A.a
- 
+```
+
    <M> and <N> are self-references, X is a bound reference and L is a
 reference to a physical module.
  
@@ -1019,14 +1122,13 @@ world.
 module_expr) and kernel/declarations.ml (type module_body and
 module_type_body).                                                              
 
-2. Library
-----------
+#### Library
 
-i) tables 
+1. tables
 [Summaries] - the only change is the special treatment of the
 global environmet.
 
-ii) objects 
+2. objects 
 [Libobject] declares persistent objects, given with methods:
 
    * cache_function specifying how to add the object in the current
@@ -1047,25 +1149,25 @@ Coq.Init.Datatypes.Fst) and kernel_name is its substitutive internal
 version such as (MPself<Datatypes#1>,[],"Fst") (see above)
 
 
-What happens at the end of an interactive module ?
-==================================================
+#### What happens at the end of an interactive module ?
+
 (or when a file is stored and reloaded from disk)
 
 All summaries (except Global environment) are reverted to the state
 from before the beginning of the module, and:
 
-a) the objects (again, since last Declaremods.start_module or
+1. the objects (again, since last Declaremods.start_module or
    Library.start_library) are classified using the classify_function.
    To simplify consider only those who returned Substitute _ or Keep _.
 
-b) If the module is not a functor, the subst_function for each object of
+2. If the module is not a functor, the subst_function for each object of
    the first group is called with the substitution 
    [MPself "<Datatypes#1>" |-> MPfile "Coq.Init.Datatypes"].
    Then the load_function is called for substituted objects and the
    "keep" object. 
    (If the module is a library the substitution is done at reloading).
 
-c) The objects which returned substitute are stored in the modtab
+3. The objects which returned substitute are stored in the modtab
    together with the self ident of the module, and functor argument
    names if the module was a functor.
 
@@ -1075,9 +1177,9 @@ c) The objects which returned substitute are stored in the modtab
    is evaluated
 
 
-The difference between "substitute" and "keep" objects
-========================================================
-i) The "keep" objects can _only_ reference other objects by section_paths
+#### The difference between "substitute" and "keep" objects
+
+1. The "keep" objects can _only_ reference other objects by section_paths
 and qualids. They do not need the substitution function.
 
 They will work after end_module (or reloading a compiled library),
@@ -1089,7 +1191,7 @@ These would typically be grammar rules, pretty printing rules etc.
 
 
 
-ii) The "substitute" objects can _only_ reference objects by
+2. The "substitute" objects can _only_ reference objects by
 kernel_names. They must have a valid subst_function. 
 
 They will work after end_module _and_ after Module Z:=N or 
@@ -1098,17 +1200,18 @@ Module Z:=F(M).
 
 
 Other kinds of objects:
-iii) "Dispose" - objects which do not survive end_module
+
+3. "Dispose" - objects which do not survive end_module
      As a consequence, objects which reference other objects sometimes
      by kernel_names and sometimes by section_path must be of this kind...
 
-iv) "Anticipate" - objects which must be treated individually by
+4. "Anticipate" - objects which must be treated individually by
     end_module (typically "REQUIRE" objects)
 
 
 
-Writing subst_thing functions
-=============================
+#### Writing subst_thing functions
+
 The subst_thing shoud not copy the thing if it hasn't actually
 changed. There are some cool emacs macros in dev/objects.el 
 to help writing subst functions this way quickly and without errors.
@@ -1123,15 +1226,13 @@ They are all (apart from constr, for now) written in the non-copying
 way.
 
 
-Nametab
-=======
+#### Nametab
 
 Nametab has been made more uniform. For every kind of thing there is
 only one "push" function and one "locate" function. 
 
 
-Lib
-===
+#### Lib
 
 library_segment is now a list of object_name * library_item, where
 object_name = section_path * kernel_name (see above)
@@ -1139,20 +1240,19 @@ object_name = section_path * kernel_name (see above)
 New items have been added for open modules and module types
 
 
-Declaremods
-==========
+#### Declaremods
+
 Functions to declare interactive and noninteractive modules and module
 types.
 
 
-Library
-=======
+#### Library
+
 Uses Declaremods to actually communicate with Global and to register
 objects.
 
 
-OTHER CHANGES
-=============
+### Other changes
 
 Internal representation of tactics bindings has changed (see type
 Rawterm.substitution).
@@ -1169,258 +1269,48 @@ New parsing model for tactics and vernacular commands
     TACTIC EXTEND ... END  to be used in ML files
 
 New organisation of THENS:
-tclTHENS tac tacs : tacs is now an array
-tclTHENSFIRSTn tac1 tacs tac2 :
+
+- tclTHENS tac tacs : tacs is now an array
+- tclTHENSFIRSTn tac1 tacs tac2 :
   apply tac1 then, apply the array tacs on the first n subgoals and
   tac2 on the remaining subgoals (previously tclTHENST)
-tclTHENSLASTn tac1 tac2 tacs :
+- tclTHENSLASTn tac1 tac2 tacs :
   apply tac1 then, apply tac2 on the first subgoals and apply the array
   tacs on the last n subgoals
-tclTHENFIRSTn tac1 tacs = tclTHENSFIRSTn tac1 tacs tclIDTAC (prev. tclTHENSI)
-tclTHENLASTn tac1 tacs  = tclTHENSLASTn tac1 tclIDTAC tacs
-tclTHENFIRST tac1 tac2  = tclTHENFIRSTn tac1 [|tac2|]
-tclTHENLAST tac1 tac2   = tclTHENLASTn tac1 [|tac2|] (previously tclTHENL)
-tclTHENS tac1 tacs = tclTHENSFIRSTn tac1 tacs (fun _ -> error "wrong number")
-tclTHENSV same as tclTHENS but with an array
-tclTHENSi : no longer available
+- tclTHENFIRSTn tac1 tacs = tclTHENSFIRSTn tac1 tacs tclIDTAC (prev. tclTHENSI)
+- tclTHENLASTn tac1 tacs  = tclTHENSLASTn tac1 tclIDTAC tacs
+- tclTHENFIRST tac1 tac2  = tclTHENFIRSTn tac1 [|tac2|]
+- tclTHENLAST tac1 tac2   = tclTHENLASTn tac1 [|tac2|] (previously tclTHENL)
+- tclTHENS tac1 tacs = tclTHENSFIRSTn tac1 tacs (fun _ -> error "wrong number")
+- tclTHENSV same as tclTHENS but with an array
+- tclTHENSi : no longer available
 
 Proof_type: subproof field in type proof_tree glued with the ref field
 
 Tacmach: no more echo from functions of module Refiner
 
 Files plugins/*/g_*.ml4 take the place of files plugins/*/*.v.
+
 Files parsing/{vernac,tac}extend.ml{4,i} implements TACTIC EXTEND andd
   VERNAC COMMAND EXTEND macros
+
 File syntax/PPTactic.v moved to parsing/pptactic.ml
+
 Tactics about False and not now in tactics/contradiction.ml
+
 Tactics depending on Init now tactics/*.ml4 (no longer in tactics/*.v)
+
 File tacinterp.ml moved from proofs to directory tactics
 
 
-==========================================
-= MAIN CHANGES FROM COQ V7.1 TO COQ V7.2 =
-==========================================
+## Changes between Coq 7.1 and Coq 7.2
 
 The core of Coq (kernel) has meen minimized with the following effects:
 
-kernel/term.ml      split into kernel/term.ml,      pretyping/termops.ml
-kernel/reduction.ml split into kernel/reduction.ml, pretyping/reductionops.ml
-kernel/names.ml     split into kernel/names.ml,     library/nameops.ml
-kernel/inductive.ml split into kernel/inductive.ml, pretyping/inductiveops.ml
+- kernel/term.ml      split into kernel/term.ml,      pretyping/termops.ml
+- kernel/reduction.ml split into kernel/reduction.ml, pretyping/reductionops.ml
+- kernel/names.ml     split into kernel/names.ml,     library/nameops.ml
+- kernel/inductive.ml split into kernel/inductive.ml, pretyping/inductiveops.ml
 
 the prefixes "Is" ans "IsMut" have been dropped from kind_of_term constructors,
 e.g. IsRel is now Rel, IsMutCase is now Case, etc.
-
-
-=======================================================
-= PRINCIPAUX CHANGEMENTS ENTRE COQ V6.3.1 ET COQ V7.0 =
-=======================================================
-
-Changements d'organisation / modules :
---------------------------------------
-
-  Std, More_util		-> lib/util.ml
-
-  Names				-> kernel/names.ml et kernel/sign.ml
-    (les parties noms et signatures ont été séparées)
-
-  Avm,Mavm,Fmavm,Mhm  ->  utiliser plutôt Map (et freeze alors gratuit)
-  Mhb                 ->  Bij
-
-  Generic est intégré à Term (et un petit peu à Closure)
-
-Changements dans les types de données :
----------------------------------------
-  dans Generic: free_rels : constr -> int Listset.t
-                  devient : constr -> Intset.t
-
-  type_judgement ->  typed_type
-  environment    ->  context
-  context        ->  typed_type signature
-
-
-ATTENTION:
-----------
-
-  Il y a maintenant d'autres exceptions que UserError (TypeError,
-  RefinerError, etc.)
-
-  Il ne faut donc plus se contenter (pour rattraper) de faire
-  
-		try . .. with UserError _ -> ...
-
-  mais écrire à la place
- 
-                try ... with e when Logic.catchable_exception e -> ...
-
-
-Changements dans les fonctions :
---------------------------------
-
-	Vectops.
-	  it_vect          ->  Array.fold_left
-	  vect_it          ->  Array.fold_right
-	  exists_vect      ->  Util.array_exists
-	  for_all2eq_vect  ->  Util.array_for_all2
-	  tabulate_vect    ->  Array.init
-	  hd_vect          ->  Util.array_hd
-	  tl_vect          ->  Util.array_tl
-	  last_vect        ->  Util.array_last
-	  it_vect_from     ->  array_fold_left_from
-	  vect_it_from     ->  array_fold_right_from
-	  app_tl_vect	   ->  array_app_tl
-	  cons_vect	   ->  array_cons
-	  map_i_vect	   ->  Array.mapi
-	  map2_vect	   ->  array_map2
-	  list_of_tl_vect  ->  array_list_of_tl
-
-        Names
-          sign_it        -> fold_var_context (se fait sur env maintenant)
-	  it_sign        -> fold_var_context_reverse (sur env maintenant)
-
-        Generic
-	  noccur_bet     -> noccur_between
-          substn_many    -> substnl
-
-	Std 
-	  comp           ->  Util.compose
-	  rev_append	 ->  List.rev_append
-
-	Termenv
-	  mind_specif_of_mind  -> Global.lookup_mind_specif
-                ou Environ.lookup_mind_specif si on a un env sous la main
-	  mis_arity      ->  instantiate_arity
-	  mis_lc	 ->  instantiate_lc	
-
-	Ex-Environ	 
-	  mind_of_path      -> Global.lookup_mind
-
-	Printer
-	  gentermpr	->   gen_pr_term
-          term0	        ->   prterm_env	
-          pr_sign       ->   pr_var_context
-	  pr_context_opt -> pr_context_of
-          pr_ne_env      -> pr_ne_context_of
-
-	Typing, Machops
-	  type_of_type     ->  judge_of_type
-	  fcn_proposition  ->  judge_of_prop_contents
-	  safe_fmachine    ->  safe_infer
-
-	Reduction, Clenv
-          whd_betadeltat      -> whd_betaevar
-          whd_betadeltatiota  -> whd_betaiotaevar
-          find_mrectype       -> Inductive.find_mrectype
-          find_minductype     -> Inductive.find_inductive
-          find_mcoinductype   -> Inductive.find_coinductive
-
-        Astterm
-          constr_of_com_casted -> interp_casted_constr
-          constr_of_com_sort   -> interp_type
-          constr_of_com        -> interp_constr
-          rawconstr_of_com     -> interp_rawconstr
-          type_of_com          -> type_judgement_of_rawconstr
-	  judgement_of_com     -> judgement_of_rawconstr
-
-        Termast
-          bdize                -> ast_of_constr
-
-        Tacmach
-          pf_constr_of_com_sort -> pf_interp_type
-          pf_constr_of_com      -> pf_interp_constr
-	  pf_get_hyp            -> pf_get_hyp_typ
-          pf_hyps, pf_untyped_hyps -> pf_env (tout se fait sur env maintenant)
-
-        Pattern
-	  raw_sopattern_of_compattern -> Astterm.interp_constrpattern
-	  somatch               -> is_matching
-          dest_somatch          -> matches
-
-        Tacticals
-	  matches               -> gl_is_matching
-          dest_match            -> gl_matches
-	  suff                  -> utiliser sort_of_goal
-          lookup_eliminator     -> utiliser sort_of_goal pour le dernier arg
-
-        Divers
-          initial_sign     -> var_context
-
-        Sign
-          ids_of_sign      -> ids_of_var_context (or Environ.ids_of_context)
-          empty_sign       -> empty_var_context
-
-        Pfedit
-	  list_proofs      -> get_all_proof_names
-          get_proof        -> get_current_proof_name
-          abort_goal       -> abort_proof
-          abort_goals      -> abort_all_proofs
-          abort_cur_goal   -> abort_current_proof
-          get_evmap_sign   -> get_goal_context/get_current_goal_context
-          unset_undo       -> reset_undo
-
-        Proof_trees
-          mkGOAL           -> mk_goal
-
-        Declare
-  	  machine_constant ->   declare_constant (+ modifs)
-
-	ex-Trad, maintenant Pretyping
-          inh_cast_rel        -> Coercion.inh_conv_coerce_to
-          inh_conv_coerce_to  -> Coercion.inh_conv_coerce_to_fail
-	  ise_resolve1        -> understand, understand_type
-	  ise_resolve         -> understand_judgment, understand_type_judgment
-
-        ex-Tradevar, maintenant Evarutil
-          mt_tycon            -> empty_tycon
-
-        Recordops
-          struc_info          -> find_structure
-
-Changements dans les inductifs
-------------------------------
-Nouveaux types "constructor" et "inductive" dans Term
-La plupart des fonctions de typage des inductives prennent maintenant
-un inductive au lieu d'un oonstr comme argument. Les seules fonctions
-à traduire un constr en inductive sont les find_rectype and co.
-
-Changements dans les grammaires
--------------------------------
-
- . le lexer (parsing/lexer.mll) est maintenant un lexer ocamllex
-
- . attention : LIDENT -> IDENT  (les identificateurs n'ont pas de
-                                 casse particulière dans Coq)
-
- . Le mot "command" est remplacé par "constr" dans les noms de
- fichiers, noms de modules et non-terminaux relatifs au parsing des
- termes; aussi les changements suivants "COMMAND"/"CONSTR" dans
- g_vernac.ml4, VARG_COMMAND/VARG_CONSTR dans vernac*.ml*
-
- . Les constructeurs d'arguments de tactiques IDENTIFIER, CONSTR, ...n
-   passent en minuscule Identifier, Constr, ...
- 
- . Plusieurs parsers ont changé de format (ex: sortarg)
-
-Changements dans le pretty-printing
------------------------------------
-
- . Découplage de la traduction de constr -> rawconstr (dans detyping)
-    et de rawconstr -> ast (dans termast)
- . Déplacement des options d'affichage de printer vers termast
- . Déplacement des réaiguillage d'univers du pp de printer vers esyntax
-
-	
-Changements divers
-------------------
-
- . il n'y a plus de script coqtop => coqtop et coqtop.byte sont
-   directement le résultat du link du code
-   => debuggage et profiling directs
-
- . il n'y a plus d'installation locale dans bin/$ARCH
- 
- . #use "include.ml"  =>  #use "include"
-   go()               =>  loop()
-
- . il y a "make depend" et "make dependcamlp4" car ce dernier prend beaucoup
-   de temps
diff --git a/dev/doc/coq-src-description.txt b/dev/doc/coq-src-description.txt
index 00e7f5c53..b3d49b7e5 100644
--- a/dev/doc/coq-src-description.txt
+++ b/dev/doc/coq-src-description.txt
@@ -14,11 +14,6 @@ parsing
 tactics
 toplevel
 
-highparsing :
-
- Files in parsing/ that cannot be linked too early.
- Contains the grammar rules g_*.ml4
-
 Special components
 ------------------
 
@@ -30,7 +25,7 @@ intf :
 
 grammar :
 
- Camlp4 syntax extensions. The file grammar/grammar.cma is used
+ Camlp5 syntax extensions. The file grammar/grammar.cma is used
  to pre-process .ml4 files containing EXTEND constructions,
  either TACTIC EXTEND, ARGUMENTS EXTEND or VERNAC ... EXTEND.
  This grammar.cma incorporates many files from other directories
diff --git a/dev/doc/debugging.md b/dev/doc/debugging.md
index 7e9373b29..fd3cbd1bc 100644
--- a/dev/doc/debugging.md
+++ b/dev/doc/debugging.md
@@ -22,8 +22,8 @@ Debugging from Coq toplevel using Caml trace mechanism
   printers too.
 
 
-Debugging from Caml debugger
-============================
+Debugging with ocamldebug from Emacs
+====================================
 
    Requires [Tuareg mode](https://github.com/ocaml/tuareg) in Emacs.\
    Coq must be configured with `-local` (`./configure -local`) and the
@@ -54,9 +54,33 @@ Debugging from Caml debugger
      of each of error* functions or anomaly* functions in lib/util.ml
    - If "source db" fails, do a "make printers" and try again (it should build
      top_printers.cmo and the core cma files).
-   - If you have the OCAMLRUNPARAM environment variable set, Coq may hang on
-     startup when run from the debugger. If this happens, unset the variable,
-     re-start Emacs, and run the debugger again.
+   - If you build Coq with an OCaml version earlier than 4.06, and have the 
+     OCAMLRUNPARAM environment variable set, Coq may hang on startup when run 
+     from the debugger. If this happens, unset the variable, re-start Emacs, and 
+     run the debugger again.
+
+Debugging with ocamldebug from the command line
+===============================================
+
+In the `coq` directory:
+1. (on Cygwin/Windows) Pass the `-no-custom` option to the `configure` script before building Coq.
+2. Run `make` (to compile the .v files)
+3. Run `make byte`
+4. (on Cygwin/Windows) Add the full pathname of the directory `.../kernel/byterun` to your bash PATH.
+   Alternatively, copy the file `kernel/byterun/dllcoqrun.dll` to a directory that is in the PATH.  (The
+   CAML_LD_LIBRARY_PATH mechanism described at the end of INSTALL isn't working.)
+5. Run `dev/ocamldebug-coq bin/coqtop.byte`  (on Cygwin/Windows, use `... bin/coqtop.byte.exe`)
+6. Enter `source db` to load printers
+7. Enter `set arguments -coqlib .` so Coq can find plugins, theories, etc.
+8. See the ocamldebug manual for more information.  A few points:
+   - use `break @ Printer 501` to set a breakpoint on line 501 in the Printer module (printer.ml).
+     `break` can be abbreviated as `b`.
+   - `backtrace` or `bt` to see the call stack
+   - `step` or `s` goes into called functions; `next` or `n` skips over them
+   - `list` or `li` shows the code just before and after the current stack frame
+   - `print <var>` or `p <var>` to see the value of a variable
+Note that `make byte` doesn't recompile .v files.  `make` recompiles all of them if there
+are changes in any .ml file--safer but much slower.
 
 Global gprof-based profiling
 ============================
@@ -72,8 +96,8 @@ Per function profiling
    To profile function foo in file bar.ml, add the following lines, just
    after the definition of the function:
 
-     let fookey = Profile.declare_profile "foo";;
-     let foo a b c = Profile.profile3 fookey foo a b c;;
+     let fookey = CProfile.declare_profile "foo";;
+     let foo a b c = CProfile.profile3 fookey foo a b c;;
 
    where foo is assumed to have three arguments (adapt using
    Profile.profile1, Profile. profile2, etc).
diff --git a/dev/doc/setup.txt b/dev/doc/setup.txt
index 0c6d3ee80..0003a2c21 100644
--- a/dev/doc/setup.txt
+++ b/dev/doc/setup.txt
@@ -58,30 +58,12 @@ behave as expected.
 A note about rlwrap
 -------------------
 
-Running "coqtop" under "rlwrap" is possible, but (on Debian) there is a catch. If you try:
-
-  cd ~/git/coq
-  rlwrap bin/coqtop
-
-you will get an error:
+When using "rlwrap coqtop" make sure the version of rlwrap is at least
+0.42, otherwise you will get
 
   rlwrap: error: Couldn't read completions from /usr/share/rlwrap/completions/coqtop: No such file or directory
 
-This is a known issue:
-
-  https://bugs.debian.org/cgi-bin/bugreport.cgi?bug=779692
-
-It was fixed upstream in version 0.42, and in a Debian package that, at the time of writing, is not part of Debian stable/testing/sid archives but only of Debian experimental.
-
-  https://packages.debian.org/experimental/rlwrap
-
-The quick solution is to grab it from there, since it installs fine on Debian stable (jessie).
-
-  cd /tmp
-  wget  http://ftp.us.debian.org/debian/pool/main/r/rlwrap/rlwrap_0.42-1_amd64.deb
-  sudo dpkg -i rlwrap_0.42-1_amd64.deb
-
-After that, "rlwrap" works fine with "coqtop".
+If this happens either update or use an alternate readline wrapper like "ledit".
 
 
 How to install and configure Merlin (for Emacs)
@@ -279,7 +261,7 @@ You can load them by switching to the window holding the "ocamldebug" shell and
 Some of the functions were you might want to set a breakpoint and see what happens next
 ---------------------------------------------------------------------------------------
 
-- Coqtop.start : This function is called by the code produced by "coqmktop".
+- Coqtop.start : This function is the main entry point of coqtop.
 - Coqtop.parse_args : This function is responsible for parsing command-line arguments.
 - Coqloop.loop : This function implements the read-eval-print loop.
 - Vernacentries.interp : This function is called to execute the Vernacular command user have typed.\
diff --git a/dev/doc/univpoly.txt b/dev/doc/univpoly.txt
index 6a69c5793..ca3d520c7 100644
--- a/dev/doc/univpoly.txt
+++ b/dev/doc/univpoly.txt
@@ -12,7 +12,7 @@ type pinductive = inductive puniverses
 type pconstructor = constructor puniverses
 
 type constr = ...
-  | Const of puniversess
+  | Const of puniverses
   | Ind of pinductive
   | Constr of pconstructor
   | Proj of constant * constr
diff --git a/dev/doc/versions-history.tex b/dev/doc/versions-history.tex
index 492e75a7b..3867d4af9 100644
--- a/dev/doc/versions-history.tex
+++ b/dev/doc/versions-history.tex
@@ -376,9 +376,27 @@ Coq V8.5 beta1 & released 21 January 2015 & \feature{computation via compilation
 && \feature{new proof engine deployed} [2-11-2013]\\
 && \feature{universe polymorphism} [6-5-2014]\\
 && \feature{primitive projections} [6-5-2014]\\
+&& \feature{miscellaneous optimizations}\\
 
 Coq V8.5 beta2 & released 22 April 2015 & \feature{MMaps library} [4-3-2015]\\
 
+Coq V8.5 & released 22 January 2016 & \\
+
+Coq V8.6 beta 1 & released 19 November 2016 & \feature{irrefutable patterns} [15-2-2016]\\
+&& \feature{Ltac profiling} [14-6-2016]\\
+&& \feature{warning system} [29-6-2016]\\
+&& \feature{miscellaneous optimizations}\\
+
+Coq V8.6 & released 14 December 2016 & \\
+
+Coq V8.7 beta 1 & released 6 September 2017 & \feature{bundled with Ssreflect plugin} [6-6-2017]\\
+&& \feature{cumulative polymorphic inductive types} [19-6-2017]\\
+&& \feature{further optimizations}\\
+
+Coq V8.7 beta 2 & released 6 October 2017 & \\
+
+Coq V8.7 & released 18 October 2016 & \\
+
 \end{tabular}
 
 \medskip
diff --git a/dev/doc/xml-protocol.md b/dev/doc/xml-protocol.md
index 127b4a6d2..b35571e9c 100644
--- a/dev/doc/xml-protocol.md
+++ b/dev/doc/xml-protocol.md
@@ -1,4 +1,4 @@
-#Coq XML Protocol for Coq 8.6#
+# Coq XML Protocol
 
 This document is based on documentation originally written by CJ Bell
 for his [vscoq](https://github.com/siegebell/vscoq/) project.
@@ -12,11 +12,7 @@ A somewhat out-of-date description of the async state machine is
 [documented here](https://github.com/ejgallego/jscoq/blob/master/etc/notes/coq-notes.md).
 OCaml types for the protocol can be found in the [`ide/interface.mli` file](/ide/interface.mli).
 
-# CHANGES
-## Changes from 8.5:
- * In several places, flat text wrapped in <string> tags now appears as structured text inside <richpp> tags 
- * The "errormsg" feedback has been replaced by a "message" feedback which contains
-    <feedback\_content> tag, with a message_level attribute of "error"
+Changes to the XML protocol are documented as part of [`dev/doc/changes.txt`](/dev/doc/changes.txt).
 
 * [Commands](#commands)
   - [About](#command-about)
@@ -291,7 +287,10 @@ Pseudocode for listing all of the goals in order: `rev (flat_map fst background)
 
 
 ### <a name="command-status">**Status(force: bool)**</a>
-CoqIDE typically sets `force` to `false`. 
+Returns information about the current proofs. CoqIDE typically sends this
+message with `force = false` after each sentence, and with `force = true` if
+the user wants to force the checking of all proofs (wheels button). In terms of
+the STM API, `force` triggers a `Join`.
 ```html
 <call val="Status"><bool val="${force}"/></call>
 ```
@@ -331,6 +330,12 @@ CoqIDE typically sets `force` to `false`.
   <string>${message}</string>
 </value>
 ```
+
+Before 8.8, `Query` only executed the first command present in the
+`query` string; starting with 8.8, the caller may include several
+statements. This is useful for instance for temporarily setting an
+option and then executing a command.
+
 -------------------------------
 
 
diff --git a/dev/header b/dev/header
index bf7bdc169..7c3ee6004 100644
--- a/dev/header
+++ b/dev/header
@@ -1,7 +1,9 @@
 (************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*         *   The Coq Proof Assistant / The Coq Development Team       *)
+(*  v      *   INRIA, CNRS and contributors - Copyright 1999-2018       *)
+(* <O___,, *       (see CREDITS file for the list of authors)           *)
 (*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
+(*    //   *    This file is distributed under the terms of the         *)
+(*         *     GNU Lesser General Public License Version 2.1          *)
+(*         *     (see LICENSE file for the text of the license)         *)
 (************************************************************************)
diff --git a/dev/include b/dev/include
index 0d34595f4..b982f4c9f 100644
--- a/dev/include
+++ b/dev/include
@@ -36,7 +36,6 @@
 #install_printer  (* constraints *)  ppconstraints;;
 #install_printer  (* univ constraints *)  ppuniverseconstraints;;
 #install_printer  (* universe *)  ppuni;;
-#install_printer  (* universes *)  ppuniverse;;
 #install_printer  (* universes *)  ppuniverses;;
 #install_printer  (* univ level *) ppuni_level;;
 #install_printer  (* univ context *) ppuniverse_context;;
diff --git a/dev/lint-commits.sh b/dev/lint-commits.sh
new file mode 100755
index 000000000..d8043558e
--- /dev/null
+++ b/dev/lint-commits.sh
@@ -0,0 +1,39 @@
+#!/usr/bin/env bash
+
+# A script to check prettyness for a range of commits
+
+CALLNAME="$0"
+
+function usage
+{
+    >&2 echo "usage: $CALLNAME <commit> <commit>"
+    >&2 echo "The order of commits is as given to 'git diff'"
+}
+
+if [ "$#" != 2 ];
+then
+    usage
+    exit 1
+fi
+
+BASE_COMMIT="$1"
+HEAD_COMMIT="$2"
+
+bad=()
+while IFS= read -r commit; do
+    echo Checking "$commit"
+    # git diff --check
+    # uses .gitattributes to know what to check
+    if ! git diff --check "${commit}^" "$commit";
+    then
+        bad+=("$commit")
+    fi
+done < <(git rev-list "$HEAD_COMMIT" --not "$BASE_COMMIT" --)
+
+if [ "${#bad[@]}" != 0 ]
+then
+    >&2 echo "Whitespace errors!"
+    >&2 echo "In commits ${bad[*]}"
+    >&2 echo "If you use emacs, you can prevent this kind of error from reocurring by installing ws-butler and enabling ws-butler-convert-leading-tabs-or-spaces."
+    exit 1
+fi
diff --git a/dev/lint-repository.sh b/dev/lint-repository.sh
new file mode 100755
index 000000000..ee9c8777a
--- /dev/null
+++ b/dev/lint-repository.sh
@@ -0,0 +1,34 @@
+#!/usr/bin/env bash
+
+# A script to check prettyness over the repository.
+
+# lint-commits.sh seeks to prevent the worsening of already present
+# problems, such as tab indentation in ml files. lint-repository.sh
+# seeks to prevent the (re-)introduction of solved problems, such as
+# newlines at the end of .v files.
+
+CODE=0
+
+if [ -n "${TRAVIS_PULL_REQUEST}" ] && [ "${TRAVIS_PULL_REQUEST}" != false ];
+then
+    # skip PRs from before the linter existed
+    if [ -z "$(git ls-tree --name-only "${TRAVIS_PULL_REQUEST_SHA}" dev/lint-commits.sh)" ];
+    then
+        1>&2 echo "Linting skipped: pull request older than the linter."
+        exit 0
+    fi
+
+    # Some problems are too widespread to fix in one commit, but we
+    # can still check that they don't worsen.
+    CUR_HEAD=${TRAVIS_COMMIT_RANGE%%...*}
+    PR_HEAD=${TRAVIS_COMMIT_RANGE##*...}
+    MERGE_BASE=$(git merge-base "$CUR_HEAD" "$PR_HEAD")
+    dev/lint-commits.sh "$MERGE_BASE" "$PR_HEAD" || CODE=1
+fi
+
+# Check that the files with 'whitespace' gitattribute end in a newline.
+# xargs exit status is 123 if any file failed the test
+find . "(" -path ./.git -prune ")" -o -type f -print0 |
+    xargs -0 dev/tools/check-eof-newline.sh || CODE=1
+
+exit $CODE
diff --git a/dev/nsis/FileAssociation.nsh b/dev/nsis/FileAssociation.nsh
index b8c1e5ee7..71a9162ef 100644
--- a/dev/nsis/FileAssociation.nsh
+++ b/dev/nsis/FileAssociation.nsh
@@ -187,4 +187,4 @@ NoOwn:
   !verbose pop
 !macroend
  
-!endif # !FileAssociation_INCLUDED
\ No newline at end of file
+!endif # !FileAssociation_INCLUDED
diff --git a/dev/nsis/coq.nsi b/dev/nsis/coq.nsi
index 80da84517..f48013cf2 100755
--- a/dev/nsis/coq.nsi
+++ b/dev/nsis/coq.nsi
@@ -13,7 +13,7 @@ SetCompressor lzma
 
 !define MY_PRODUCT "Coq" ;Define your own software name here
 !define COQ_SRC_PATH "..\.."
-!define OUTFILE "coq-installer-${VERSION}-${ARCH}.exe"
+!define OUTFILE "coq-${VERSION}-installer-windows-${ARCH}.exe"
 
 !include "MUI2.nsh"
 !include "FileAssociation.nsh"
diff --git a/dev/ocamldebug-coq.run b/dev/ocamldebug-coq.run
index f4799f7b2..f3e60edea 100644
--- a/dev/ocamldebug-coq.run
+++ b/dev/ocamldebug-coq.run
@@ -3,27 +3,26 @@
 # Wrapper around ocamldebug for Coq
 
 # This file is to be launched via the generated script ocamldebug-coq,
-# which will set the env variables $OCAMLDEBUG, $CAMLP4LIB, $COQTOP
+# which will set the env variables $OCAMLDEBUG, $CAMLP5LIB, $COQTOP
 # Anyway, just in case someone tries to use this script directly,
 # here are some reasonable default values
 
 [ -z "$OCAMLDEBUG" ] && OCAMLDEBUG=ocamldebug
-[ -z "$CAMLP4LIB" ] && CAMLP4LIB=+camlp5
+[ -z "$CAMLP5LIB" ] && CAMLP5LIB=+camlp5
 [ -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 +threads \
+	-I $CAMLP5LIB -I +threads \
 	-I $COQTOP \
-	-I $COQTOP/config -I $COQTOP/printing -I $COQTOP/grammar \
+	-I $COQTOP/config -I $COQTOP/printing -I $COQTOP/grammar -I $COQTOP/clib \
 	-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/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/API \
         -I $COQTOP/plugins/cc         -I $COQTOP/plugins/dp \
         -I $COQTOP/plugins/extraction -I $COQTOP/plugins/field \
         -I $COQTOP/plugins/firstorder -I $COQTOP/plugins/fourier \
diff --git a/dev/set_raw_db b/dev/set_raw_db
deleted file mode 100644
index 5caff7e5d..000000000
--- a/dev/set_raw_db
+++ /dev/null
@@ -1 +0,0 @@
-install_printer Top_printers.ppconstrdb
diff --git a/dev/tools/anomaly-traces-parser.el b/dev/tools/anomaly-traces-parser.el
deleted file mode 100644
index 68f54266f..000000000
--- a/dev/tools/anomaly-traces-parser.el
+++ /dev/null
@@ -1,28 +0,0 @@
-;; This Elisp snippet adds a regexp parser for the format of Anomaly
-;; backtraces (coqc -bt ...), to the error parser of the Compilation
-;; mode (C-c C-c: "Compile command: ..."). Once the
-;; coq-change-error-alist-for-backtraces function has run, file
-;; locations in traces are recognized and can be jumped from easily
-;; from the *compilation* buffer.
-
-;; You can just copy everything below to your .emacs and this will be
-;; enabled from any compilation command launched from an OCaml file.
-
-(defun coq-change-error-alist-for-backtraces ()
-  "Hook to change the compilation-error-regexp-alist variable, to
-   search the coq backtraces for error locations"
-  (interactive)
-  (add-to-list
-   'compilation-error-regexp-alist-alist
-   '(coq-backtrace
-     "^ *\\(?:raise\\|frame\\) @ file \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1,\
-      lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\
-      \\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:?\\)?\\)"
-     2 (3 . 4) (5 . 6)))
-  (add-to-list 'compilation-error-regexp-alist 'coq-backtrace))
-
-;; this Anomaly parser should be available when one is hacking
-;; on the *OCaml* code of Coq (adding bugs), so we enable it
-;; through the OCaml mode hooks.
-(add-hook 'caml-mode-hook 'coq-change-error-alist-for-backtraces)
-(add-hook 'tuareg-mode-hook 'coq-change-error-alist-for-backtraces)
diff --git a/dev/tools/backport-pr.sh b/dev/tools/backport-pr.sh
new file mode 100755
index 000000000..e4359f703
--- /dev/null
+++ b/dev/tools/backport-pr.sh
@@ -0,0 +1,74 @@
+#!/usr/bin/env bash
+
+# Usage: dev/tools/backport-pr.sh <PR number> [--stop-before-merging]
+
+set -e
+
+PRNUM=$1
+OPTION=$2
+
+if ! git log master --grep "Merge PR #${PRNUM}" | grep "." > /dev/null; then
+    echo "PR #${PRNUM} does not exist."
+    exit 1
+fi
+
+SIGNATURE_STATUS=$(git log master --grep "Merge PR #${PRNUM}" --format="%G?")
+git log master --grep "Merge PR #${PRNUM}" --format="%GG"
+if [[ "${SIGNATURE_STATUS}" != "G" ]]; then
+    echo
+    read -p "Merge commit does not have a good (valid) signature. Bypass? [y/N] " -n 1 -r
+    echo
+    if [[ ! $REPLY =~ ^[Yy]$ ]]; then
+        exit 1
+    fi
+fi
+
+BRANCH=backport-pr-${PRNUM}
+RANGE=$(git log master --grep "Merge PR #${PRNUM}" --format="%P" | sed 's/ /../')
+MESSAGE=$(git log master --grep "Merge PR #${PRNUM}" --format="%s" | sed 's/Merge/Backport/')
+
+if git checkout -b ${BRANCH}; then
+
+    if ! git cherry-pick -x ${RANGE}; then
+        echo "Please fix the conflicts, then exit."
+        bash
+        while ! git cherry-pick --continue; do
+            echo "Please fix the conflicts, then exit."
+            bash
+        done
+    fi
+    git checkout -
+
+else
+
+    echo
+    read -p "Skip directly to merging phase? [y/N] " -n 1 -r
+    echo
+    if [[ ! $REPLY =~ ^[Yy]$ ]]; then
+        exit 1
+    fi
+
+fi
+
+if ! git diff --exit-code HEAD ${BRANCH} -- "*.mli"; then
+    echo
+    read -p "Some mli files are modified. Bypass? [y/N] " -n 1 -r
+    echo
+    if [[ ! $REPLY =~ ^[Yy]$ ]]; then
+        exit 1
+    fi
+fi
+
+if [[ "${OPTION}" == "--stop-before-merging" ]]; then
+    exit 0
+fi
+
+git merge -S --no-ff ${BRANCH} -m "${MESSAGE}"
+git branch -d ${BRANCH}
+
+# To-Do:
+# - Support for backporting a PR before it is merged
+# - Automatically backport all PRs in the "Waiting to be backported" column using a command like:
+# $ curl -s -H "Authorization: token ${GITHUB_TOKEN}" -H "Accept: application/vnd.github.inertia-preview+json" https://api.github.com/projects/columns/1358120/cards | jq -r '.[].content_url' | grep issue | sed 's/^.*issues\/\([0-9]*\)$/\1/' | tac
+# (The ID of the column must first be obtained through https://api.github.com/repos/coq/coq/projects then https://api.github.com/projects/819866/columns.)
+# - Then move each of the backported PR to the subsequent columns automatically as well...
diff --git a/dev/tools/check-eof-newline.sh b/dev/tools/check-eof-newline.sh
new file mode 100755
index 000000000..e244d9ab8
--- /dev/null
+++ b/dev/tools/check-eof-newline.sh
@@ -0,0 +1,41 @@
+#!/usr/bin/env bash
+
+# Usage: check-eof-newline.sh [--fix] FILES...
+# Detect missing end of file newlines for FILES.
+# Files are skipped if untracked by git and depending on gitattributes.
+# With --fix, automatically append a newline.
+# Exit status:
+# Without --fix: 1 if any file had a missing newline, 0 otherwise.
+# With --fix: 1 if any non writable file had a missing newline, 0 otherwise.
+
+FIX=
+if [ "$1" = --fix ];
+then
+   FIX=1
+   shift
+fi
+
+CODE=0
+for f in "$@"; do
+    if git ls-files --error-unmatch "$f" >/dev/null 2>&1 && \
+           git check-attr whitespace -- "$f" | grep -q -v -e 'unset$' -e 'unspecified$' && \
+           [ -n "$(tail -c 1 "$f")" ]
+    then
+        if [ -n "$FIX" ];
+        then
+            if [ -w "$f" ];
+            then
+                echo >> "$f"
+                echo "Newline appended to file $f!"
+            else
+                echo "File $f is missing a newline and not writable!"
+                CODE=1
+            fi
+        else
+            echo "No newline at end of file $f!"
+            CODE=1
+        fi
+    fi
+done
+
+exit "$CODE"
diff --git a/dev/tools/coqdev.el b/dev/tools/coqdev.el
new file mode 100644
index 000000000..62fdaec80
--- /dev/null
+++ b/dev/tools/coqdev.el
@@ -0,0 +1,107 @@
+;;; coqdev.el --- Emacs helpers for Coq development  -*- lexical-binding:t -*-
+
+;; Copyright (C) 2018 The Coq Development Team
+
+;; Maintainer: coqdev@inria.fr
+
+;;; Commentary:
+
+;; Helpers to set compilation commands, proof general variables, etc
+;; for Coq development
+
+;; You can disable individual features without editing this file by
+;; using `remove-hook', for instance
+;; (remove-hook 'hack-local-variables-hook #'coqdev-setup-compile-command)
+
+;;; Installation:
+
+;; To use this, with coqdev.el located at /path/to/coqdev.el, add the
+;; following to your init:
+
+;; (add-to-list 'load-path "/path/to/coqdev/")
+;; (require 'coqdev)
+
+;; If you load this file from a git repository, checking out an old
+;; commit will make it disappear and cause errors for your Emacs
+;; startup. To ignore those errors use (require 'coqdev nil t). If you
+;; check out a malicious commit Emacs startup would allow it to run
+;; arbitrary code, to avoid this you can copy coqdev.el to any
+;; location and adjust the load path accordingly (of course if you run
+;; ./configure to compile Coq it is already too late).
+
+;;; Code:
+
+(defun coqdev-default-directory ()
+  "Return the Coq repository containing `default-directory'."
+  (let ((dir (locate-dominating-file default-directory "META.coq")))
+    (when dir (expand-file-name dir))))
+
+(defun coqdev-setup-compile-command ()
+  "Setup `compile-command' for Coq development."
+  (let ((dir (coqdev-default-directory)))
+    ;; we add a space at the end to make it easy to add arguments (eg -j or target)
+    (when dir (setq-local compile-command (concat "make -C " (shell-quote-argument dir) " ")))))
+(add-hook 'hack-local-variables-hook #'coqdev-setup-compile-command)
+
+(defvar camldebug-command-name) ; from camldebug.el (caml package)
+(defvar ocamldebug-command-name) ; from ocamldebug.el (tuareg package)
+(defun coqdev-setup-camldebug ()
+  "Setup ocamldebug for Coq development.
+
+Specifically `camldebug-command-name' and `ocamldebug-command-name'."
+  (let ((dir (coqdev-default-directory)))
+    (when dir
+      (setq-local camldebug-command-name
+                  (concat dir "dev/ocamldebug-coq"))
+      (setq-local ocamldebug-command-name
+                  (concat dir "dev/ocamldebug-coq")))))
+(add-hook 'hack-local-variables-hook #'coqdev-setup-camldebug)
+
+(defun coqdev-setup-tags ()
+  "Setup `tags-file-name' for Coq development."
+  (let ((dir (coqdev-default-directory)))
+    (when dir (setq-local tags-file-name (concat dir "TAGS")))))
+(add-hook 'hack-local-variables-hook #'coqdev-setup-tags)
+
+(defvar coq-prog-args)
+(defvar coq-prog-name)
+
+;; Lets us detect whether there are file local variables
+;; even though PG sets it with `setq' when there's a _Coqproject.
+;; Also makes sense generally, so might make it into PG someday.
+(make-variable-buffer-local 'coq-prog-args)
+(setq-default coq-prog-args nil)
+
+(defun coqdev-setup-proofgeneral ()
+  "Setup Proofgeneral variables for Coq development.
+
+Note that this function is executed before _Coqproject is read if it exists."
+  (let ((dir (coqdev-default-directory)))
+    (when dir
+      (unless coq-prog-args
+        (setq coq-prog-args
+              `("-coqlib" ,dir "-R" ,(concat dir "plugins")
+                "Coq" "-R" ,(concat dir "theories")
+                "Coq")))
+      (setq-local coq-prog-name (concat dir "bin/coqtop")))))
+(add-hook 'hack-local-variables-hook #'coqdev-setup-proofgeneral)
+
+;; This Elisp snippet adds a regexp parser for the format of Anomaly
+;; backtraces (coqc -bt ...), to the error parser of the Compilation
+;; mode (C-c C-c: "Compile command: ..."). File locations in traces
+;; are recognized and can be jumped from easily in the *compilation*
+;; buffer.
+(defvar compilation-error-regexp-alist-alist)
+(defvar compilation-error-regexp-alist)
+(with-eval-after-load 'compile
+  (add-to-list
+   'compilation-error-regexp-alist-alist
+   '(coq-backtrace
+     "^ *\\(?:raise\\|frame\\) @ file \\(\"?\\)\\([^,\" \n\t<>]+\\)\\1,\
+      lines? \\([0-9]+\\)-?\\([0-9]+\\)?\\(?:$\\|,\
+      \\(?: characters? \\([0-9]+\\)-?\\([0-9]+\\)?:?\\)?\\)"
+     2 (3 . 4) (5 . 6)))
+  (add-to-list 'compilation-error-regexp-alist 'coq-backtrace))
+
+(provide 'coqdev)
+;;; coqdev ends here
diff --git a/dev/tools/github-check-prs.py b/dev/tools/github-check-prs.py
new file mode 100755
index 000000000..beb26d910
--- /dev/null
+++ b/dev/tools/github-check-prs.py
@@ -0,0 +1,47 @@
+#!/usr/bin/env python3
+
+# Requires PyGithub https://pypi.python.org/pypi/PyGithub, for instance
+# debian package: python3-github
+# nix: nix-shell -p python3 python3Packages.PyGithub --run ./github-check-rebase.py
+from github import Github
+import argparse
+
+REPO = "coq/coq"
+REBASE_LABEL="needs: rebase"
+
+parser = argparse.ArgumentParser()
+parser.add_argument("--token-file", type=argparse.FileType('r'))
+args = parser.parse_args()
+
+if args.token_file is None:
+    token = input("Github access token: ").strip()
+else:
+    token = args.token_file.read().rstrip("\n")
+    args.token_file.close()
+
+if token == "":
+    print ("Warning: using the GitHub API without a token")
+    print ("We may run into rate limit issues")
+    g = Github()
+else:
+    g = Github(token)
+
+repo = g.get_repo(REPO)
+
+for pull in repo.get_pulls():
+    # if conflicts then dirty
+    # otherwise blocked (because I have no rights)
+    dirty = pull.mergeable_state == "dirty"
+    labelled = False
+    for label in repo.get_issue(pull.number).get_labels():
+        if label.name == REBASE_LABEL:
+            labelled = True
+    if labelled and not dirty:
+        print ("PR #" + str(pull.number) + " is not dirty but is labelled")
+        print ("("+ pull.html_url +")")
+    elif dirty and not labelled:
+        print ("PR #" + str(pull.number) + " is dirty and not labelled")
+        print ("("+ pull.html_url +")")
+    else:
+        # give some feedback so the user can see we didn't crash
+        print ("PR #" + str(pull.number) + " OK")
diff --git a/dev/tools/merge-pr.sh b/dev/tools/merge-pr.sh
new file mode 100755
index 000000000..9f24960ff
--- /dev/null
+++ b/dev/tools/merge-pr.sh
@@ -0,0 +1,50 @@
+#!/usr/bin/env bash
+
+set -e
+
+# This script depends (at least) on git and jq.
+# It should be used like this: dev/tools/merge-pr.sh /PR number/
+
+#TODO: check arguments and show usage if relevant
+
+PR=$1
+
+CURRENT_LOCAL_BRANCH=$(git rev-parse --abbrev-ref HEAD)
+REMOTE=$(git config --get "branch.$CURRENT_LOCAL_BRANCH.remote")
+git fetch "$REMOTE" "refs/pull/$PR/head"
+
+API=https://api.github.com/repos/coq/coq
+
+BASE_BRANCH=$(curl -s "$API/pulls/$PR" | jq -r '.base.label')
+
+COMMIT=$(git rev-parse FETCH_HEAD)
+STATUS=$(curl -s "$API/commits/$COMMIT/status" | jq -r '.state')
+
+if [ "$BASE_BRANCH" != "coq:$CURRENT_LOCAL_BRANCH" ]; then
+  echo "Wrong base branch"
+  read -p "Bypass? [y/N] " -n 1 -r
+  echo
+  if [[ ! $REPLY =~ ^[Yy]$ ]]
+  then
+    exit 1
+  fi
+fi;
+
+if [ "$STATUS" != "success" ]; then
+  echo "CI status is \"$STATUS\""
+  read -p "Bypass? [y/N] " -n 1 -r
+  echo
+  if [[ ! $REPLY =~ ^[Yy]$ ]]
+  then
+    exit 1
+  fi
+fi;
+
+git merge -S --no-ff FETCH_HEAD -m "Merge PR #$PR: $(curl -s "$API/pulls/$PR" | jq -r '.title')" -e
+
+# TODO: improve this check
+if ! git diff --quiet "$REMOTE/$CURRENT_LOCAL_BRANCH" -- dev/ci; then
+  echo "******************************************"
+  echo "** WARNING: does this PR have overlays? **"
+  echo "******************************************"
+fi
diff --git a/dev/tools/pre-commit b/dev/tools/pre-commit
new file mode 100755
index 000000000..c9cdee84a
--- /dev/null
+++ b/dev/tools/pre-commit
@@ -0,0 +1,73 @@
+#!/bin/sh
+
+# configure automatically sets up a wrapper at .git/hooks/pre-commit
+# which calls this script (if it exists).
+
+set -e
+
+if ! git diff --cached --name-only -z | xargs -0 dev/tools/check-eof-newline.sh ||
+        ! git diff-index --check --cached HEAD >/dev/null 2>&1 ;
+then
+    1>&2 echo "Auto fixing whitespace issues..."
+
+    # We fix whitespace in the index and in the working tree
+    # separately to preserve non-added changes.
+    index=$(mktemp "git-fix-ws-index.XXXXX")
+    fixed_index=$(mktemp "git-fix-ws-index-fixed.XXXXX")
+    tree=$(mktemp "git-fix-ws-tree.XXXXX")
+    1>&2 echo "Patches are saved in '$index', '$fixed_index' and '$tree'."
+    1>&2 echo "If an error destroys your changes you can recover using them."
+    1>&2 echo "(The files are cleaned up on success.)"
+    1>&2 echo #newline
+
+    git diff-index -p --cached HEAD > "$index"
+    git diff-index -p HEAD > "$tree"
+
+    # reset work tree and index
+    # NB: untracked files which were not added are untouched
+    git apply --cached -R "$index"
+    git apply -R "$tree"
+
+    # Fix index
+    # For end of file newlines we must go through the worktree
+    1>&2 echo "Fixing staged changes..."
+    git apply --cached --whitespace=fix "$index"
+    git apply --whitespace=fix "$index" 2>/dev/null # no need to repeat yourself
+    git diff --cached --name-only -z | xargs -0 dev/tools/check-eof-newline.sh --fix
+    git add -u
+    1>&2 echo #newline
+
+    # reset work tree
+    git diff-index -p --cached HEAD > "$fixed_index"
+    # If all changes were bad whitespace changes the patch is empty
+    # making git fail. Don't fail now: we fix the worktree first.
+    if [ -s "$fixed_index" ]
+    then
+        git apply -R "$fixed_index"
+    fi
+
+    # Fix worktree
+    1>&2 echo "Fixing unstaged changes..."
+    git apply --whitespace=fix "$tree"
+    git diff --name-only -z | xargs -0 dev/tools/check-eof-newline.sh --fix
+    1>&2 echo #newline
+
+    if ! [ -s "$fixed_index" ]
+    then
+        1>&2 echo "No changes after fixing whitespace issues!"
+        exit 1
+    fi
+
+    # Check that we did fix whitespace
+    if ! git diff-index --check --cached HEAD;
+    then
+        1>&2 echo "Auto-fixing whitespace failed: errors remain."
+        1>&2 echo "This may fix itself if you try again."
+        1>&2 echo "(Consider whether the number of errors decreases after each run.)"
+        exit 1
+    fi
+    1>&2 echo "Whitespace issues fixed!"
+
+    # clean up temporary files
+    rm "$index" "$tree" "$fixed_index"
+fi
diff --git a/dev/tools/sudo-apt-get-update.sh b/dev/tools/sudo-apt-get-update.sh
new file mode 100755
index 000000000..f8bf6bed4
--- /dev/null
+++ b/dev/tools/sudo-apt-get-update.sh
@@ -0,0 +1,4 @@
+#!/usr/bin/env bash
+
+(sudo apt-get update "$@" 2>&1 || echo 'E: update failed') | tee /tmp/apt.err
+! grep -q '^\(E:\|W: Failed to fetch\)' /tmp/apt.err || exit $?
diff --git a/dev/top_printers.ml b/dev/top_printers.ml
index ffa8fffdf..f99e2593d 100644
--- a/dev/top_printers.ml
+++ b/dev/top_printers.ml
@@ -8,17 +8,16 @@
 
 (* Printers for the ocaml toplevel. *)
 
+open Sorts
 open Util
 open Pp
 open Names
 open Libnames
 open Globnames
-open Nameops
 open Univ
 open Environ
 open Printer
-open Term
-open Evd
+open Constr
 open Goptions
 open Genarg
 open Clenv
@@ -37,41 +36,40 @@ let ppfuture kx = pp (Future.print (fun _ -> str "_") kx)
 
 (* name printers *)
 let ppid id = pp (Id.print id)
-let pplab l = pp (pr_lab l)
+let pplab l = pp (Label.print l)
 let ppmbid mbid = pp (str (MBId.debug_to_string mbid))
-let ppdir dir = pp (pr_dirpath dir)
+let ppdir dir = pp (DirPath.print dir)
 let ppmp mp = pp(str (ModPath.debug_to_string mp))
-let ppcon con = pp(debug_pr_con con)
-let ppproj con = pp(debug_pr_con (Projection.constant con))
+let ppcon con = pp(Constant.debug_print con)
+let ppproj con = pp(Constant.debug_print (Projection.constant con))
 let ppkn kn = pp(str (KerName.to_string kn))
-let ppmind kn = pp(debug_pr_mind kn)
-let ppind (kn,i) = pp(debug_pr_mind kn ++ str"," ++int i)
+let ppmind kn = pp(MutInd.debug_print kn)
+let ppind (kn,i) = pp(MutInd.debug_print kn ++ str"," ++int i)
 let ppsp sp = pp(pr_path sp)
 let ppqualid qid = pp(pr_qualid qid)
 let ppclindex cl = pp(Classops.pr_cl_index cl)
 let ppscheme k = pp (Ind_tables.pr_scheme_kind k)
 
-let pprecarg = function
+let prrecarg = function
   | Declarations.Norec -> str "Norec"
   | Declarations.Mrec (mind,i) ->
      str "Mrec[" ++ MutInd.print mind ++ pr_comma () ++ int i ++ str "]"
   | Declarations.Imbr (mind,i) ->
      str "Imbr[" ++ MutInd.print mind ++ pr_comma () ++ int i ++ str "]"
-let ppwf_paths x = pp (Rtree.pp_tree pprecarg x)
+let ppwf_paths x = pp (Rtree.pp_tree prrecarg x)
 
 (* term printers *)
+let envpp pp = let sigma,env = Pfedit.get_current_context () in pp env sigma
 let rawdebug = ref false
-let ppevar evk = pp (str (Evd.string_of_existential evk))
+let ppevar evk = pp (Evar.print evk)
 let ppconstr x = pp (Termops.print_constr (EConstr.of_constr x))
 let ppeconstr x = pp (Termops.print_constr x)
 let ppconstr_expr x = pp (Ppconstr.pr_constr_expr x)
-let ppconstrdb x = pp(Flags.with_option rawdebug Termops.print_constr (EConstr.of_constr x))
-let ppterm = ppconstr
 let ppsconstr x = ppconstr (Mod_subst.force_constr x)
 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 ppglob_constr = (fun x -> pp(pr_lglob_constr_env (Global.env()) x))
+let pppattern = (fun x -> pp(envpp pr_constr_pattern_env x))
+let pptype = (fun x -> try pp(envpp pr_ltype_env x) with e -> pp (str (Printexc.to_string e)))
 let ppfconstr c = ppconstr (CClosure.term_of_fconstr c)
 
 let ppbigint n = pp (str (Bigint.to_string n));;
@@ -85,9 +83,14 @@ let prset' pr l = str "[" ++ hov 0 (prlist_with_sep pr_comma pr l) ++ str "]"
 let pridmap pr l =
   let pr (id,b) = Id.print id ++ str "=>" ++ pr id b in
   prset' pr (Id.Map.fold (fun a b l -> (a,b)::l) l [])
-
 let ppidmap pr l = pp (pridmap pr l)
 
+let pridmapgen l =
+  let dom = Id.Set.elements (Id.Map.domain l) in
+  if dom = [] then str "[]" else
+  str "[domain= " ++ hov 0 (prlist_with_sep spc Id.print dom) ++ str "]"
+let ppidmapgen l = pp (pridmapgen l)
+
 let ppevarsubst = ppidmap (fun id0 -> prset (fun (c,copt,id) ->
   hov 0
   (Termops.print_constr (EConstr.of_constr c) ++
@@ -106,10 +109,9 @@ let prconstrunderbindersidmap = pridmap (fun _ (l,c) ->
 let ppconstrunderbindersidmap l = pp (prconstrunderbindersidmap l)
 
 let ppunbound_ltac_var_map l = ppidmap (fun _ arg ->
-  str"<genarg:" ++ pr_argument_type(genarg_tag arg) ++ str">")
-
-open Glob_term
+  str"<genarg:" ++ pr_argument_type(genarg_tag arg) ++ str">") l
 
+open Ltac_pretype
 let rec pr_closure {idents=idents;typed=typed;untyped=untyped} =
   hov 1 (str"{idents=" ++ prididmap idents ++ str";" ++ spc() ++
          str"typed=" ++ prconstrunderbindersidmap typed ++ str";" ++ spc() ++
@@ -117,7 +119,7 @@ let rec pr_closure {idents=idents;typed=typed;untyped=untyped} =
 and pr_closed_glob_constr_idmap x =
   pridmap (fun _ -> pr_closed_glob_constr) x
 and pr_closed_glob_constr {closure=closure;term=term} =
-  pr_closure closure ++ pr_lglob_constr term
+  pr_closure closure ++ (pr_lglob_constr_env Global.(env ())) term
 
 let ppclosure x = pp (pr_closure x)
 let ppclosedglobconstr x = pp (pr_closed_glob_constr x)
@@ -126,27 +128,27 @@ let ppclosedglobconstridmap x = pp (pr_closed_glob_constr_idmap x)
 let pP s = pp (hov 0 s)
 
 let safe_pr_global = function
-  | ConstRef kn -> pp (str "CONSTREF(" ++ debug_pr_con kn ++ str ")")
-  | IndRef (kn,i) -> pp (str "INDREF(" ++ debug_pr_mind kn ++ str "," ++
+  | ConstRef kn -> pp (str "CONSTREF(" ++ Constant.debug_print kn ++ str ")")
+  | IndRef (kn,i) -> pp (str "INDREF(" ++ MutInd.debug_print kn ++ str "," ++
 			  int i ++ str ")")
-  | ConstructRef ((kn,i),j) -> pp (str "INDREF(" ++ debug_pr_mind kn ++ str "," ++
+  | ConstructRef ((kn,i),j) -> pp (str "INDREF(" ++ MutInd.debug_print kn ++ str "," ++
 				      int i ++ str "," ++ int j ++ str ")")
   | VarRef id -> pp (str "VARREF(" ++ Id.print id ++ str ")")
 
 let ppglobal x = try pp(pr_global x) with _ -> safe_pr_global x
 
 let ppconst (sp,j) =
-    pp (str"#" ++ KerName.print sp ++ str"=" ++ pr_lconstr j.uj_val)
+    pp (str"#" ++ KerName.print sp ++ str"=" ++ envpp pr_lconstr_env j.uj_val)
 
 let ppvar ((id,a)) =
-    pp (str"#" ++ Id.print id ++ str":" ++ pr_lconstr a)
+    pp (str"#" ++ Id.print id ++ str":" ++ envpp pr_lconstr_env a)
 
 let genppj f j = let (c,t) = f j in (c ++ str " : " ++ t)
 
-let ppj j = pp (genppj pr_ljudge j)
+let ppj j = pp (genppj (envpp pr_ljudge_env) j)
 
-let prsubst s = pp (Mod_subst.debug_pr_subst s)
-let prdelta s = pp (Mod_subst.debug_pr_delta s)
+let ppsubst s = pp (Mod_subst.debug_pr_subst s)
+let ppdelta s = pp (Mod_subst.debug_pr_delta s)
 
 let pp_idpred s = pp (pr_idpred s)
 let pp_cpred s = pp (pr_cpred s)
@@ -171,13 +173,13 @@ let ppclenv clenv = pp(pr_clenv clenv)
 let ppgoalgoal gl = pp(Goal.pr_goal gl)
 let ppgoal g = pp(Printer.pr_goal g)
 let ppgoalsigma g = pp(Printer.pr_goal g ++ Termops.pr_evar_map None (Refiner.project g))
-let pphintdb db = pp(Hints.pr_hint_db db)
+let pphintdb db = pp(envpp Hints.pr_hint_db_env db)
 let ppproofview p =
   let gls,sigma = Proofview.proofview p in
   pp(pr_enum Goal.pr_goal gls ++ fnl () ++ Termops.pr_evar_map (Some 1) sigma)
 
 let ppopenconstr (x : Evd.open_constr) =
-  let (evd,c) = x in pp (Termops.pr_evar_map (Some 2) evd ++ pr_constr c)
+  let (evd,c) = x in pp (Termops.pr_evar_map (Some 2) evd ++ envpp pr_constr_env c)
 (* spiwack: deactivated until a replacement is found
 let pppftreestate p = pp(print_pftreestate p)
 *)
@@ -196,9 +198,8 @@ let pppftreestate p = pp(print_pftreestate p)
 
 let pproof p = pp(Proof.pr_proof p)
 
-let ppuni u = pp(pr_uni u)
+let ppuni u = pp(Universe.pr u)
 let ppuni_level u = pp (Level.pr u)
-let ppuniverse u = pp (str"[" ++ Universe.pr u ++ str"]")
 
 let prlev = Universes.pr_with_global_universes
 let ppuniverse_set l = pp (LSet.pr prlev l)
@@ -227,9 +228,9 @@ let ppenv e = pp
 let ppenvwithcst e = pp
   (str "[" ++ pr_named_context_of e Evd.empty ++ str "]" ++ spc() ++
    str "[" ++ pr_rel_context e Evd.empty (rel_context e) ++ str "]" ++ spc() ++
-   str "{" ++ Cmap_env.fold (fun a _ s -> pr_con a ++ spc () ++ s) (Obj.magic e).Pre_env.env_globals.Pre_env.env_constants (mt ()) ++ str "}")
+   str "{" ++ Cmap_env.fold (fun a _ s -> Constant.print a ++ spc () ++ s) (Obj.magic e).Pre_env.env_globals.Pre_env.env_constants (mt ()) ++ str "}")
 
-let pptac = (fun x -> pp(Ltac_plugin.Pptactic.pr_glob_tactic (API.Global.env()) x))
+let pptac = (fun x -> pp(Ltac_plugin.Pptactic.pr_glob_tactic (Global.env()) x))
 
 let ppobj obj = Format.print_string (Libobject.object_tag obj)
 
@@ -243,7 +244,7 @@ let cast_kind_display k =
   | NATIVEcast -> "NATIVEcast"
 
 let constr_display csr =
-  let rec term_display c = match kind_of_term c with
+  let rec term_display c = match kind c with
   | Rel n -> "Rel("^(string_of_int n)^")"
   | Meta n -> "Meta("^(string_of_int n)^")"
   | Var id -> "Var("^(Id.to_string id)^")"
@@ -258,14 +259,14 @@ let constr_display csr =
       "LetIn("^(name_display na)^","^(term_display b)^","
       ^(term_display t)^","^(term_display c)^")"
   | App (c,l) -> "App("^(term_display c)^","^(array_display l)^")\n"
-  | Evar (e,l) -> "Evar("^(string_of_existential e)^","^(array_display l)^")"
-  | Const (c,u) -> "Const("^(string_of_con c)^","^(universes_display u)^")"
+  | Evar (e,l) -> "Evar("^(Pp.string_of_ppcmds (Evar.print e))^","^(array_display l)^")"
+  | Const (c,u) -> "Const("^(Constant.to_string c)^","^(universes_display u)^")"
   | Ind ((sp,i),u) ->
-      "MutInd("^(string_of_mind sp)^","^(string_of_int i)^","^(universes_display u)^")"
+      "MutInd("^(MutInd.to_string sp)^","^(string_of_int i)^","^(universes_display u)^")"
   | Construct (((sp,i),j),u) ->
-      "MutConstruct(("^(string_of_mind sp)^","^(string_of_int i)^"),"
+      "MutConstruct(("^(MutInd.to_string sp)^","^(string_of_int i)^"),"
       ^","^(universes_display u)^(string_of_int j)^")"
-  | Proj (p, c) -> "Proj("^(string_of_con (Projection.constant p))^","^term_display c ^")"
+  | Proj (p, c) -> "Proj("^(Constant.to_string (Projection.constant p))^","^term_display c ^")"
   | Case (ci,p,c,bl) ->
       "MutCase(<abs>,"^(term_display p)^","^(term_display c)^","
       ^(array_display bl)^")"
@@ -315,7 +316,7 @@ let constr_display csr =
 open Format;;
 
 let print_pure_constr csr =
-  let rec term_display c = match kind_of_term c with
+  let rec term_display c = match Constr.kind c with
   | Rel n -> print_string "#"; print_int n
   | Meta n -> print_string "Meta("; print_int n; print_string ")"
   | Var id -> print_string (Id.to_string id)
@@ -433,7 +434,7 @@ let print_pure_constr csr =
 	| ("Coq"::_::l) -> l
 	| l             -> l
     in  List.iter (fun x -> print_string x; print_string ".") ls;*)
-      print_string (debug_string_of_mind sp)
+      print_string (MutInd.debug_to_string sp)
   and sp_con_display sp =
 (*    let dir,l = decode_kn sp in
     let ls =
@@ -442,7 +443,7 @@ let print_pure_constr csr =
 	| ("Coq"::_::l) -> l
 	| l             -> l
     in  List.iter (fun x -> print_string x; print_string ".") ls;*)
-      print_string (debug_string_of_con sp)
+      print_string (Constant.debug_to_string sp)
 
   in
     try
@@ -484,7 +485,7 @@ let in_current_context f c =
   let (evmap,sign) = Pfedit.get_current_context () in
   f (fst (Constrintern.interp_constr sign evmap c))(*FIXME*)
 
-(* We expand the result of preprocessing to be independent of camlp4
+(* We expand the result of preprocessing to be independent of camlp5
 
 VERNAC COMMAND EXTEND PrintPureConstr
 | [ "PrintPureConstr" constr(c) ] -> [ in_current_context print_pure_constr c ]
@@ -504,7 +505,7 @@ let _ =
       (function
          [c] when genarg_tag c = unquote (topwit wit_constr) && true ->
            let c = out_gen (rawwit wit_constr) c in
-           (fun () -> in_current_context constr_display c)
+           (fun ~atts ~st -> in_current_context constr_display c; st)
        | _ -> failwith "Vernac extension: cannot occur")
   with
     e -> pp (CErrors.print e)
@@ -520,7 +521,7 @@ let _ =
       (function
          [c] when genarg_tag c = unquote (topwit wit_constr) && true ->
            let c = out_gen (rawwit wit_constr) c in
-           (fun () -> in_current_context print_pure_constr c)
+           (fun ~atts ~st -> in_current_context print_pure_constr c; st)
        | _ -> failwith "Vernac extension: cannot occur")
   with
     e -> pp (CErrors.print e)
diff --git a/dev/top_printers.mli b/dev/top_printers.mli
new file mode 100644
index 000000000..7b5e4a0b6
--- /dev/null
+++ b/dev/top_printers.mli
@@ -0,0 +1,173 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Printers for the ocaml toplevel. *)
+
+val pp : Pp.t -> unit
+val pP : Pp.t -> unit (* with surrounding box *)
+
+val ppfuture : 'a Future.computation -> unit
+
+val ppid : Names.Id.t -> unit
+val pplab : Names.Label.t -> unit
+val ppmbid : Names.MBId.t -> unit
+val ppdir : Names.DirPath.t -> unit
+val ppmp : Names.ModPath.t -> unit
+val ppcon : Names.Constant.t -> unit
+val ppproj : Names.Projection.t -> unit
+val ppkn : Names.KerName.t -> unit
+val ppmind : Names.MutInd.t -> unit
+val ppind : Names.inductive -> unit
+
+val ppsp : Libnames.full_path -> unit
+val ppqualid : Libnames.qualid -> unit
+
+val ppclindex : Classops.cl_index -> unit
+
+val ppscheme : 'a Ind_tables.scheme_kind -> unit
+
+val prrecarg : Declarations.recarg -> Pp.t
+val ppwf_paths : Declarations.recarg Rtree.t -> unit
+
+val pr_evar : Evar.t -> Pp.t
+val ppevar : Evar.t -> unit
+
+(* Multiple printers for Constr.t *)
+val ppconstr : Constr.t -> unit (* by Termops printer *)
+val ppconstr_univ : Constr.t -> unit
+
+(* Extern as type *)
+val pptype : Constr.types -> unit
+
+val ppsconstr : Constr.constr Mod_subst.substituted -> unit
+val ppeconstr : EConstr.constr -> unit (* Termops printer *)
+val ppconstr_expr : Constrexpr.constr_expr -> unit
+val ppglob_constr : 'a Glob_term.glob_constr_g -> unit
+val pppattern : Pattern.constr_pattern -> unit
+val ppfconstr : CClosure.fconstr -> unit
+
+val ppbigint : Bigint.bigint -> unit
+
+val ppintset : Int.Set.t -> unit
+val ppidset : Names.Id.Set.t -> unit
+
+val pridmap : (Names.Id.Map.key -> 'a -> Pp.t) -> 'a Names.Id.Map.t -> Pp.t
+val ppidmap : (Names.Id.Map.key -> 'a -> Pp.t) -> 'a Names.Id.Map.t -> unit
+
+val pridmapgen : 'a Names.Id.Map.t -> Pp.t
+val ppidmapgen : 'a Names.Id.Map.t -> unit
+
+val prididmap : Names.Id.t Names.Id.Map.t -> Pp.t
+val ppididmap : Names.Id.t Names.Id.Map.t -> unit
+
+val prconstrunderbindersidmap :
+  (Names.Id.t list * EConstr.constr) Names.Id.Map.t -> Pp.t
+val ppconstrunderbindersidmap :
+  (Names.Id.t list * EConstr.constr) Names.Id.Map.t -> unit
+
+val ppevarsubst :
+  (Constr.t * Constr.t option * Names.Id.Map.key) list Names.Id.Map.t -> unit
+
+val ppunbound_ltac_var_map :
+  'a Genarg.generic_argument Names.Id.Map.t -> unit
+
+val pr_closure : Ltac_pretype.closure -> Pp.t
+val pr_closed_glob_constr_idmap :
+  Ltac_pretype.closed_glob_constr Names.Id.Map.t -> Pp.t
+val pr_closed_glob_constr : Ltac_pretype.closed_glob_constr -> Pp.t
+val ppclosure : Ltac_pretype.closure -> unit
+val ppclosedglobconstr : Ltac_pretype.closed_glob_constr -> unit
+val ppclosedglobconstridmap :
+  Ltac_pretype.closed_glob_constr Names.Id.Map.t -> unit
+
+val ppglobal : Globnames.global_reference -> unit
+
+val ppconst :
+  Names.KerName.t * (Constr.constr, 'a) Environ.punsafe_judgment -> unit
+val ppvar : Names.Id.t * Constr.constr -> unit
+
+val genppj : ('a -> Pp.t * Pp.t) -> 'a -> Pp.t
+val ppj : EConstr.unsafe_judgment -> unit
+
+val ppsubst : Mod_subst.substitution -> unit
+val ppdelta : Mod_subst.delta_resolver -> unit
+
+val pp_idpred : Names.Id.Pred.t -> unit
+val pp_cpred : Names.Cpred.t -> unit
+val pp_transparent_state : Names.transparent_state -> unit
+
+val pp_stack_t : Constr.t Reductionops.Stack.t -> unit
+val pp_cst_stack_t : Reductionops.Cst_stack.t -> unit
+val pp_state_t : Reductionops.state -> unit
+
+val ppmetas : Evd.Metaset.t -> unit
+val ppevm : Evd.evar_map -> unit
+val ppevmall : Evd.evar_map -> unit
+
+val pr_existentialset : Evar.Set.t -> Pp.t
+val ppexistentialset : Evar.Set.t -> unit
+
+val ppexistentialfilter : Evd.Filter.t -> unit
+
+val ppclenv : Clenv.clausenv -> unit
+
+val ppgoalgoal : Goal.goal -> unit
+
+val ppgoal : Proof_type.goal Evd.sigma -> unit
+(* also print evar map *)
+val ppgoalsigma : Proof_type.goal Evd.sigma -> unit
+
+val pphintdb : Hints.Hint_db.t -> unit
+val ppproofview : Proofview.proofview -> unit
+val ppopenconstr : Evd.open_constr -> unit
+
+val pproof : Proof.t -> unit
+
+(* Universes *)
+val ppuni : Univ.Universe.t -> unit
+val ppuni_level : Univ.Level.t -> unit (* raw *)
+val prlev : Univ.Level.t -> Pp.t (* with global names (does this work?) *)
+val ppuniverse_set : Univ.LSet.t -> unit
+val ppuniverse_instance : Univ.Instance.t -> unit
+val ppuniverse_context : Univ.UContext.t -> unit
+val ppuniverse_context_set : Univ.ContextSet.t -> unit
+val ppuniverse_subst : Univ.universe_subst -> unit
+val ppuniverse_opt_subst : Universes.universe_opt_subst -> unit
+val ppuniverse_level_subst : Univ.universe_level_subst -> unit
+val ppevar_universe_context : UState.t -> unit
+val ppconstraints : Univ.Constraint.t -> unit
+val ppuniverseconstraints : Universes.Constraints.t -> unit
+val ppuniverse_context_future : Univ.UContext.t Future.computation -> unit
+val ppcumulativity_info : Univ.CumulativityInfo.t -> unit
+val ppabstract_cumulativity_info : Univ.ACumulativityInfo.t -> unit
+val ppuniverses : UGraph.t -> unit
+
+val ppnamedcontextval : Environ.named_context_val -> unit
+val ppenv : Environ.env -> unit
+val ppenvwithcst : Environ.env -> unit
+
+val pptac : Tacexpr.glob_tactic_expr -> unit
+
+val ppobj : Libobject.obj -> unit
+
+(* Some super raw printers *)
+val cast_kind_display : Constr.cast_kind -> string
+val constr_display : Constr.constr -> unit
+val print_pure_constr : Constr.types -> unit
+
+val pploc : Loc.t -> unit
+
+val pp_argument_type : Genarg.argument_type -> unit
+val pp_generic_argument : 'a Genarg.generic_argument -> unit
+
+val prgenarginfo : Geninterp.Val.t -> Pp.t
+val ppgenarginfo : Geninterp.Val.t -> unit
+
+val ppgenargargt : ('a, 'b, 'c) Genarg.ArgT.tag -> unit
+
+val ppist : Geninterp.interp_sign -> unit
diff --git a/dev/vm_printers.ml b/dev/vm_printers.ml
index afa94a63e..f819d2e6a 100644
--- a/dev/vm_printers.ml
+++ b/dev/vm_printers.ml
@@ -3,18 +3,18 @@ open Term
 open Names
 open Cbytecodes
 open Cemitcodes
-open Vm
+open Vmvalues
 
 let ppripos (ri,pos) =
   (match ri with
   | Reloc_annot a ->
       let sp,i = a.ci.ci_ind in
       print_string
-	("annot : MutInd("^(string_of_mind sp)^","^(string_of_int i)^")\n")
+	("annot : MutInd("^(MutInd.to_string sp)^","^(string_of_int i)^")\n")
   | Reloc_const _ ->
       print_string "structured constant\n"
   | Reloc_getglobal kn ->
-      print_string ("getglob "^(string_of_con kn)^"\n"));
+      print_string ("getglob "^(Constant.to_string kn)^"\n"));
    print_flush ()
 
 let print_vfix () = print_string "vfix"
@@ -32,7 +32,7 @@ let print_idkey idk =
   match idk with
   | ConstKey sp ->
       print_string "Cons(";
-      print_string (string_of_con sp);
+      print_string (Constant.to_string sp);
       print_string ")"
   | VarKey id -> print_string (Id.to_string id)
   | RelKey i -> print_string "~";print_int i
@@ -63,7 +63,7 @@ and ppatom a =
   | Aid idk -> print_idkey idk
   | Atype u -> print_string "Type(...)"
   | Aind(sp,i) ->  print_string "Ind(";
-      print_string (string_of_mind sp);
+      print_string (MutInd.to_string sp);
       print_string ","; print_int i;
       print_string ")"
 
diff --git a/doc/common/macros.tex b/doc/common/macros.tex
index 0a4251a37..6a28c5b3d 100644
--- a/doc/common/macros.tex
+++ b/doc/common/macros.tex
@@ -94,8 +94,8 @@
 \newcommand{\gallina}{\textsc{Gallina}}
 \newcommand{\Gallina}{\textsc{Gallina}}
 \newcommand{\CoqIDE}{\textsc{CoqIDE}}
-\newcommand{\ocaml}{\textsc{Objective Caml}}
-\newcommand{\camlpppp}{\textsc{Camlp4}}
+\newcommand{\ocaml}{\textsc{OCaml}}
+\newcommand{\camlpppp}{\textsc{Camlp5}}
 \newcommand{\emacs}{\textsc{GNU Emacs}}
 \newcommand{\ProofGeneral}{\textsc{Proof General}}
 \newcommand{\CIC}{\textsc{Cic}}
@@ -182,6 +182,7 @@
 \newcommand{\declnotation}{\nterm{decl\_notation}} 
 \newcommand{\symbolentry}{\nterm{symbol}}
 \newcommand{\modifiers}{\nterm{modifiers}}
+\newcommand{\binderinterp}{\nterm{binder\_interp}}
 \newcommand{\localdef}{\nterm{local\_def}}
 \newcommand{\localdecls}{\nterm{local\_decls}}
 \newcommand{\ident}{\nterm{ident}}
diff --git a/doc/common/styles/html/coqremote/cover.html b/doc/common/styles/html/coqremote/cover.html
index 1c415eca6..5d151381f 100644
--- a/doc/common/styles/html/coqremote/cover.html
+++ b/doc/common/styles/html/coqremote/cover.html
@@ -52,20 +52,7 @@
 <h2 style="text-align:center; font-size: 150%">The Coq Development Team</h2>
 <br /><br /><br />
 
-<div style="text-align: left; font-size: 80%; text-indent: 0pt">
-<ul style="list-style: none; margin-left: 0pt">
-  <li>V7.x © INRIA 1999-2004</li>
-  <li>V8.0 © INRIA 2004-2008</li>
-  <li>V8.1 © INRIA 2006-2011</li>
-  <li>V8.2 © INRIA 2008-2011</li>
-  <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
-  working group ``Types''</p>
+<p style="text-indent:0pt">Copyright © INRIA 1999-2017</p>
 
 <p style="text-indent:0pt">This material may be distributed only subject to the terms and conditions set forth in the Open Publication License, v1.0 or later (the latest version is presently available at <a href="http://www.opencontent.org/openpub">http://www.opencontent.org/openpub</a>). Options A and B are not elected.</p>
 
diff --git a/doc/common/styles/html/simple/cover.html b/doc/common/styles/html/simple/cover.html
index 25fb56320..605313104 100644
--- a/doc/common/styles/html/simple/cover.html
+++ b/doc/common/styles/html/simple/cover.html
@@ -30,20 +30,7 @@
 <br /><br /><br />
 
 
-<div style="text-align: left; font-size: 80%; text-indent: 0pt">
-<ul style="list-style: none; margin-left: 0pt">
-  <li>V7.x © INRIA 1999-2004</li>
-  <li>V8.0 © INRIA 2004-2008</li>
-  <li>V8.1 © INRIA 2006-2011</li>
-  <li>V8.2 © INRIA 2008-2011</li>
-  <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
-  working group ``Types''</p>
+<p style="text-indent:0pt">Copyright © INRIA 1999-2017</p>
 
 <p style="text-indent: 0pt">This material may be distributed only subject to the terms and conditions set forth in the Open Publication License, v1.0 or later (the latest version is presently available at <a href="http://www.opencontent.org/openpub">http://www.opencontent.org/openpub</a>). Options A and B are not elected.</p>
 
diff --git a/doc/common/styles/html/simple/style.css b/doc/common/styles/html/simple/style.css
index 0b1e640b3..d1b2ce111 100644
--- a/doc/common/styles/html/simple/style.css
+++ b/doc/common/styles/html/simple/style.css
@@ -10,4 +10,4 @@
     margin: 0pt;
     padding: .5ex 1em;
     list-style: none 
-}
\ No newline at end of file
+}
diff --git a/doc/faq/FAQ.tex b/doc/faq/FAQ.tex
deleted file mode 100644
index 213fb0313..000000000
--- a/doc/faq/FAQ.tex
+++ /dev/null
@@ -1,2714 +0,0 @@
-\RequirePackage{ifpdf}
-\ifpdf   % si on est en pdflatex
-\documentclass[a4paper,pdftex]{article}
-\else
-\documentclass[a4paper]{article}
-\fi
-\pagestyle{plain}
-
-% yay les symboles
-\usepackage{textcomp}
-\usepackage{stmaryrd}
-\usepackage{amssymb}
-\usepackage{url}
-%\usepackage{multicol}
-\usepackage{hevea}
-\usepackage{fullpage}
-\usepackage[utf8]{inputenc}
-\usepackage[english]{babel}
-
-\ifpdf   % si on est en pdflatex
-  \usepackage[pdftex]{graphicx}
-\else
-  \usepackage[dvips]{graphicx}
-\fi
-
-%\input{../macros.tex}
-
-% Making hevea happy
-%HEVEA \renewcommand{\textbar}{|}
-%HEVEA \renewcommand{\textunderscore}{\_}
-
-\def\Question#1{\stepcounter{question}\subsubsection{#1}}
-
-% version et date
-\def\faqversion{0.1}
-
-% les macros d'amour
-\def\Coq{\textsc{Coq}}
-\def\Why{\textsc{Why}}
-\def\Framac{\textsc{Frama-c}}
-\def\Krakatoa{\textsc{Krakatoa}}
-\def\Ltac{\textsc{Ltac}}
-\def\CoqIde{\textsc{CoqIde}}
-
-\newcommand{\coqtt}[1]{{\tt #1}}
-\newcommand{\coqimp}{{\mbox{\tt ->}}}
-\newcommand{\coqequiv}{{\mbox{\tt <->}}}
-
-
-% macro pour les tactics
-\def\split{{\tt split}}
-\def\assumption{{\tt assumption}}
-\def\auto{{\tt auto}}
-\def\trivial{{\tt trivial}}
-\def\tauto{{\tt tauto}}
-\def\left{{\tt left}}
-\def\right{{\tt right}}
-\def\decompose{{\tt decompose}}
-\def\intro{{\tt intro}}
-\def\intros{{\tt intros}}
-\def\field{{\tt field}}
-\def\ring{{\tt ring}}
-\def\apply{{\tt apply}}
-\def\exact{{\tt exact}}
-\def\cut{{\tt cut}}
-\def\assert{{\tt assert}}
-\def\solve{{\tt solve}}
-\def\idtac{{\tt idtac}}
-\def\fail{{\tt fail}}
-\def\existstac{{\tt exists}}
-\def\firstorder{{\tt firstorder}}
-\def\congruence{{\tt congruence}}
-\def\gb{{\tt gb}}
-\def\generalize{{\tt generalize}}
-\def\abstracttac{{\tt abstract}}
-\def\eapply{{\tt eapply}}
-\def\unfold{{\tt unfold}}
-\def\rewrite{{\tt rewrite}}
-\def\replace{{\tt replace}}
-\def\simpl{{\tt simpl}}
-\def\elim{{\tt elim}}
-\def\set{{\tt set}}
-\def\pose{{\tt pose}}
-\def\case{{\tt case}}
-\def\destruct{{\tt destruct}}
-\def\reflexivity{{\tt reflexivity}}
-\def\transitivity{{\tt transitivity}}
-\def\symmetry{{\tt symmetry}}
-\def\Focus{{\tt Focus}}
-\def\discriminate{{\tt discriminate}}
-\def\contradiction{{\tt contradiction}}
-\def\intuition{{\tt intuition}}
-\def\try{{\tt try}}
-\def\repeat{{\tt repeat}}
-\def\eauto{{\tt eauto}}
-\def\subst{{\tt subst}}
-\def\symmetryin{{\tt symmetryin}}
-\def\instantiate{{\tt instantiate}}
-\def\inversion{{\tt inversion}}
-\def\specialize{{\tt specialize}}
-\def\Defined{{\tt Defined}}
-\def\Qed{{\tt Qed}}
-\def\pattern{{\tt pattern}}
-\def\Type{{\tt Type}}
-\def\Prop{{\tt Prop}}
-\def\Set{{\tt Set}}
-
-
-\newcommand\vfile[2]{\ahref{#1}{\tt {#2}.v}}
-\urldef{\InitWf}\url
-  {http://coq.inria.fr/library/Coq.Init.Wf.html}
-\urldef{\LogicBerardi}\url
-  {http://coq.inria.fr/library/Coq.Logic.Berardi.html}
-\urldef{\LogicClassical}\url
-  {http://coq.inria.fr/library/Coq.Logic.Classical.html}
-\urldef{\LogicClassicalFacts}\url
-  {http://coq.inria.fr/library/Coq.Logic.ClassicalFacts.html}
-\urldef{\LogicClassicalDescription}\url
-  {http://coq.inria.fr/library/Coq.Logic.ClassicalDescription.html}
-\urldef{\LogicProofIrrelevance}\url
-  {http://coq.inria.fr/library/Coq.Logic.ProofIrrelevance.html}
-\urldef{\LogicEqdep}\url
-  {http://coq.inria.fr/library/Coq.Logic.Eqdep.html}
-\urldef{\LogicEqdepDec}\url
-  {http://coq.inria.fr/library/Coq.Logic.Eqdep_dec.html}
-
-
-
-
-\begin{document}
-\bibliographystyle{plain}
-\newcounter{question}
-\renewcommand{\thesubsubsection}{\arabic{question}}
-
-%%%%%%% Coq pour les nuls %%%%%%%
-
-\title{Coq Version 8.4 for the Clueless\\
-  \large(\protect\ref{lastquestion}
-  \ Hints)
-}
-\author{Pierre Castéran \and Hugo Herbelin \and Florent Kirchner \and Benjamin Monate \and Julien Narboux}
-\maketitle
-
-%%%%%%%
-
-\begin{abstract}
-This note intends to provide an easy way to get acquainted with the
-{\Coq} theorem prover. It tries to formulate appropriate answers
-to some of the questions any newcomers will face, and to give
-pointers to other references when possible.
-\end{abstract}
-
-%%%%%%%
-
-%\begin{multicols}{2}
-\tableofcontents
-%\end{multicols}
-
-%%%%%%%
-
-\newpage
-
-\section{Introduction}
-This FAQ is the sum of the questions that came to mind as we developed
-proofs in \Coq. Since we are singularly short-minded, we wrote the
-answers we found on bits of papers to have them at hand whenever the
-situation occurs again. This is pretty much the result of that: a
-collection of tips one can refer to when proofs become intricate. Yes,
-it means we won't take the blame for the shortcomings of this
-FAQ. But if you want to contribute and send in your own question and
-answers, feel free to write to us\ldots
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-\section{Presentation}
-
-\Question{What is {\Coq}?}\label{whatiscoq} 
-The {\Coq} tool is a formal proof management system: a proof done with {\Coq} is mechanically checked by the machine. 
-In particular, {\Coq} allows:
-\begin{itemize}
-    \item the definition of mathematical objects and programming objects,
-    \item to state mathematical theorems and software specifications,
-    \item to interactively develop formal proofs of these theorems,
-    \item to check these proofs by a small certification ``kernel''.
-\end{itemize}
-{\Coq} is based on a logical framework called ``Calculus of Inductive
-Constructions'' extended by a modular development system for theories.
-
-\Question{Did you really need to name it like that?}
-Some French computer scientists have a tradition of naming their
-software as animal species: Caml, Elan, Foc or Phox are examples
-of this tacit convention. In French, ``coq'' means rooster, and it
-sounds like the initials of the Calculus of Constructions CoC on which
-it is based.
-
-\Question{Is {\Coq} a theorem prover?}
-
-{\Coq} comes with decision and semi-decision procedures (
-propositional calculus, Presburger's arithmetic, ring and field
-simplification, resolution, ...) but the main style for proving
-theorems is interactively by using LCF-style tactics.
-
-
-\Question{What are the other theorem provers?} 
-Many other theorem provers are available for use nowadays. 
-Isabelle, HOL, HOL Light, Lego, Nuprl, PVS are examples of provers that are fairly similar
-to {\Coq} by the way they interact with the user. Other relatives of
-{\Coq} are ACL2, Agda/Alfa, Twelf, Kiv, Mizar, NqThm, 
-\begin{htmlonly}%
-Omega\ldots
-\end{htmlonly}
-\begin{latexonly}%
-{$\Omega$}mega\ldots
-\end{latexonly}
-
-\Question{What do I have to trust when I see a proof checked by Coq?}
-
-You have to trust:
-
-\begin{description}
-\item[The theory behind Coq] The theory of {\Coq} version 8.0 is
-generally admitted to be consistent wrt Zermelo-Fraenkel set theory +
-inaccessible cardinals. Proofs of consistency of subsystems of the
-theory of Coq can be found in the literature.
-\item[The Coq kernel implementation] You have to trust that the
-implementation of the {\Coq} kernel mirrors the theory behind {\Coq}. The
-kernel is intentionally small to limit the risk of conceptual or
-accidental implementation bugs.
-\item[The Objective Caml compiler] The {\Coq} kernel is written using the
-Objective Caml language but it uses only the most standard features
-(no object, no label ...), so that it is highly improbable that an
-Objective Caml bug breaks the consistency of {\Coq} without breaking all
-other kinds of features of {\Coq} or of other software compiled with
-Objective Caml.
-\item[Your hardware] In theory, if your hardware does not work
-properly, it can accidentally be the case that False becomes
-provable. But it is more likely the case that the whole {\Coq} system
-will be unusable. You can check your proof using different computers
-if you feel the need to.
-\item[Your axioms] Your axioms must be consistent with the theory
-behind {\Coq}.
-\end{description}
-
-
-\Question{Where can I find information about the theory behind {\Coq}?}
-\begin{description}
-\item[The Calculus of Inductive Constructions] The
-\ahref{http://coq.inria.fr/doc/Reference-Manual006.html}{corresponding}
-chapter and the chapter on
-\ahref{http://coq.inria.fr/doc/Reference-Manual007.html}{modules} in
-the {\Coq} Reference Manual.
-\item[Type theory] A book~\cite{ProofsTypes} or some lecture
-notes~\cite{Types:Dowek}.
-\item[Inductive types]
-Christine Paulin-Mohring's habilitation thesis~\cite{Pau96b}.
-\item[Co-Inductive types]
-Eduardo Giménez' thesis~\cite{EGThese}.
-\item[Miscellaneous] A
-\ahref{http://coq.inria.fr/doc/biblio.html}{bibliography} about Coq
-\end{description}
-
-
-\Question{How can I use {\Coq} to prove programs?}
-
-You can either extract a program from a proof by using the extraction
-mechanism or use dedicated tools, such as
-\ahref{http://why3.lri.fr}{\Why},
-\ahref{http://krakatoa.lri.fr}{\Krakatoa},
-\ahref{http://frama-c.com}{\Framac}, to prove
-annotated programs written in other languages.
-
-%\Question{How many {\Coq} users are there?}
-%
-%An estimation is about 100 regular users.
-
-\Question{How old is {\Coq}?}
-
-The first implementation is from 1985 (it was named {\sf CoC} which is
-the acronym of the name of the logic it implemented: the Calculus of
-Constructions).  The first official release of {\Coq} (version 4.10)
-was distributed in 1989.
-
-\Question{What are the \Coq-related tools?}
-
-There are graphical user interfaces:
-\begin{description}
-\item[Coqide] A GTK based GUI for \Coq.
-\item[Pcoq] A GUI for {\Coq} with proof by pointing and pretty printing.
-\item[coqwc] A tool similar to {\tt wc} to count lines in {\Coq} files.
-\item[Proof General] A emacs mode for {\Coq} and many other proof assistants.
-\item[ProofWeb] The ProofWeb online web interface for {\Coq} (and other proof assistants), with a focus on teaching. 
-\item[ProverEditor] is an experimental Eclipse plugin with support for {\Coq}. 
-\end{description}
-
-There are documentation and browsing tools:
-
-\begin{description}
-\item[coq-tex] A tool to insert {\Coq} examples within .tex files. 
-\item[coqdoc] A documentation tool for \Coq.
-\item[coqgraph] A tool to generate a dependency graph from {\Coq} sources.
-\end{description}
-
-There are front-ends for specific languages:
-
-\begin{description}
-\item[Why] A back-end generator of verification conditions.
-\item[Krakatoa] A Java code certification tool that uses both {\Coq} and {\Why} to verify the soundness of implementations with regards to the specifications.
-\item[Caduceus] A C code certification tool that uses both {\Coq} and \Why.
-\item[Zenon] A first-order theorem prover.
-\item[Focal] The \ahref{http://focal.inria.fr}{Focal} project aims at building an environment to develop certified computer algebra libraries. 
-\item[Concoqtion] is a dependently-typed extension of Objective Caml (and of MetaOCaml) with specifications expressed and proved in Coq. 
-\item[Ynot] is an extension of Coq providing a "Hoare Type Theory" for specifying higher-order, imperative and concurrent programs.
-\item[Ott]is a tool to translate the descriptions of the syntax and semantics of programming languages to the syntax of Coq, or of other provers.
-\end{description}
-
-\Question{What are the high-level tactics of \Coq}
-
-\begin{itemize}
-\item Decision of quantifier-free Presburger's Arithmetic
-\item Simplification of expressions on rings and fields
-\item Decision of closed systems of equations
-\item Semi-decision of first-order logic
-\item Prolog-style proof search, possibly involving equalities
-\end{itemize}
-
-\Question{What are the main libraries available for \Coq}
-
-\begin{itemize}
-\item Basic Peano's arithmetic, binary integer numbers, rational numbers,
-\item Real analysis,
-\item Libraries for lists, boolean, maps, floating-point numbers,
-\item Libraries for relations, sets and constructive algebra,
-\item Geometry
-\end{itemize}
-
-
-\Question{What are the mathematical applications for {\Coq}?}
-
-{\Coq} is used for formalizing mathematical theories, for teaching,
-and for proving properties of algorithms or programs libraries.
-
-The largest mathematical formalization has been done at the University
-of Nijmegen (see the
-\ahref{http://c-corn.cs.ru.nl}{Constructive Coq
-Repository at Nijmegen}).
-
-A symbolic step has also been obtained by formalizing in full a proof
-of the Four Color Theorem.
-
-\Question{What are the industrial applications for {\Coq}?}
-
-{\Coq} is used e.g. to prove properties of the JavaCard system
-(especially by Schlumberger and Trusted Logic). It has
-also been used to formalize the semantics of the Lucid-Synchrone
-data-flow synchronous calculus used by Esterel-Technologies.
-
-\iffalse
-todo christine compilo lustre?
-\fi
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-\section{Documentation}
-
-\Question{Where can I find documentation about {\Coq}?} 
-All the documentation about \Coq, from the reference manual~\cite{Coq:manual} to
-friendly tutorials~\cite{Coq:Tutorial} and documentation of the standard library, is available 
-\ahref{http://coq.inria.fr/doc-eng.html}{online}.
-All these documents are viewable either in browsable HTML, or as
-downloadable postscripts.
-
-\Question{Where can I find this FAQ on the web?}
-
-This FAQ is available online at \ahref{http://coq.inria.fr/faq}{\url{http://coq.inria.fr/faq}}.
-
-\Question{How can I submit suggestions / improvements / additions for this FAQ?}
-
-This FAQ is unfinished (in the sense that there are some obvious
-sections that are missing). Please send contributions to Coq-Club.
-
-\Question{Is there any mailing list about {\Coq}?} 
-The main {\Coq} mailing list is \url{coq-club@inria.fr}, which
-broadcasts questions and suggestions about the implementation, the
-logical formalism or proof developments. See
-\ahref{http://sympa.inria.fr/sympa/info/coq-club}{\url{http://sympa.inria.fr/sympa/info/coq-club}} for
-subscription. For bugs reports see question \ref{coqbug}.
-
-\Question{Where can I find an archive of the list?}
-The archives of the {\Coq} mailing list are available at
-\ahref{http://sympa.inria.fr/sympa/arc/coq-club}{\url{http://sympa.inria.fr/sympa/arc/coq-club}}.
-
-
-\Question{How can I be kept informed of new releases of {\Coq}?}
-
-New versions of {\Coq} are announced on the coq-club mailing list. If you only want to receive information about new releases, you can subscribe to {\Coq} on \ahref{http://freshmeat.net/projects/coq/}{\url{http://freshmeat.net/projects/coq/}}.
-
-
-\Question{Is there any book about {\Coq}?}
-
-The first book on \Coq, Yves Bertot and Pierre Castéran's Coq'Art has been published by Springer-Verlag in 2004:
-\begin{quote}
-``This book provides a pragmatic introduction to the development of
-proofs and certified programs using \Coq. With its large collection of
-examples and exercises it is an invaluable tool for researchers,
-students, and engineers interested in formal methods and the
-development of zero-default software.''
-\end{quote}
-
-\Question{Where can I find some {\Coq} examples?} 
-
-There are examples in the manual~\cite{Coq:manual} and in the
-Coq'Art~\cite{Coq:coqart} exercises \ahref{\url{http://www.labri.fr/Perso/~casteran/CoqArt/index.html}}{\url{http://www.labri.fr/Perso/~casteran/CoqArt/index.html}}.
-You can also find large developments using
-{\Coq} in the {\Coq} user contributions:
-\ahref{http://coq.inria.fr/contribs}{\url{http://coq.inria.fr/contribs}}.
-
-\Question{How can I report a bug?}\label{coqbug}
-
-You can use the web interface accessible at \ahref{http://coq.inria.fr}{\url{http://coq.inria.fr}}, link ``contacts''.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-\section{Installation}
-
-\Question{What is the license of {\Coq}?}
-{\Coq} is distributed under the GNU Lesser General License
-(LGPL).
-
-\Question{Where can I find the sources of {\Coq}?}
-The sources of {\Coq} can be found online in the tar.gz'ed packages
-(\ahref{http://coq.inria.fr}{\url{http://coq.inria.fr}}, link
-``download''). Development sources can be accessed at
-\ahref{http://coq.gforge.inria.fr/}{\url{http://coq.gforge.inria.fr/}}
-
-\Question{On which platform is {\Coq} available?}
-Compiled binaries are available for Linux, MacOS X, and Windows. The
-sources can be easily compiled on all platforms supporting Objective
-Caml.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-\section{The logic of {\Coq}}
-
-\subsection{General}
-
-\Question{What is the logic of \Coq?}
-
-{\Coq} is based on an axiom-free type theory called
-the Calculus of Inductive Constructions (see Coquand \cite{CoHu86},
-Luo~\cite{Luo90}
-and Coquand--Paulin-Mohring \cite{CoPa89}). It includes higher-order
-functions and predicates, inductive and co-inductive datatypes and
-predicates, and a stratified hierarchy of sets.
-
-\Question{Is \Coq's logic intuitionistic or classical?}
-
-{\Coq}'s logic is modular. The core logic is intuitionistic
-(i.e. excluded-middle $A\vee\neg A$ is not granted by default). It can
-be extended to classical logic on demand by requiring an
-optional module stating $A\vee\neg A$.
-
-\Question{Can I define non-terminating programs in \Coq?}
-
-All programs in {\Coq} are terminating. Especially, loops
-must come with an evidence of their termination. 
-
-Non-terminating programs can be simulated by passing around a
-bound on how long the program is allowed to run before dying.
-
-\Question{How is equational reasoning working in {\Coq}?}
-
- {\Coq} comes with an internal notion of computation called
-{\em conversion} (e.g. $(x+1)+y$ is internally equivalent to
-$(x+y)+1$; similarly applying argument $a$ to a function mapping $x$
-to some expression $t$ converts to the expression $t$ where $x$ is
-replaced by $a$). This notion of conversion (which is decidable
-because {\Coq} programs are terminating) covers a certain part of
-equational reasoning but is limited to sequential evaluation of
-expressions of (not necessarily closed) programs. Besides conversion,
-equations have to be treated by hand or using specialised tactics.
-
-\subsection{Axioms}
-
-\Question{What axioms can be safely added to {\Coq}?}
-
-There are a few typical useful axioms that are independent from the
-Calculus of Inductive Constructions and that are considered consistent with
-the theory of {\Coq}.
-Most of these axioms are stated in the directory {\tt Logic} of the
-standard library of {\Coq}. The most interesting ones are
-
-\begin{itemize}
-\item Excluded-middle: $\forall A:Prop, A \vee \neg A$
-\item Proof-irrelevance: $\forall A:Prop \forall p_1 p_2:A, p_1=p_2$
-\item Unicity of equality proofs (or equivalently Streicher's axiom $K$):
-$\forall A \forall x y:A \forall p_1 p_2:x=y, p_1=p_2$
-\item Hilbert's $\epsilon$ operator: if $A \neq \emptyset$, then there is $\epsilon_P$ such that $\exists x P(x) \rightarrow P(\epsilon_P)$
-\item Church's $\iota$ operator: if $A \neq \emptyset$, then there is $\iota_P$ such that $\exists! x P(x) \rightarrow P(\iota_P)$
-\item The axiom of unique choice: $\forall x \exists! y R(x,y) \rightarrow \exists f \forall x R(x,f(x))$
-\item The functional axiom of choice: $\forall x \exists y R(x,y) \rightarrow \exists f \forall x R(x,f(x))$
-\item Extensionality of predicates: $\forall P Q:A\rightarrow Prop, (\forall x, P(x) \leftrightarrow Q(x)) \rightarrow P=Q$
-\item Extensionality of functions: $\forall f g:A\rightarrow B, (\forall x, f(x)=g(x)) \rightarrow f=g$
-\end{itemize}
-
-Figure~\ref{fig:axioms} is a summary of the relative strength of these
-axioms, most proofs can be found in directory {\tt Logic} of the standard
-library. (Statements in boldface are the most ``interesting'' ones for
-Coq.) The justification of their validity relies on the interpretability
-in set theory.
-
-\begin{figure}[htbp]
-%HEVEA\imgsrc{axioms.png}
-%BEGIN LATEX
-\begin{center}
-\ifpdf   % si on est en pdflatex
-\scalebox{0.65}{\input{axioms.pdf_t}}
-\else
-\scalebox{0.65}{\input{axioms.eps_t}}
-\fi
-\end{center}
-%END LATEX
-\caption{The dependency graph of axioms in the Calculus of Inductive Constructions}
-\label{fig:axioms}
-\end{figure}
-
-\Question{What standard axioms are inconsistent with {\Coq}?}
-
-The axiom of unique choice together with classical logic
-(e.g. excluded-middle) are inconsistent in the variant of the Calculus
-of Inductive Constructions where {\Set} is impredicative.
-
-As a consequence, the functional form of the axiom of choice and
-excluded-middle, or any form of the axiom of choice together with
-predicate extensionality are inconsistent in the {\Set}-impredicative
-version of the Calculus of Inductive Constructions.
-
-The main purpose of the \Set-predicative restriction of the Calculus
-of Inductive Constructions is precisely to accommodate these axioms
-which are quite standard in mathematical usage.
-
-The $\Set$-predicative system is commonly considered consistent by
-interpreting it in a standard set-theoretic boolean model, even with
-classical logic, axiom of choice and predicate extensionality added.
-
-\Question{What is Streicher's axiom $K$}
-\label{Streicher}
-
-Streicher's axiom $K$~\cite{HofStr98} is an axiom that asserts
-dependent elimination of reflexive equality proofs.
-
-\begin{coq_example*}
-Axiom Streicher_K :
-  forall (A:Type) (x:A) (P: x=x -> Prop),
-    P (eq_refl x) -> forall p: x=x, P p.
-\end{coq_example*}
-
-In the general case, axiom $K$ is an independent statement of the
-Calculus of Inductive Constructions.  However, it is true on decidable
-domains (see file \vfile{\LogicEqdepDec}{Eqdep\_dec}). It is also
-trivially a consequence of proof-irrelevance (see
-\ref{proof-irrelevance}) hence of classical logic.
-
-Axiom $K$ is equivalent to {\em Uniqueness of Identity Proofs} \cite{HofStr98}
-
-\begin{coq_example*}
-Axiom UIP : forall (A:Set) (x y:A) (p1 p2: x=y), p1 = p2.
-\end{coq_example*}
-
-Axiom $K$ is also equivalent to {\em Uniqueness of Reflexive Identity Proofs} \cite{HofStr98}
-
-\begin{coq_example*}
-Axiom UIP_refl : forall (A:Set) (x:A) (p: x=x), p = eq_refl x.
-\end{coq_example*}
-
-Axiom $K$ is also equivalent to 
-
-\begin{coq_example*}
-Axiom
-  eq_rec_eq :
-    forall (A:Set) (x:A) (P: A->Set) (p:P x) (h: x=x),
-      p = eq_rect x P p x h.
-\end{coq_example*}
-
-It is also equivalent to the injectivity of dependent equality (dependent equality is itself equivalent to equality of dependent pairs).
-
-\begin{coq_example*}
-Inductive eq_dep (U:Set) (P:U -> Set) (p:U) (x:P p) :
-forall q:U, P q -> Prop :=
-    eq_dep_intro : eq_dep U P p x p x.
-Axiom
-  eq_dep_eq :
-    forall (U:Set) (u:U) (P:U -> Set) (p1 p2:P u),
-      eq_dep U P u p1 u p2 -> p1 = p2.
-\end{coq_example*}
-
-\Question{What is proof-irrelevance}
-\label{proof-irrelevance}
-
-A specificity of the Calculus of Inductive Constructions is to permit
-statements about proofs. This leads to the question of comparing two
-proofs of the same proposition. Identifying all proofs of the same
-proposition is called {\em proof-irrelevance}:
-$$
-\forall A:\Prop, \forall p q:A, p=q
-$$ 
-
-Proof-irrelevance (in {\Prop}) can be assumed without contradiction in
-{\Coq}. It expresses that only provability matters, whatever the exact
-form of the proof is. This is in harmony with the common purely
-logical interpretation of {\Prop}. Contrastingly, proof-irrelevance is
-inconsistent in {\Set} since there are types in {\Set}, such as the
-type of booleans, that provably have at least two distinct elements.
-
-Proof-irrelevance (in {\Prop}) is a consequence of classical logic
-(see proofs in file \vfile{\LogicClassical}{Classical} and
-\vfile{\LogicBerardi}{Berardi}). Proof-irrelevance is also a
-consequence of propositional extensionality (i.e.  \coqtt{(A {\coqequiv} B)
-{\coqimp} A=B}, see the proof in file
-\vfile{\LogicClassicalFacts}{ClassicalFacts}).
-
-Proof-irrelevance directly implies Streicher's axiom $K$.
-
-\Question{What about functional extensionality?}
-
-Extensionality of functions is admittedly consistent with the
-Set-predicative Calculus of Inductive Constructions.
-
-%\begin{coq_example*}
-%  Axiom extensionality : (A,B:Set)(f,g:(A->B))(x:A)(f x)=(g x)->f=g.
-%\end{coq_example*}
-
-Let {\tt A}, {\tt B} be types. To deal with extensionality on 
-\verb=A->B= without relying on a general extensionality axiom, 
-a possible approach is to define one's own extensional equality on
-\verb=A->B=.
-
-\begin{coq_eval}
-Variables A B : Set.
-\end{coq_eval}
-
-\begin{coq_example*}
-Definition ext_eq (f g: A->B) := forall x:A, f x = g x.
-\end{coq_example*}
-
-and to reason on \verb=A->B= as a setoid (see the Chapter on
-Setoids in the Reference Manual).
-
-\Question{Is {\Prop} impredicative?}
-
-Yes, the sort {\Prop} of propositions is {\em
-impredicative}. Otherwise said, a statement of the form $\forall
-A:Prop, P(A)$ can be instantiated by itself: if $\forall A:\Prop, P(A)$
-is provable, then $P(\forall A:\Prop, P(A))$ is.
-
-\Question{Is {\Set} impredicative?}
-
-No, the sort {\Set} lying at the bottom of the hierarchy of
-computational types is {\em predicative} in the basic {\Coq} system.
-This means that a family of types in {\Set}, e.g. $\forall A:\Set, A
-\rightarrow A$, is not a type in {\Set} and it cannot be applied on
-itself.
-
-However, the sort {\Set} was impredicative in the original versions of
-{\Coq}. For backward compatibility, or for experiments by
-knowledgeable users, the logic of {\Coq} can be set impredicative for
-{\Set} by calling {\Coq} with the option {\tt -impredicative-set}.
-
-{\Set} has been made predicative from version 8.0 of {\Coq}. The main
-reason is to interact smoothly with a classical mathematical world
-where both excluded-middle and the axiom of description are valid (see
-file \vfile{\LogicClassicalDescription}{ClassicalDescription} for a
-proof that excluded-middle and description implies the double negation
-of excluded-middle in {\Set} and file {\tt Hurkens\_Set.v} from the
-user contribution {\tt Paradoxes} at
-\ahref{http://coq.inria.fr/contribs}{\url{http://coq.inria.fr/contribs}}
-for a proof that impredicativity of {\Set} implies the simple negation
-of excluded-middle in {\Set}).
-
-\Question{Is {\Type} impredicative?}
-
-No, {\Type} is stratified. This is hidden for the
-user, but {\Coq} internally maintains a set of constraints ensuring
-stratification.
-
-If {\Type} were impredicative then it would be possible to encode
-Girard's systems $U-$ and $U$ in {\Coq} and it is known from Girard,
-Coquand, Hurkens and Miquel that systems $U-$ and $U$ are inconsistent
-[Girard 1972, Coquand 1991, Hurkens 1993, Miquel 2001]. This encoding
-can be found in file {\tt Logic/Hurkens.v} of {\Coq} standard library.
-
-For instance, when the user see {\tt $\forall$ X:Type, X->X : Type}, each
-occurrence of {\Type} is implicitly bound to a different level, say
-$\alpha$ and $\beta$ and the actual statement is {\tt
-forall X:Type($\alpha$), X->X : Type($\beta$)} with the constraint
-$\alpha<\beta$.
-
-When a statement violates a constraint, the message {\tt Universe
-inconsistency} appears. Example: {\tt fun (x:Type) (y:$\forall$ X:Type, X
-{\coqimp} X) => y x x}.
-
-\Question{I have two proofs of the same proposition. Can I prove they are equal?}
-
-In the base {\Coq} system, the answer is generally no. However, if
-classical logic is set, the answer is yes for propositions in {\Prop}.
-The answer is also yes if proof irrelevance holds (see question
-\ref{proof-irrelevance}).
-
-There are also ``simple enough'' propositions for which you can prove
-the equality without requiring any extra axioms.  This is typically
-the case for propositions defined deterministically as a first-order
-inductive predicate on decidable sets. See for instance in question
-\ref{le-uniqueness} an axiom-free proof of the uniqueness of the proofs of
-the proposition {\tt le m n} (less or equal on {\tt nat}).
-
-%  It is an ongoing work of research to natively include proof
-%  irrelevance in {\Coq}.
-
-\Question{I have two proofs of an equality statement. Can I prove they are 
-equal?}
-
- Yes, if equality is decidable on the domain considered (which
-is the case for {\tt nat}, {\tt bool}, etc): see {\Coq} file
-\verb=Eqdep_dec.v=). No otherwise, unless
-assuming Streicher's axiom $K$ (see \cite{HofStr98}) or a more general
-assumption such as proof-irrelevance (see \ref{proof-irrelevance}) or
-classical logic.
-
-All of these statements can be found in file \vfile{\LogicEqdep}{Eqdep}.
-
-\Question{Can I prove that the second components of equal dependent
-pairs are equal?}
-
- The answer is the same as for proofs of equality
-statements. It is provable if equality on the domain of the first
-component is decidable (look at \verb=inj_right_pair= from file
-\vfile{\LogicEqdepDec}{Eqdep\_dec}), but not provable in the general
-case. However, it is consistent (with the Calculus of Constructions)
-to assume it is true. The file \vfile{\LogicEqdep}{Eqdep} actually
-provides an axiom (equivalent to Streicher's axiom $K$) which entails
-the result (look at \verb=inj_pair2= in \vfile{\LogicEqdep}{Eqdep}).
-
-\subsection{Impredicativity}
-
-\Question{Why {\tt injection} does not work on impredicative {\tt Set}?}
-
- E.g. in this case (this occurs only in the {\tt Set}-impredicative
- variant of \Coq):
-
-\begin{coq_example*}
-Inductive I : Type :=
-  intro : forall k:Set, k -> I.
-Lemma eq_jdef :
-   forall x y:nat, intro _ x = intro _ y -> x = y.
-Proof.
-   intros x y H; injection H.
-\end{coq_example*}
-
-\begin{coq_eval}
-Reset Initial.
-\end{coq_eval}
-
- Injectivity of constructors is restricted to predicative types. If
-injectivity on large inductive types were not restricted, we would be
-allowed to derive an inconsistency (e.g. following the lines of
-Burali-Forti paradox). The question remains open whether injectivity
-is consistent on some large inductive types not expressive enough to
-encode known paradoxes (such as type I above).
-
-
-\Question{What is a ``large inductive definition''?}
-
-An inductive definition in {\Prop} or {\Set} is called large
-if its constructors embed sets or propositions. As an example, here is
-a large inductive type:
-
-\begin{coq_example*}
-Inductive sigST (P:Set -> Set) : Type :=
-  existST : forall X:Set, P X -> sigST P.
-\end{coq_example*}
-
-In the {\tt Set} impredicative variant of {\Coq}, large inductive
-definitions in {\tt Set} have restricted elimination schemes to
-prevent inconsistencies. Especially, projecting the set or the
-proposition content of a large inductive definition is forbidden. If
-it were allowed, it would be possible to encode e.g. Burali-Forti
-paradox \cite{Gir70,Coq85}.
-
-
-\Question{Is Coq's logic conservative over Coquand's Calculus of 
-Constructions?}
-
-In the {\Set}-impredicative version of the Calculus of Inductive
-Constructions (CIC), there are two ways to interpret the Calculus of
-Constructions (CC) since the impredicative sort of CC can be
-interpreted either as {\Prop} or as {\Set}. In the {\Set}-predicative
-CIC, the impredicative sort of CC can only be interpreted as {\Prop}.
-
-If the impredicative sort of CC is interpreted as {\Set}, there is no
-conservativity of CIC over CC as the discrimination of
-constructors of inductive types in {\Set} transports to a
-discrimination of constructors of inductive types encoded
-impredicatively. Concretely, considering the impredicative encoding of
-Boolean, equality and falsity, we can prove the following CC statement
-DISCR in CIC which is not provable in CC, as CC has a
-``term-irrelevant'' model.
-
-\begin{coq_example*}
-Definition BOOL := forall X:Set, X -> X -> X.
-Definition TRUE : BOOL := fun X x1 x2 => x1.
-Definition FALSE : BOOL := fun X x1 x2 => x2.
-Definition EQBOOL (x1 x2:BOOL) := forall P:BOOL->Set, P x1 -> P x2.
-Definition BOT := forall X:Set, X.
-
-Definition BOOL2bool : BOOL -> bool := fun b => b bool true false.
-
-Theorem DISCR : EQBOOL TRUE FALSE -> BOT.
-intro X.
-assert (H : BOOL2bool TRUE = BOOL2bool FALSE).
-{ apply X. trivial. }
-discriminate H.
-Qed.
-\end{coq_example*}
-
-If the impredicative sort of CC is interpreted as {\Prop}, CIC is
-presumably conservative over CC. The general idea is that no
-proof-relevant information can flow from {\Prop} to {\Set}, even
-though singleton elimination can be used. Hence types in {\Set} should
-be smashable to the unit type and {\Set} and {\Type} themselves be
-mapped to {\Prop}.
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{Talkin' with the Rooster}
-
-
-%%%%%%%
-\subsection{My goal is ...,  how can I prove it?}
-
-
-\Question{My goal is a conjunction, how can I prove it?}
-
-Use some theorem or assumption or use the {\split} tactic.
-\begin{coq_example}
-Goal forall A B:Prop, A -> B -> A/\B.
-intros.
-split.
-assumption.
-assumption.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-\Question{My goal contains a conjunction as an hypothesis, how can I use it?}
-
-If you want to decompose a hypothesis into several hypotheses, you can
-use the {\destruct} tactic:
-
-\begin{coq_example}
-Goal forall A B:Prop, A/\B -> B.
-intros.
-destruct H as [H1 H2].
-assumption.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-You can also perform the destruction at the time of introduction:
-
-\begin{coq_example}
-Goal forall A B:Prop, A/\B -> B.
-intros A B [H1 H2].
-assumption.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-\Question{My goal is a disjunction, how can I prove it?}
-
-You can prove the left part or the right part of the disjunction using
-{\left} or {\right} tactics. If you want to do a classical
-reasoning step, use the {\tt classic} axiom to prove the right part with the assumption
-that the left part of the disjunction is false.
-
-\begin{coq_example}
-Goal forall A B:Prop, A -> A\/B.
-intros.
-left.
-assumption.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-An example using classical reasoning:
-
-\begin{coq_example}
-Require Import Classical.
-
-Ltac classical_right :=
-match goal with
-| _:_ |- ?X1 \/ _ => (elim (classic X1);intro;[left;trivial|right])
-end.
-
-Ltac classical_left :=
-match goal with
-| _:_ |- _ \/ ?X1 => (elim (classic X1);intro;[right;trivial|left])
-end.
-
-
-Goal forall A B:Prop, (~A -> B) -> A\/B.
-intros.
-classical_right.
-auto.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-\Question{My goal is an universally quantified statement, how can I prove it?}
-
-Use some theorem or assumption or introduce the quantified variable in
-the context using the {\intro} tactic. If there are several
-variables you can use the {\intros} tactic. A good habit is to
-provide names for these variables: {\Coq} will do it anyway, but such
-automatic naming decreases legibility and robustness.
-
-
-\Question{My goal contains an universally quantified statement, how can I use it?}
-
-If the universally quantified assumption matches the goal you can
-use the {\apply} tactic. If it is an equation you can use the
-{\rewrite} tactic. Otherwise you can use the {\specialize} tactic
-to instantiate the quantified variables with terms. The variant
-{\tt assert(Ht := H t)} makes a copy of assumption {\tt H} before
-instantiating it.
-
-
-\Question{My goal is an existential, how can I prove it?}
-
-Use some theorem or assumption or exhibit the witness using the {\existstac} tactic.
-\begin{coq_example}
-Goal exists x:nat, forall y, x+y=y.
-exists 0.
-intros.
-auto.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-
-\Question{My goal is solvable by  some lemma, how can I prove it?}
-
-Just use the {\apply} tactic.
-
-\begin{coq_eval}
-Reset Initial.
-\end{coq_eval}
-
-\begin{coq_example}
-Lemma mylemma : forall x, x+0 = x.
-auto.
-Qed.
-
-Goal 3+0 = 3.
-apply mylemma.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-
-
-\Question{My goal contains False as an hypothesis, how can I prove it?}
-
-You can use the {\contradiction} or {\intuition} tactics.
-
-
-\Question{My goal is an equality of two convertible terms, how can I prove it?}
-
-Just use the {\reflexivity} tactic.
-
-\begin{coq_example}
-Goal forall x, 0+x = x.
-intros.
-reflexivity.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-\Question{My goal is a {\tt let x := a in ...}, how can I prove it?}
-
-Just use the {\intro} tactic.
-
-
-\Question{My goal is a {\tt let (a, ..., b) := c in}, how can I prove it?}
-
-Just use the {\destruct} c as (a,...,b) tactic.
-
-
-\Question{My goal contains some existential hypotheses, how can I use it?}
-
-As with conjunctive hypotheses, you can use the {\destruct} tactic or
-the {\intros} tactic to decompose them into several hypotheses.
-
-\begin{coq_example*}
-Require Import Arith.
-\end{coq_example*}
-\begin{coq_example}
-Goal forall x, (exists y, x * y = 1) -> x = 1.
-intros x [y H].
-apply mult_is_one in H.
-easy.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-
-\Question{My goal is an equality, how can I swap the left and right hand terms?}
-
-Just use the {\symmetry} tactic.
-\begin{coq_example}
-Goal forall x y : nat, x=y -> y=x.
-intros.
-symmetry.
-assumption.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-\Question{My hypothesis is an equality, how can I swap the left and right hand terms?}
-
-Just use the {\symmetryin} tactic.
-
-\begin{coq_example}
-Goal forall x y : nat, x=y -> y=x.
-intros.
-symmetry in H.
-assumption.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-
-\Question{My goal is an equality, how can I prove it by transitivity?}
-
-Just use the {\transitivity} tactic.
-\begin{coq_example}
-Goal forall x y z : nat, x=y -> y=z -> x=z.
-intros.
-transitivity y.
-assumption.
-assumption.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-
-\Question{My goal would be solvable using {\tt apply;assumption} if it would not create meta-variables, how can I prove it?}
-
-You can use {\tt eapply yourtheorem;eauto} but it won't work in all cases ! (for example if more than one hypothesis match one of the subgoals generated by \eapply) so you should rather use  {\tt try solve [eapply yourtheorem;eauto]}, otherwise some metavariables may be incorrectly instantiated.
-
-\begin{coq_example}
-Lemma trans : forall x y z : nat, x=y -> y=z -> x=z.
-intros.
-transitivity y;assumption.
-Qed.
-
-Goal forall x y z : nat, x=y -> y=z -> x=z.
-intros.
-eapply trans;eauto.
-Qed.
-
-Goal forall x y z t : nat, x=y -> x=t -> y=z -> x=z.
-intros.
-eapply trans;eauto.
-Undo.
-eapply trans.
-apply H.
-auto.
-Qed.
-
-Goal forall x y z t : nat, x=y -> x=t -> y=z -> x=z.
-intros.
-eapply trans;eauto.
-Undo.
-try solve [eapply trans;eauto].
-eapply trans.
-apply H.
-auto.
-Qed.
-\end{coq_example}
-
-\Question{My goal is solvable by  some lemma within a set of lemmas and I don't want to remember which one, how can I prove it?}
-
-You can use a what is called a hints' base.
-
-\begin{coq_example}
-Require Import ZArith.
-Require Ring.
-Local Open Scope Z_scope.
-Lemma toto1 : 1+1 = 2.
-ring.
-Qed.
-Lemma toto2 : 2+2 = 4.
-ring.
-Qed.
-Lemma toto3 : 2+1 = 3.
-ring.
-Qed.
-
-Hint Resolve toto1 toto2 toto3 : mybase.
-
-Goal 2+(1+1)=4. 
-auto with mybase.
-Qed.
-\end{coq_example}
-
-
-\Question{My goal is one of the hypotheses, how can I prove it?}
-
-Use the {\assumption} tactic.
-
-\begin{coq_example}
-Goal 1=1 -> 1=1.
-intro.
-assumption.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-
-\Question{My goal appears twice in the hypotheses and I want to choose which one is used, how can I do it?}
-
-Use the {\exact} tactic.
-\begin{coq_example}
-Goal 1=1 -> 1=1 -> 1=1.
-intros.
-exact H0.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-\Question{What can be the difference between applying one hypothesis or another in the context of the last question?}
-
-From a proof point of view it is equivalent but if you want to extract
-a program from your proof, the two hypotheses can lead to different
-programs.
-
-
-\Question{My goal is a propositional tautology, how can I prove it?}
-
-Just use the {\tauto} tactic.
-\begin{coq_example}
-Goal forall A B:Prop, A-> (A\/B) /\ A.
-intros.
-tauto.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-\Question{My goal is a first order formula, how can I prove it?}
-
-Just use the semi-decision tactic: \firstorder.
-
-\iffalse
-todo: demander un exemple à Pierre
-\fi
-
-\Question{My goal is solvable by a sequence of rewrites, how can I prove it?}
-
-Just use the {\congruence} tactic.
-\begin{coq_example}
-Goal forall a b c d e, a=d -> b=e -> c+b=d -> c+e=a.
-intros.
-congruence.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-
-\Question{My goal is a disequality solvable by a sequence of rewrites, how can I prove it?}
-
-Just use the {\congruence} tactic.
-
-\begin{coq_example}
-Goal forall a b c d, a<>d -> b=a -> d=c+b -> b<>c+b.
-intros.
-congruence.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-
-\Question{My goal is an equality on some ring (e.g. natural numbers), how can I prove it?}
-
-Just use the {\ring} tactic.
-
-\begin{coq_example}
-Require Import ZArith.
-Require Ring.
-Local Open Scope Z_scope.
-Goal forall a b : Z, (a+b)*(a+b) = a*a + 2*a*b + b*b.
-intros.
-ring.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-\Question{My goal is an equality on some field (e.g. real numbers), how can I prove it?}
-
-Just use the {\field} tactic.
-
-\begin{coq_example}
-Require Import Reals.
-Require Ring.
-Local Open Scope R_scope.
-Goal forall a b : R, b*a<>0 -> (a/b) * (b/a) = 1.
-intros.
-field.
-split ; auto with real.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-
-\Question{My goal is an inequality on integers in Presburger's arithmetic (an expression build from $+$, $-$, constants, and variables), how can I prove it?}
-
-
-\begin{coq_example}
-Require Import ZArith.
-Require Omega.
-Local Open Scope Z_scope.
-Goal forall a : Z, a>0 -> a+a > a.
-intros.
-omega.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-
-\Question{My goal is an equation solvable using equational hypothesis on some ring (e.g. natural numbers), how can I prove it?}
-
-You need the {\gb} tactic (see Loïc Pottier's homepage).
-
-\subsection{Tactics usage}
-
-\Question{I want to state a fact that I will use later as an hypothesis, how can I do it?}
-
-If you want to use forward reasoning (first proving the fact and then
-using it) you just need to use the {\assert} tactic. If you want to use
-backward reasoning (proving your goal using an assumption and then
-proving the assumption) use the {\cut} tactic.
-
-\begin{coq_example}
-Goal forall A B C D : Prop, (A -> B) -> (B->C) -> A -> C. 
-intros.
-assert (A->C).
-intro;apply H0;apply H;assumption.
-apply H2.
-assumption.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-\begin{coq_example}
-Goal forall A B C D : Prop, (A -> B) -> (B->C) -> A -> C. 
-intros.
-cut (A->C).
-intro.
-apply H2;assumption.
-intro;apply H0;apply H;assumption.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-
-
-
-\Question{I want to state a fact that I will use later as an hypothesis and prove it later, how can I do it?}
-
-You can use {\cut} followed by {\intro} or you can use the following {\Ltac} command:
-\begin{verbatim}
-Ltac assert_later t := cut t;[intro|idtac]. 
-\end{verbatim}
-
-\Question{What is the difference between {\Qed} and {\Defined}?}
-
-These two commands perform type checking, but when {\Defined} is used the new definition is set as transparent, otherwise it is defined as opaque (see \ref{opaque}).
-
-
-\Question{How can I know what an automation tactic does in my example?}
-
-You can use its {\tt info} variant: info\_auto, info\_trivial, info\_eauto.
-
-\Question{Why {\auto} does not work? How can I fix it?}
-
-You can increase the depth of the proof search or add some lemmas in the base of hints.
-Perhaps you may need to use \eauto.
-
-\Question{What is {\eauto}?}
-
-This is the same tactic as \auto, but it relies on {\eapply} instead of \apply.
-
-\Question{How can I speed up {\auto}?}
-
-You can use \texttt{info\_}{\auto} to replace {\auto} by the tactics it generates.
-You can split your hint bases into smaller ones.
-
-
-\Question{What is the equivalent of {\tauto} for classical logic?}
-
-Currently there are no equivalent tactic for classical logic. You can use Gödel's ``not not'' translation.
-
-
-\Question{I want to replace some term with another in the goal, how can I do it?}
-
-If one of your hypothesis (say {\tt H}) states that the terms are equal you can use the {\rewrite} tactic. Otherwise you can use the {\replace} {\tt with} tactic. 
-
-\Question{I want to replace some term with another in an hypothesis, how can I do it?}
-
-You can use the {\rewrite} {\tt in} tactic.
-
-\Question{I want to replace some symbol with its definition, how can I do it?}
-
-You can use the {\unfold} tactic.
-
-\Question{How can I reduce some term?}
-
-You can use the {\simpl} tactic.
-
-\Question{How can I declare a shortcut for some term?}
-
-You can use the {\set} or {\pose} tactics.
-
-\Question{How can I perform case analysis?}
-
-You can use the {\case} or {\destruct} tactics.
-
-\Question{How can I prevent the case tactic from losing information ?}
-
-You may want to use the (now standard) {\tt case\_eq} tactic. See the Coq'Art page 159.
-
-\Question{Why should I name my intros?}
-
-When you use the {\intro} tactic you don't have to give a name to your
-hypothesis. If you do so the name will be generated by {\Coq} but your
-scripts may be less robust. If you add some hypothesis to your theorem
-(or change their order), you will have to change your proof to adapt
-to the new names.
-
-\Question{How can I automatize the naming?}
-
-You can use the {\tt Show Intro.} or  {\tt Show Intros.} commands to generate the names and use your editor to generate a fully named {\intro} tactic. 
-This can be automatized within {\tt xemacs}.
-
-\begin{coq_example}
-Goal forall A B C : Prop, A -> B -> C -> A/\B/\C.
-Show Intros.
-(*
-A B C H H0
-H1
-*)
-intros A B C H H0 H1.
-repeat split;assumption.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-\Question{I want to automatize the use of some tactic, how can I do it?}
-
-You need to use the {\tt proof with T} command and add {\ldots} at the
-end of your sentences.
-
-For instance:
-\begin{coq_example}
-Goal forall A B C : Prop, A -> B/\C -> A/\B/\C.
-Proof with assumption.
-intros.
-split...
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-\Question{I want to execute the {\texttt proof with} tactic only if it solves the goal, how can I do it?}
-
-You need to use the {\try} and {\solve} tactics. For instance:
-\begin{coq_example}
-Require Import ZArith.
-Require Ring.
-Local Open Scope Z_scope.
-Goal forall a b c : Z, a+b=b+a.
-Proof with try solve [ring].
-intros...
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-\Question{How can I do the opposite of the {\intro} tactic?}
-
-You can use the {\generalize} tactic.
-
-\begin{coq_example}
-Goal forall A B : Prop, A->B-> A/\B.
-intros.
-generalize H.
-intro.
-auto.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-\Question{One of the hypothesis is an equality between a variable and some term, I want to get rid of this variable, how can I do it?}
-
-You can use the {\subst} tactic. This will rewrite the equality everywhere and clear the assumption.
-
-\Question{What can I do if I get ``{\tt generated subgoal term has metavariables in it }''?}
-
-You should use the {\eapply} tactic, this will generate some goals containing metavariables. 
-
-\Question{How can I instantiate some metavariable?}
-
-Just use the {\instantiate} tactic.
-
-
-\Question{What is the use of the {\pattern} tactic?}
-
-The {\pattern} tactic transforms the current goal, performing
-beta-expansion on all the applications featuring this tactic's
-argument. For instance, if the current goal includes a subterm {\tt
-phi(t)}, then {\tt pattern t} transforms the subterm into {\tt (fun
-x:A => phi(x)) t}. This can be useful when {\apply} fails on matching,
-to abstract the appropriate terms.
-
-\Question{What is the difference between assert, cut and generalize?}
-
-PS: Notice for people that are interested in proof rendering that \assert
-and {\pose} (and \cut) are not rendered the same as {\generalize} (see the
-HELM experimental rendering tool at \ahref{http://helm.cs.unibo.it/library.html}{\url{http://helm.cs.unibo.it}}, link
-HELM, link COQ Online). Indeed {\generalize} builds a beta-expanded term
-while \assert, {\pose} and {\cut} uses a let-in.
-
-\begin{verbatim}
-  (* Goal is T *)
-  generalize (H1 H2).
-  (* Goal is A->T *)
-  ... a proof of A->T ...
-\end{verbatim}
-
-is rendered into something like
-\begin{verbatim}
-  (h) ... the proof of A->T ...
-      we proved A->T
-  (h0) by (H1 H2) we proved A
-  by (h h0) we proved T
-\end{verbatim}
-while 
-\begin{verbatim}
-  (* Goal is T *)
-  assert q := (H1 H2).
-  (* Goal is A *)
-  ... a proof of A ...
-  (* Goal is A |- T *)
-  ... a proof of T ...
-\end{verbatim}
-is rendered into something like
-\begin{verbatim}
-  (q) ... the proof of A ...
-      we proved A
-  ... the proof of T ...
-  we proved T
-\end{verbatim}
-Otherwise said, {\generalize} is not rendered in a forward-reasoning way,
-while {\assert} is.
-
-\Question{What can I do if \Coq can not infer some implicit argument ?}
-
-You can state explicitly what this implicit argument is. See \ref{implicit}.
-
-\Question{How can I explicit some implicit argument ?}\label{implicit}
-
-Just use \texttt{A:=term} where \texttt{A} is the argument.
-
-For instance if you want to use the existence of ``nil'' on nat*nat lists:
-\begin{verbatim}
-exists (nil (A:=(nat*nat))).
-\end{verbatim}
-
-\iffalse
-\Question{Is there anyway to do pattern matching with dependent types?}
-
-todo
-\fi
-
-\subsection{Proof management}
-
-
-\Question{How can I change the order of the subgoals?}
-
-You can use the {\Focus} command to concentrate on some goal. When the goal is proved you will see the remaining goals.
-
-\Question{How can I change the order of the hypothesis?}
-
-You can use the {\tt Move ... after} command.
-
-\Question{How can I change the name of an hypothesis?}
-
-You can use the {\tt Rename ... into} command.
-
-\Question{How can I delete some hypothesis?}
-
-You can use the {\tt Clear} command.
-
-\Question{How can use a proof which is not finished?}
-
-You can use the {\tt Admitted} command to state your current proof as an axiom.
-You can use the {\tt give\_up} tactic to omit a portion of a proof.
-
-\Question{How can I state a conjecture?}
-
-You can use the {\tt Admitted} command to state your current proof as an axiom.
-
-\Question{What is the difference between a lemma, a fact and a theorem?}
-
-From {\Coq} point of view there are no difference. But some tools can
-have a different behavior when you use a lemma rather than a
-theorem. For instance {\tt coqdoc} will not generate documentation for
-the lemmas within your development.
-
-\Question{How can I organize my proofs?}
-
-You can organize your proofs using the section mechanism of \Coq. Have
-a look at the manual for further information.
-
-
-%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-\section{Inductive and Co-inductive types}
-
-\subsection{General}
-
-\Question{How can I prove that two constructors are different?}
-
-You can use the {\discriminate} tactic.
-
-\begin{coq_example}
-Inductive toto : Set := | C1 : toto | C2 : toto.
-Goal C1 <> C2.
-discriminate.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-\Question{During an inductive proof, how to get rid of impossible cases of an inductive definition?}
-
-Use the {\inversion} tactic.
-
-
-\Question{How can I prove that 2 terms in an inductive set are equal? Or different?}
-
-Have a look at \coqtt{decide equality} and \coqtt{discriminate} in the \ahref{http://coq.inria.fr/doc/main.html}{Reference Manual}.
-
-\Question{Why is the proof of \coqtt{0+n=n} on natural numbers
-trivial but the proof of \coqtt{n+0=n} is not?}
-
- Since \coqtt{+} (\coqtt{plus}) on natural numbers is defined by analysis on its first argument
-
-\begin{coq_example}
-Print plus.
-\end{coq_example}
-
-{\noindent} The expression \coqtt{0+n} evaluates to \coqtt{n}. As {\Coq} reasons
-modulo evaluation of expressions, \coqtt{0+n} and \coqtt{n} are
-considered equal and the theorem \coqtt{0+n=n} is an instance of the
-reflexivity of equality. On the other side, \coqtt{n+0} does not
-evaluate to \coqtt{n} and a proof by induction on \coqtt{n} is
-necessary to trigger the evaluation of \coqtt{+}.
-
-\Question{Why is dependent elimination in Prop not
-available by default?}
-
- 
-This is just because most of the time it is not needed. To derive a
-dependent elimination principle in {\tt Prop}, use the command {\tt Scheme} and
-apply the elimination scheme using the \verb=using= option of
-\verb=elim=, \verb=destruct= or \verb=induction=.
-
-
-\Question{Argh! I cannot write expressions like ``~{\tt if n <= p then p else n}~'', as in any programming language}
-\label{minmax}
-
-The short answer : You should use {\texttt le\_lt\_dec n p} instead.\\
-
-The long answer: That's right, you can't.
-If you type for instance the following ``definition'':
-\begin{coq_eval}
-Reset Initial.
-\end{coq_eval}
-\begin{coq_example}
-Fail Definition max (n p : nat) := if n <= p then p else n.
-\end{coq_example}
-
-As \Coq~ says, the term ``~\texttt{n <= p}~'' is a proposition, i.e. a
-statement that belongs to the mathematical world. There are many ways to
-prove such a proposition, either by some computation, or using some already
-proven theorems. For instance, proving $3-2 \leq 2^{45503}$ is very easy,
-using some theorems on arithmetical operations. If you compute both numbers
-before comparing them, you risk to use a lot of time and space.
-
-
-On the contrary, a function for computing the greatest of two natural numbers
-is an algorithm  which, called on two natural numbers
-$n$ and $p$, determines whether $n\leq p$ or $p < n$.
-Such a function is a \emph{decision  procedure} for the inequality of
- \texttt{nat}.  The possibility of writing such a procedure comes 
-directly from de decidability of the order $\leq$ on natural numbers.
-
-
-When you write a piece of code like 
-``~\texttt{if n <= p then \dots{} else \dots}~''
-in a
-programming language like \emph{ML} or \emph{Java}, a call to such a 
-decision procedure is generated. The decision procedure is in general
-a primitive function, written in a low-level language, in the correctness
-of which you have to trust.
-
-The standard Library of the system \emph{Coq} contains a  
-(constructive) proof of decidability of the order $\leq$ on
-\texttt{nat} : the function \texttt{le\_lt\_dec} of 
-the module \texttt{Compare\_dec} of library \texttt{Arith}.
-
-The following code shows how to define correctly \texttt{min} and
-\texttt{max}, and prove some properties of these functions.
-
-\begin{coq_example}
-Require Import Compare_dec.
-
-Definition max (n p : nat) := if le_lt_dec n p then p else n.
-
-Definition min (n p : nat) := if le_lt_dec n p then n else p.
-
-Eval compute in (min 4 7).
-
-Theorem min_plus_max : forall n p, min n p + max n p  = n + p.
-Proof.
- intros n p; 
- unfold min, max; 
- case (le_lt_dec n p);
- simpl; auto with arith.
-Qed.
-
-Theorem max_equiv : forall n p, max n p = p <-> n <= p.
-Proof.
- unfold max; intros n p; case (le_lt_dec n p);simpl; auto.
- intuition auto with arith.
- split. 
- intro e; rewrite e; auto with arith.
- intro H; absurd (p < p); eauto with arith.
-Qed.
-\end{coq_example}
-
-\Question{I wrote my own decision procedure for $\leq$, which
-is much  faster than yours, but proving such theorems as
- \texttt{max\_equiv} seems to be quite difficult}
-
-Your code is probably the following one:
-
-\begin{coq_example}
-Fixpoint my_le_lt_dec (n p :nat) {struct n}: bool  :=
- match n, p with 0, _ => true
-               | S n', S p' => my_le_lt_dec n' p'
-               | _   , _    => false
- end.
-
-Definition my_max (n p:nat) := if my_le_lt_dec n p then p else n.
-
-Definition my_min (n p:nat) := if my_le_lt_dec n p then n else p.
-\end{coq_example}
-
-
-For instance, the computation of \texttt{my\_max 567 321} is almost
-immediate, whereas one can't wait for  the result of 
-\texttt{max 56 32}, using \emph{Coq's} \texttt{le\_lt\_dec}.
-
-This is normal. Your definition is a simple recursive function which
-returns a boolean value. Coq's \texttt{le\_lt\_dec} is a \emph{certified
-function}, i.e. a complex object, able not only to tell whether $n\leq p$
-or $p<n$, but also of building a complete proof of the correct inequality.
-What make \texttt{le\_lt\_dec} inefficient for computing \texttt{min}
-and \texttt{max} is the building of a huge proof term.
-
-Nevertheless,  \texttt{le\_lt\_dec} is very useful. Its type 
-is a strong specification, using the
-\texttt{sumbool} type (look at the reference manual or chapter 9 of
-\cite{coqart}). Eliminations of the form
-``~\texttt{case (le\_lt\_dec n p)}~'' provide proofs of
-either $n \leq p$ or $p < n$, allowing easy proofs of some theorems as in
-question~\ref{minmax}. Unfortunately, this not the case of your
-\texttt{my\_le\_lt\_dec}, which returns a quite non-informative boolean
-value.
-
-
-\begin{coq_example}
-Check le_lt_dec.
-\end{coq_example}
-
-You should keep in mind that \texttt{le\_lt\_dec} is useful to build
-certified programs which need to compare natural numbers, and is not
-designed to compare quickly two numbers.
-
-Nevertheless, the \emph{extraction} of \texttt{le\_lt\_dec} towards 
-\emph{OCaml} or \emph{Haskell}, is a reasonable program for comparing two
-natural numbers in Peano form in linear time.
-
-It is also possible to keep your boolean function as a decision procedure,
-but you have to establish yourself the relationship between \texttt{my\_le\_lt\_dec} and the propositions $n\leq p$ and $p<n$:
-
-\begin{coq_example*}
-Theorem my_le_lt_dec_true : 
-    forall n p, my_le_lt_dec n p = true <-> n <= p.
-
-Theorem  my_le_lt_dec_false : 
-   forall n p, my_le_lt_dec n p = false <-> p < n.
-\end{coq_example*}
-
-
-\subsection{Recursion}
-
-\Question{Why can't I define a non terminating program?}
-
- Because otherwise the decidability of the type-checking
-algorithm (which involves evaluation of programs) is not ensured.  On
-another side, if non terminating proofs were allowed, we could get a
-proof of {\tt False}:
-
-\begin{coq_example*}
-(* This is fortunately not allowed! *)
-Fixpoint InfiniteProof (n:nat) : False := InfiniteProof n.
-Theorem Paradox : False.
-Proof (InfiniteProof O).
-\end{coq_example*}
-
-
-\Question{Why only structurally well-founded loops are allowed?}
-
- The structural order on inductive types is a simple and
-powerful notion of termination. The consistency of the Calculus of
-Inductive Constructions relies on it and another consistency proof
-would have to be made for stronger termination arguments (such
-as the termination of the evaluation of CIC programs themselves!).
-
-In spite of this, all non-pathological termination orders can be mapped
-to a structural order. Tools to do this are provided in the file 
-\vfile{\InitWf}{Wf} of the standard library of {\Coq}.
-
-\Question{How to define loops based on non structurally smaller
-recursive calls?}
-
- The procedure is as follows (we consider the definition of {\tt
-mergesort} as an example).
-
-\begin{itemize}
-
-\item Define the termination order, say {\tt R} on the type {\tt A} of
-the arguments of the loop.
-
-\begin{coq_eval}
-Reset Initial.
-Require Import List.
-\end{coq_eval}
-
-\begin{coq_example*}
-Definition R (a b:list nat) := length a < length b.
-\end{coq_example*}
-
-\item Prove that this order is well-founded (in fact that all elements in {\tt A} are accessible along {\tt R}).
-
-\begin{coq_example*}
-Lemma Rwf : well_founded R.
-\end{coq_example*}
-\begin{coq_eval}
-Admitted.
-\end{coq_eval}
-
-\item Define the step function (which needs proofs that recursive
-calls are on smaller arguments).
-
-\begin{coq_example*}
-Definition split (l : list nat)
-   : {l1: list nat | R l1 l} * {l2 : list nat | R l2 l}.
-Admitted.
-Definition concat (l1 l2 : list nat) : list nat.
-Admitted.
-Definition merge_step (l : list nat) (f: forall l':list nat, R l' l -> list nat) :=
-  let (lH1,lH2) := (split l) in
-  let (l1,H1) := lH1 in
-  let (l2,H2) := lH2 in
-  concat (f l1 H1) (f l2 H2).
-\end{coq_example*}
-
-\item Define the recursive function by fixpoint on the step function.
-
-\begin{coq_example*}
-Definition merge := Fix Rwf (fun _ => list nat) merge_step.
-\end{coq_example*}
-
-\end{itemize}
-
-\Question{What is behind the accessibility and well-foundedness proofs?}
-
- Well-foundedness of some relation {\tt R} on some type {\tt A}
-is defined as the accessibility of all elements of {\tt A} along {\tt R}.
-
-\begin{coq_example}
-Print well_founded.
-Print Acc.
-\end{coq_example}
-
-The structure of the accessibility predicate is a well-founded tree
-branching at each node {\tt x} in {\tt A} along all the nodes {\tt x'}
-less than {\tt x} along {\tt R}. Any sequence of elements of {\tt A}
-decreasing along the order {\tt R} are branches in the accessibility
-tree. Hence any decreasing along {\tt R} is mapped into a structural
-decreasing in the accessibility tree of {\tt R}. This is emphasised in
-the definition of {\tt fix} which recurs not on its argument {\tt x:A}
-but on the accessibility of this argument along {\tt R}.
-
-See file \vfile{\InitWf}{Wf}.
-
-\Question{How to perform simultaneous double induction?}
-
- In general a (simultaneous) double induction is simply solved by an
-induction on the first hypothesis followed by an inversion over the
-second hypothesis. Here is an example
-
-\begin{coq_eval}
-Reset Initial.
-\end{coq_eval}
-
-\begin{coq_example}
-Inductive even : nat -> Prop :=
-  | even_O : even 0
-  | even_S : forall n:nat, even n -> even (S (S n)).
-
-Inductive odd : nat -> Prop :=
-  | odd_SO : odd 1
-  | odd_S : forall n:nat, odd n -> odd (S (S n)).
-
-Lemma not_even_and_odd : forall n:nat, even n -> odd n -> False.
-induction 1.
-  inversion 1.
-  inversion 1. apply IHeven; trivial.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-In case the type of the second induction hypothesis is not
-dependent, {\tt inversion} can just be replaced by {\tt destruct}.
-
-\Question{How to define a function by simultaneous double recursion?}
-
- The same trick applies, you can even use the pattern-matching
-compilation algorithm to do the work for you. Here is an example:
-
-\begin{coq_example}
-Fixpoint minus (n m:nat) {struct n} : nat :=
-  match n, m with
-  | O, _ => 0
-  | S k, O => S k
-  | S k, S l => minus k l
-  end.
-Print  minus.
-\end{coq_example}
-
-In case of dependencies in the type of the induction objects
-$t_1$ and $t_2$, an extra argument stating $t_1=t_2$ must be given to
-the fixpoint definition
-
-\Question{How to perform nested and double induction?}
-
- To reason by nested (i.e. lexicographic) induction, just reason by
-induction on the successive components.
-
-\smallskip
-
-Double induction (or induction on pairs) is a restriction of the
-lexicographic induction. Here is an example of double induction.
-
-\begin{coq_example}
-Lemma nat_double_ind :
-forall P : nat -> nat -> Prop, P 0 0 ->
-  (forall m n, P m n -> P m (S n)) ->
-  (forall m n, P m n -> P (S m) n) ->
-     forall m n, P m n.
-intros P H00 HmS HSn; induction m.
-(* case 0 *)
-induction n; [assumption | apply HmS; apply IHn].
-(* case Sm *)
-intro n; apply HSn; apply IHm.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-\Question{How to define a function by nested recursion?}
-
- The same trick applies. Here is the example of Ackermann
-function.
-
-\begin{coq_example}
-Fixpoint ack (n:nat) : nat -> nat :=
-  match n with
-  | O => S
-  | S n' =>
-     (fix ack' (m:nat) : nat :=
-        match m with
-        | O => ack n' 1
-        | S m' => ack n' (ack' m')
-        end)
-  end.
-\end{coq_example}
-
-
-\subsection{Co-inductive types}
-
-\Question{I have a cofixpoint $t:=F(t)$ and I want to prove $t=F(t)$. How to do it?}
-
-Just case-expand $F({\tt t})$ then complete by a trivial case analysis.
-Here is what it gives on e.g. the type of streams on naturals
-
-\begin{coq_eval}
-Set Implicit Arguments.
-\end{coq_eval}
-\begin{coq_example}
-CoInductive Stream (A:Set) : Set :=
-  Cons : A -> Stream A -> Stream A.
-CoFixpoint nats (n:nat) : Stream nat := Cons n (nats (S n)).
-Lemma Stream_unfold :
-   forall n:nat, nats n = Cons n (nats (S n)).
-Proof.
-  intro;
-  change (nats n = match nats n with
-                  | Cons x s => Cons x s
-                  end).
-  case (nats n); reflexivity.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-
-
-\section{Syntax and notations}
-
-\Question{I do not want to type ``forall'' because it is too long, what can I do?}
-
-You can define your own notation for forall:
-\begin{verbatim}
-Notation "fa x : t, P" := (forall x:t, P) (at level 200, x ident).
-\end{verbatim}
-or if your are using {\CoqIde} you can define a pretty symbol for for all and an input method (see \ref{forallcoqide}).
-
-
-
-\Question{How can I define a notation for square?}
-
-You can use for instance:
-\begin{verbatim}
-Notation "x ^2" := (Rmult x x) (at level 20).
-\end{verbatim}
-Note that you can not use:
-\begin{tt}
-Notation "x $^2$" := (Rmult x x) (at level 20).
-\end{tt}
-because ``$^2$'' is an iso-latin character. If you really want this kind of notation you should use UTF-8.
-
-
-\Question{Why ``no associativity'' and  ``left associativity'' at the same level does not work?}
-
-Because we relie on Camlp4 for syntactical analysis and Camlp4 does not really
-implement no associativity. By default, non associative operators are defined
-as right associative.
-
-
-
-\Question{How can I know the associativity associated with a level?}
-
-You can do ``Print Grammar constr'', and decode the output from Camlp4, good luck !
-
-\section{Modules}
-
-
-
-
-%%%%%%%
-\section{\Ltac}
-
-\Question{What is {\Ltac}?}
-
-{\Ltac} is the tactic language for \Coq. It provides the user with a
-high-level ``toolbox'' for tactic creation.
-
-\Question{Is there any printing command in {\Ltac}?}
-
-You can use the {\idtac} tactic with a string argument. This string
-will be printed out. The same applies to the {\fail} tactic
-
-\Question{What is the syntax for let in {\Ltac}?}
-
-If $x_i$ are identifiers and $e_i$ and $expr$ are tactic expressions, then let reads:
-\begin{center}
-{\tt let $x_1$:=$e_1$ with $x_2$:=$e_2$\ldots with $x_n$:=$e_n$ in
-$expr$}.
-\end{center}
-Beware that if $expr$ is complex (i.e. features at least a sequence) parenthesis
-should be added around it. For example: 
-\begin{coq_example}
-Ltac twoIntro := let x:=intro in (x;x).
-\end{coq_example}
-
-\Question{What is the syntax for pattern matching in {\Ltac}?}
-
-Pattern matching on a term $expr$ (non-linear first order unification)
-with patterns $p_i$ and tactic expressions $e_i$ reads:
-\begin{center}
-\hspace{10ex}
-{\tt match $expr$ with
-\hspace*{2ex}$p_1$ => $e_1$
-\hspace*{1ex}\textbar$p_2$ => $e_2$
-\hspace*{1ex}\ldots
-\hspace*{1ex}\textbar$p_n$ => $e_n$
-\hspace*{1ex}\textbar\ \textunderscore\ => $e_{n+1}$
-end.
-}
-\end{center}
-Underscore matches all terms.
-
-\Question{What is the semantics for ``match goal''?}
-
-The semantics of {\tt match goal} depends on whether it returns
-tactics or not.  The {\tt match goal} expression matches the current
-goal against a series of patterns: {$hyp_1 {\ldots} hyp_n$ \textbar-
-$ccl$}. It uses a first-order unification algorithm and in case of
-success, if the right-hand-side is an expression, it tries to type it
-while if the right-hand-side is a tactic, it tries to apply it.  If the
-typing or the tactic application fails, the {\tt match goal} tries all
-the possible combinations of $hyp_i$ before dropping the branch and
-moving to the next one. Underscore matches all terms.
-
-\Question{Why can't I use a ``match goal'' returning a tactic in a non
-tail-recursive position?}
-
-This is precisely because the semantics of {\tt match goal} is to
-apply the tactic on the right as soon as a pattern unifies what is
-meaningful only in tail-recursive uses.
-
-The semantics in non tail-recursive call could have been the one used
-for terms (i.e. fail if the tactic expression is not typable, but
-don't try to apply it). For uniformity of semantics though, this has
-been rejected.
-
-\Question{How can I generate a new name?}
-
-You can use the following syntax:
-{\tt let id:=fresh in \ldots}\\
-For example:
-\begin{coq_example}
-Ltac introIdGen := let id:=fresh in intro id.
-\end{coq_example}
-
-
-\iffalse
-\Question{How can I access the type of a term?}
-
-You can use typeof.
-todo
-\fi
-
-\iffalse
-\Question{How can I define static and dynamic code?}
-\fi
-
-\section{Tactics written in OCaml}
-
-\Question{Can you show me an example of a tactic written in OCaml?}
-
-Have a look at the skeleton ``Hello World'' tactic from the next question. 
-You also have some examples of tactics written in OCaml in the ``plugins'' directory of {\Coq} sources. 
-
-\Question{Is there a skeleton of OCaml tactic I can reuse somewhere?}
-
-The following steps describe how to write a simplistic ``Hello world'' OCaml
-tactic. This takes the form of a dynamically loadable OCaml module, which will
-be invoked from the Coq toplevel.
-\begin{enumerate}
-\item In the \verb+plugins+ directory of the Coq source location, create a
-directory \verb+hello+. Proceed to create a grammar and OCaml file, respectively
-\verb+plugins/hello/g_hello.ml4+ and \verb+plugins/hello/coq_hello.ml+,
-containing:
-  \begin{itemize}
-  \item in \verb+g_hello.ml4+:
-\begin{verbatim}
-(*i camlp4deps: "grammar/grammar.cma" i*)
-TACTIC EXTEND Hello
-| [ "hello" ] -> [ Coq_hello.printHello ]
-END
-\end{verbatim}
-  \item in \verb+coq_hello.ml+:
-\begin{verbatim}
-let printHello gl =
-Tacticals.tclIDTAC_MESSAGE (Pp.str "Hello world") gl
-  \end{verbatim}
-  \end{itemize}
-\item Create a file \verb+plugins/hello/hello_plugin.mllib+, containing the
-names of the OCaml modules bundled in the dynamic library:
-\begin{verbatim}
-Coq_hello
-G_hello
-\end{verbatim}
-\item Append the following lines in \verb+plugins/plugins{byte,opt}.itarget+:
-\begin{itemize}
-  \item in \verb+pluginsopt.itarget+:
-\begin{verbatim}
-hello/hello_plugin.cmxa
-\end{verbatim}
-  \item in \verb+pluginsbyte.itarget+:
-\begin{verbatim}
-hello/hello_plugin.cma
-\end{verbatim}
-\end{itemize}
-\item In the root directory of the Coq source location, modify the file
-\verb+Makefile.common+:
-  \begin{itemize}
-  \item add \verb+hello+ to the \verb+SRCDIR+ definition (second argument of the
-  \verb+addprefix+ function);
-  \item in the section ``Object and Source files'', add \verb+HELLOCMA:=plugins/hello/hello_plugin.cma+;
-  \item add \verb+$(HELLOCMA)+ to the \verb+PLUGINSCMA+ definition.
-  \end{itemize}
-\item Modify the file \verb+Makefile.build+, adding in section ``3) plugins'' the
-line:
-\begin{verbatim}
-hello: $(HELLOCMA)
-\end{verbatim}
-\item From the command line, run \verb+make hello+, then \verb+make plugins/hello/hello_plugin.cmxs+.
-\end{enumerate}
-The call to the tactic \verb+hello+ from a Coq script has to be preceded by
-\verb+Declare ML Module "hello_plugin"+, which will load the dynamic object
-\verb+hello_plugin.cmxs+. For instance:
-\begin{verbatim}
-Declare ML Module "hello_plugin".
-Variable A:Prop.
-Goal A-> A.
-Proof.
-hello.
-auto.
-Qed.
-\end{verbatim}
-
-
-\section{Case studies}
-
-\iffalse
-\Question{How can I define vectors or lists of size n?}
-\fi
-
-
-\Question{How to prove that 2 sets are different?}
-
- You need to find a property true on one set and false on the
-other one. As an example we show how to prove that {\tt bool} and {\tt
-nat} are discriminable. As discrimination property we take the
-property to have no more than 2 elements.
-
-\begin{coq_example*}
-Theorem nat_bool_discr : bool <> nat.
-Proof.
-  pose (discr :=
-    fun X:Set =>
-      ~ (forall a b:X, ~ (forall x:X, x <> a -> x <> b -> False))).
-  intro Heq; assert (H: discr bool).
-  intro H; apply (H true false); destruct x; auto.
-  rewrite Heq in H; apply H; clear H.
-  destruct a; destruct b as [|n]; intro H0; eauto.
-  destruct n; [ apply (H0 2); discriminate | eauto ].
-Qed.
-\end{coq_example*}
-
-\Question{Is there an axiom-free proof of Streicher's axiom $K$ for
-the equality on {\tt nat}?}
-\label{K-nat}
-
-Yes, because equality is decidable on {\tt nat}. Here is the proof.
-
-\begin{coq_example*}
-Require Import Eqdep_dec.
-Require Import Peano_dec.
-Theorem K_nat :
-  forall (x:nat) (P:x = x -> Prop), P (eq_refl x) -> forall p:x = x, P p.
-Proof.
-intros; apply K_dec_set with (p := p).
-apply eq_nat_dec.
-assumption.
-Qed.
-\end{coq_example*}
-
-Similarly, we have
-
-\begin{coq_example*}
-Theorem eq_rect_eq_nat :
-  forall (p:nat) (Q:nat->Type) (x:Q p) (h:p=p), x = eq_rect p Q x p h.
-Proof.
-intros; apply K_nat with (p := h); reflexivity.
-Qed.
-\end{coq_example*}
-
-\Question{How to prove that two proofs of {\tt n<=m} on {\tt nat} are equal?}
-\label{le-uniqueness}
-
-This is provable without requiring any axiom because axiom $K$
-directly holds on {\tt nat}. Here is a proof using question \ref{K-nat}.
-
-\begin{coq_example*}
-Require Import Arith.
-Scheme le_ind' := Induction for le Sort Prop.
-Theorem le_uniqueness_proof : forall (n m : nat) (p q : n <= m), p = q.
-Proof.
-induction p using le_ind'; intro q.
- replace (le_n n) with
-  (eq_rect _ (fun n0 => n <= n0) (le_n n) _ eq_refl).
- 2:reflexivity.
-  generalize (eq_refl n).
-    pattern n at 2 4 6 10, q; case q; [intro | intros m l e].
-     rewrite <- eq_rect_eq_nat; trivial.
-     contradiction (le_Sn_n m); rewrite <- e; assumption.
- replace (le_S n m p) with
-  (eq_rect _ (fun n0 => n <= n0) (le_S n m p) _ eq_refl).
- 2:reflexivity.
-  generalize (eq_refl (S m)).
-    pattern (S m) at 1 3 4 6, q; case q; [intro Heq | intros m0 l HeqS].
-     contradiction (le_Sn_n m); rewrite Heq; assumption.
-     injection HeqS; intro Heq; generalize l HeqS.
-      rewrite <- Heq; intros; rewrite <- eq_rect_eq_nat.
-      rewrite (IHp l0); reflexivity.
-Qed.
-\end{coq_example*}
-
-\Question{How to exploit equalities on sets}
-
-To extract information from an equality on sets, you need to
-find a predicate of sets satisfied by the elements of the sets. As an
-example, let's consider the following theorem.
-
-\begin{coq_example*}
-Theorem interval_discr :
-  forall m n:nat,
-    {x : nat | x <= m} = {x : nat | x <= n} -> m = n.
-\end{coq_example*}
-
-We have a proof requiring the axiom of proof-irrelevance. We
-conjecture that proof-irrelevance can be circumvented by introducing a
-primitive definition of discrimination of the proofs of
-\verb!{x : nat | x <= m}!.
-
-\begin{latexonly}%
-The proof can be found in file {\tt interval$\_$discr.v} in this directory.
-%Here is the proof
-%\begin{small}
-%\begin{flushleft}
-%\begin{texttt}
-%\def_{\ifmmode\sb\else\subscr\fi}
-%\include{interval_discr.v}
-%%% WARNING semantics of \_ has changed !
-%\end{texttt}
-%$a\_b\_c$
-%\end{flushleft}
-%\end{small}
-\end{latexonly}%
-\begin{htmlonly}%
-\ahref{./interval_discr.v}{Here} is the proof.
-\end{htmlonly}
-
-\Question{I have a problem of dependent elimination on
-proofs, how to solve it?}
-
-\begin{coq_eval}
-Reset Initial.
-\end{coq_eval}
-
-\begin{coq_example*}
-Inductive Def1 : Set := c1 : Def1.
-Inductive DefProp : Def1 -> Prop :=
-  c2 : forall d:Def1, DefProp d.
-Inductive Comb : Set :=
-  c3 : forall d:Def1, DefProp d -> Comb.
-Lemma eq_comb :
-  forall (d1 d1':Def1) (d2:DefProp d1) (d2':DefProp d1'),
-    d1 = d1' -> c3 d1 d2 = c3 d1' d2'.
-\end{coq_example*}
-
- You need to derive the dependent elimination
-scheme for DefProp by hand using {\coqtt Scheme}.
-
-\begin{coq_eval}
-Abort.
-\end{coq_eval}
-
-\begin{coq_example*}
-Scheme DefProp_elim := Induction for DefProp Sort Prop.
-Lemma eq_comb :
-  forall d1 d1':Def1,
-    d1 = d1' ->
-    forall (d2:DefProp d1) (d2':DefProp d1'), c3 d1 d2 = c3 d1' d2'.
-intros.
-destruct H.
-destruct d2 using DefProp_elim.
-destruct d2' using DefProp_elim.
-reflexivity.
-Qed.
-\end{coq_example*}
-
-
-\Question{And what if I want to prove the following?}
-
-\begin{coq_example*}
-Inductive natProp : nat -> Prop :=
-  | p0 : natProp 0
-  | pS : forall n:nat, natProp n -> natProp (S n).
-Inductive package : Set :=
-  pack : forall n:nat, natProp n -> package.
-Lemma eq_pack :
- forall n n':nat,
-   n = n' ->
-   forall (np:natProp n) (np':natProp n'), pack n np = pack n' np'.
-\end{coq_example*}
-
-
-
-\begin{coq_eval}
-Abort.
-\end{coq_eval}
-\begin{coq_example*}
-Scheme natProp_elim := Induction for natProp Sort Prop.
-Definition pack_S : package -> package.
-destruct 1.
-apply (pack (S n)).
-apply pS; assumption.
-Defined.
-Lemma eq_pack :
-  forall n n':nat,
-    n = n' ->
-    forall (np:natProp n) (np':natProp n'), pack n np = pack n' np'.
-intros n n' Heq np np'.
-generalize dependent n'.
-induction np using natProp_elim.
-induction np' using natProp_elim; intros; auto.
- discriminate Heq.
-induction np' using natProp_elim; intros; auto.
- discriminate Heq.
-change (pack_S (pack n np) = pack_S (pack n0 np')).
-apply (f_equal (A:=package)).
-apply IHnp.
-auto.
-Qed.
-\end{coq_example*}
-
-
-
-
-
-
-
-\section{Publishing tools}
-
-\Question{How can I generate some latex from my development?}
-
-You can use {\tt coqdoc}.
-
-\Question{How can I generate some HTML from my development?}
-
-You can use {\tt coqdoc}.
-
-\Question{How can I generate some dependency graph from my development?}
-
-You can use the tool \verb|coqgraph| developed by Philippe Audebaud in 2002.
-This tool transforms dependencies generated by \verb|coqdep| into 'dot' files which can be visualized using the Graphviz software (http://www.graphviz.org/).
-
-\Question{How can I cite some {\Coq} in my latex document?}
-
-You can use {\tt coq\_tex}.
-
-\Question{How can I cite the {\Coq} reference manual?}
-
-You can use this bibtex entry:
-\begin{verbatim}
-@Manual{Coq:manual,
-  title =        {The Coq proof assistant reference manual},
-  author =       {\mbox{The Coq development team}},
-  organization = {LogiCal Project},
-  note =         {Version 8.2},
-  year =         {2009},
-  url =          "http://coq.inria.fr"
-}
-\end{verbatim}
-
-\Question{Where can I publish my developments in {\Coq}?}
-
-You can submit your developments as a user contribution to the {\Coq}
-development team. This ensures its liveness along the evolution and
-possible changes of {\Coq}.
-
-You can also submit your developments to the HELM/MoWGLI repository at
-the University of Bologna (see
-\ahref{http://mowgli.cs.unibo.it}{\url{http://mowgli.cs.unibo.it}}). For
-developments submitted in this database, it is possible to visualize
-the developments in natural language and execute various retrieving
-requests.
-
-\Question{How can I read my proof in natural language?}
-
-You can submit your proof to the HELM/MoWGLI repository and use the
-rendering tool provided by the server (see
-\ahref{http://mowgli.cs.unibo.it}{\url{http://mowgli.cs.unibo.it}}).
-
-\section{\CoqIde}
-
-\Question{What is {\CoqIde}?}
-
-{\CoqIde} is a gtk based GUI for \Coq.
-
-\Question{How to enable Emacs keybindings?}
-
-If in Gnome, run the gnome configuration editor (\texttt{gconf-editor})
-and set key \texttt{gtk-key-theme} to \texttt{Emacs} in the category
-\texttt{desktop/gnome/interface}.
-
-Otherwise, you need to find where the \verb#gtk-key-theme-name# option is located in
-your configuration, and set it to \texttt{Emacs}. Usually, it is in the
-\verb#$(HOME)/.gtkrc-2.0# file.
-
-
-%$ juste pour que la coloration emacs marche
-
-\Question{How to enable antialiased fonts?}
-
- Set the \verb#GDK_USE_XFT# variable to \verb#1#. This is by default
-    with \verb#Gtk >= 2.2#.  If some of your fonts are not available,
-    set \verb#GDK_USE_XFT# to \verb#0#.
-
-\Question{How to use those Forall and Exists pretty symbols?}\label{forallcoqide}
- Thanks to the notation features in \Coq, you just need to insert these
-lines in your {\Coq} buffer:\\
-\begin{tt}
-Notation "$\forall$ x : t, P" := (forall x:t, P) (at level 200, x ident).
-\end{tt}\\
-\begin{tt}
-Notation "$\exists$ x : t, P" := (exists x:t, P) (at level 200, x ident).
-\end{tt}
-
-Copy/Paste of these lines from this file will not work outside of \CoqIde.
-You need to load a file containing these lines or to enter the $\forall$
-using an input method (see \ref{inputmeth}). To try it just use \verb#Require Import utf8# from inside
-\CoqIde. 
-To enable these notations automatically start coqide with
-\begin{verbatim}
-	coqide -l utf8
-\end{verbatim}
-In the ide subdir of {\Coq} library, you will find a sample utf8.v with some 
-pretty simple notations.
-
-\Question{How to define an input method for non ASCII symbols?}\label{inputmeth}
-
-\begin{itemize}
-\item First solution: type \verb#<CONTROL><SHIFT>2200# to enter a forall in the script widow. 
-	2200 is the hexadecimal code for forall in unicode charts and is encoded as 	
-	in UTF-8.
-	2203 is for exists. See \ahref{http://www.unicode.org}{\url{http://www.unicode.org}} for more codes.
-\item Second solution: rebind \verb#<AltGr>a# to forall and \verb#<AltGr>e# to exists.
-
-       Under X11, one can add those lines in the file ~/.xmodmaprc :
-
-\begin{verbatim}
-! forall
-keycode  24 = a A a A U2200 NoSymbol U2200 NoSymbol
-! exists
-keycode  26 = e E e E U2203 NoSymbol U2203 NoSymbol
-\end{verbatim}
-and then run xmodmap ~/.xmodmaprc.
-\end{itemize}
-
-	Alternatively, you may use an input method editor such as SCIM or iBus.
-The latter offers a \LaTeX-like input method.
-
-\Question{How to customize the shortcuts for menus?}
- Two solutions are offered:
-\begin{itemize}
-\item Edit \verb+$XDG_CONFIG_HOME/coq/coqide.keys+ (which is usually \verb+$HOME/.config/coq/coqide.keys+) by hand or
-\item If your system supports it, from \CoqIde, you may select a menu entry and press the desired 
-    shortcut. 
-\end{itemize}
-
-\Question{What encoding should I use? What is this $\backslash$x\{iiii\} in my file?}
- The encoding option is related to the way files are saved. 
- Keep it as UTF-8 until it becomes important for you to exchange files 
- with non UTF-8 aware applications.
- If you choose something else than UTF-8, then missing characters will 
- be encoded by $\backslash$x\{....\} or $\backslash$x\{........\}
- where each dot is an hex. digit. 
- The number between braces is the hexadecimal UNICODE index for the
-  missing character.
-    
-\Question{How to get rid of annoying unwanted automatic templates?}
-
-Some users may experiment problems with unwanted automatic
-templates while using Coqide. This is due to a change in the
-modifiers keys available through GTK. The straightest way to get
-rid of the problem is to edit by hand your coqiderc (either
-\verb|/home/<user>/.config/coq/coqiderc| under Linux, or \\
-\verb|C:\Documents and Settings\<user>\.config\coq\coqiderc| under Windows) 
-and replace any occurrence of \texttt{MOD4} by \texttt{MOD1}.
-
-
-
-\section{Extraction}
-
-\Question{What is program extraction?}
-
-Program extraction consist in generating a program from a constructive proof.
-
-\Question{Which language can I extract to?}
-
-You can extract your programs to Objective Caml and Haskell.
-
-\Question{How can I extract an incomplete proof?}
-
-You can provide programs for your axioms.
-
-
-
-%%%%%%%
-\section{Glossary}
-
-\Question{Can you explain me what an evaluable constant is?}
-
-An evaluable constant is a constant which is unfoldable.
-
-\Question{What is a goal?}
-
-The goal is the statement to be proved.
-
-\Question{What is a meta variable?}
-
-A meta variable in {\Coq} represents a ``hole'', i.e. a part of a proof
-that is still unknown. 
-
-\Question{What is Gallina?}  
-
-Gallina is the specification language of \Coq. Complete documentation
-of this language can be found in the Reference Manual.
-
-\Question{What is The Vernacular?}  
-
-It is the language of commands of Gallina i.e. definitions, lemmas, {\ldots}  
-
-
-\Question{What is a dependent type?}
-
-A 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?}
-
-This is a proof generated by some computation which is done using the
-internal reduction of {\Coq} (not using the tactic language of {\Coq}
-(\Ltac) nor the implementation language for \Coq).  An example of
-tactic using the reflection mechanism is the {\ring} tactic. The
-reflection method consist in reflecting a subset of {\Coq} language (for
-example the arithmetical expressions) into an object of the {\Coq}
-language itself (in this case an inductive type denoting arithmetical
-expressions).  For more information see~\cite{howe,harrison,boutin}
-and the last chapter of the Coq'Art.
-
-\Question{What is intuitionistic logic?}
-
-This is any logic which does not assume that ``A or not A''.
-
-
-\Question{What is proof-irrelevance?}
-
-See question \ref{proof-irrelevance}
-
-
-\Question{What is the difference between opaque and transparent?}{\label{opaque}}	
-
-Opaque definitions can not be unfolded but transparent ones can.
-
-
-\section{Troubleshooting}
-
-\Question{What can I do when {\tt Qed.} is slow?}
-
-Sometime you can use the {\abstracttac} tactic, which makes as if you had
-stated some local lemma, this speeds up the typing process.
-
-\Question{Why \texttt{Reset Initial.} does not work when using \texttt{coqc}?}
-
-The initial state corresponds to the state of \texttt{coqtop} when the interactive
-session began. It does not make sense in files to compile.
-
-
-\Question{What can I do if I get ``No more subgoals but non-instantiated existential variables''?}
-
-This means that {\eauto} or {\eapply} didn't instantiate an
-existential variable which eventually got erased by some computation.
-You may backtrack to the faulty occurrence of {\eauto} or {\eapply}
-and give the missing argument an explicit value. Alternatively, you
-can use the commands \texttt{Show Existentials.} and
-\texttt{Existential.} to display and instantiate the remaining
-existential variables.
-
-
-\begin{coq_example}
-Lemma example_show_existentials :  forall a b c:nat, a=b -> b=c -> a=c.
-Proof.
-intros.
-eapply eq_trans.
-Show Existentials.
-eassumption.
-assumption.
-\end{coq_example}
-\begin{coq_example*}
-Qed.
-\end{coq_example*}
-
-
-\Question{What can I do if I get ``Cannot solve a second-order unification problem''?}
-
-You can help {\Coq} using the {\pattern} tactic.
-
-
-\Question{I copy-paste a term and {\Coq} says it is not convertible
-  to the original term. Sometimes it even says the copied term is not
-well-typed.}
-
- This is probably due to invisible implicit information (implicit
-arguments, coercions and Cases annotations) in the printed term, which
-is not re-synthesised from the copied-pasted term in the same way as
-it is in the original term.
-
-  Consider for instance {\tt (@eq Type True True)}. This term is
-printed as {\tt True=True} and re-parsed as {\tt (@eq Prop True
-True)}. The two terms are not convertible (hence they fool tactics
-like {\tt pattern}).
-
-  There is currently no satisfactory answer to the problem. However,
-the command {\tt Set Printing All} is useful for diagnosing the
-problem.
- 
-  Due to coercions, one may even face type-checking errors. In some
-rare cases, the criterion to hide coercions is a bit too loose, which
-may result in a typing error message if the parser is not able to find
-again the missing coercion.
-
-
-
-\section{Conclusion and Farewell.}
-\label{ccl}
-
-\Question{What if my question isn't answered here?} 
-\label{lastquestion}
-
-Don't panic \verb+:-)+. You can try the {\Coq} manual~\cite{Coq:manual} for a technical
-description of the prover. The Coq'Art~\cite{Coq:coqart} is the first
-book written on {\Coq} and provides a comprehensive review of the
-theorem prover as well as a number of example and exercises. Finally,
-the tutorial~\cite{Coq:Tutorial} provides a smooth introduction to
-theorem proving in \Coq.
-
-
-%%%%%%%
-\newpage
-\nocite{LaTeX:intro}
-\nocite{LaTeX:symb}
-\bibliography{fk}
-
-%%%%%%%
-\typeout{*********************************************}
-\typeout{********* That makes {\thequestion} questions **********}
-\typeout{*********************************************}
-
-\end{document}
diff --git a/doc/faq/axioms.fig b/doc/faq/axioms.fig
deleted file mode 100644
index 963178503..000000000
--- a/doc/faq/axioms.fig
+++ /dev/null
@@ -1,131 +0,0 @@
-#FIG 3.2  Produced by xfig version 3.2.5c
-Landscape
-Center
-Inches
-Letter  
-100.00
-Single
--2
-1200 2
-5 1 0 1 0 7 50 -1 -1 0.000 0 1 1 0 14032.500 7222.500 4725 3825 4425 4800 4200 6000
-	1 1 1.00 60.00 120.00
-5 1 0 1 0 7 50 -1 -1 0.000 0 0 0 1 3600.000 8925.000 3600 9075 3450 8925 3600 8775
-	1 1 1.00 60.00 120.00
-5 1 0 1 0 7 50 -1 -1 0.000 0 0 0 1 3600.000 8625.000 3600 8775 3450 8625 3600 8475
-	1 1 1.00 60.00 120.00
-5 1 0 1 0 7 50 -1 -1 0.000 0 0 1 1 3600.000 8325.000 3600 8475 3450 8325 3600 8175
-	1 1 1.00 60.00 120.00
-	1 1 1.00 60.00 120.00
-5 1 0 1 0 7 50 -1 -1 0.000 0 0 1 1 3600.000 8625.000 3600 8775 3450 8625 3600 8475
-	1 1 1.00 60.00 120.00
-	1 1 1.00 60.00 120.00
-5 1 0 1 0 7 50 -1 -1 0.000 0 0 1 1 3600.000 8925.000 3600 9075 3450 8925 3600 8775
-	1 1 1.00 60.00 120.00
-	1 1 1.00 60.00 120.00
-5 1 0 1 0 7 50 -1 -1 0.000 0 0 1 1 3600.000 9225.000 3600 9375 3450 9225 3600 9075
-	1 1 1.00 60.00 120.00
-	1 1 1.00 60.00 120.00
-5 1 0 1 0 7 50 -1 -1 0.000 0 1 1 0 6309.515 5767.724 4200 3825 3450 5550 3825 7200
-	1 1 1.00 60.00 120.00
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
-	1 1 1.00 60.00 120.00
-	 7725 3900 7200 6000
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
-	1 1 1.00 60.00 120.00
-	 7200 6225 7200 7050
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 1 2
-	1 1 1.00 60.00 120.00
-	1 1 1.00 60.00 120.00
-	 5550 5625 5550 6000
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 1 2
-	1 1 1.00 60.00 120.00
-	1 1 1.00 60.00 120.00
-	 3375 3225 3375 3600
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
-	1 1 1.00 60.00 120.00
-	 3373 1950 3376 2250
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 1 2
-	1 1 1.00 60.00 120.00
-	1 1 1.00 60.00 120.00
-	 3375 2625 3375 3000
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
-	 2175 3600 3750 3600
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
-	1 1 1.00 60.00 120.00
-	 3075 2475 2475 2475
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
-	1 1 1.00 60.00 120.00
-	 3374 1125 3377 1425
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
-	1 1 1.00 60.00 120.00
-	 3075 975 1575 975
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
-	1 1 1.00 60.00 120.00
-	 3075 1725 2025 1725
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 4
-	 8025 5925 8250 5925 9000 4950 9150 4950
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
-	1 1 1.00 60.00 120.00
-	 8625 5400 8250 3900
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
-	1 1 1.00 60.00 120.00
-	 7050 7350 4575 7950
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
-	1 1 1.00 60.00 120.00
-	 4200 7500 4200 7950
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 1 2
-	1 1 1.00 60.00 120.00
-	1 1 1.00 60.00 120.00
-	 1139 2771 1364 3521
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
-	 4425 4875 7350 3825
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
-	1 1 1.00 60.00 120.00
-	 1048 1125 1051 1425
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
-	1 1 1.00 60.00 120.00
-	 1049 1950 1052 2250
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
-	1 1 1.00 60.00 120.00
-	 1500 3900 2175 6000
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 0 0 2
-	 4575 6000 6450 6000
-2 1 0 1 0 7 50 -1 -1 0.000 0 0 -1 1 0 2
-	1 1 1.00 60.00 120.00
-	 4714 6255 7039 7080
-2 1 0 1 -1 7 50 -1 -1 0.000 0 0 -1 1 0 2
-	1 1 1.00 60.00 120.00
-	 4200 6225 4200 7200
-3 0 0 1 0 7 50 -1 -1 0.000 0 0 0 4
-	 6450 7050 4050 6675 3750 6825 3750 7050
-	 0.000 1.000 1.000 0.000
-4 0 -1 50 -1 2 12 0.0000 2 135 1440 3675 6225 Excluded-middle\001
-4 0 -1 50 -1 0 12 0.0000 2 180 1065 450 1050 Operator iota\001
-4 0 -1 50 -1 0 12 0.0000 2 180 2850 3150 2400 Constructive indefinite description\001
-4 0 -1 50 -1 0 12 0.0000 2 180 1965 3150 2625 in propositional context\001
-4 0 -1 50 -1 0 12 0.0000 2 135 2235 450 2400 Constructive definite descr.\001
-4 0 -1 50 -1 0 12 0.0000 2 180 1965 450 2625 in propositional context\001
-4 0 -1 50 -1 0 12 0.0000 2 135 1995 3825 3750 Relational choice axiom\001
-4 0 -1 50 -1 0 12 0.0000 2 180 1965 6900 3750 Predicate extensionality\001
-4 0 -1 50 -1 0 12 0.0000 2 180 1710 1275 5025 (if Set impredicative)\001
-4 0 -1 50 -1 0 12 0.0000 2 165 1065 3750 5250 (Diaconescu)\001
-4 0 -1 50 -1 0 12 0.0000 2 180 2070 4950 5550 Propositional degeneracy\001
-4 0 -1 50 -1 0 12 0.0000 2 180 2310 6150 6150 Propositional extensionality\001
-4 0 -1 50 -1 0 12 0.0000 2 180 2325 4950 6525 (needs Prop-impredicativity)\001
-4 0 -1 50 -1 0 12 0.0000 2 165 720 6000 6750 (Berardi)\001
-4 0 -1 50 -1 0 12 0.0000 2 135 1725 1575 6225 Not excluded-middle\001
-4 0 -1 50 -1 0 12 0.0000 2 180 2730 3375 7425 Decidability of equality on any A\001
-4 0 -1 50 -1 0 12 0.0000 2 135 1170 3600 8175 Axiom K on A\001
-4 0 -1 50 -1 0 12 0.0000 2 180 4035 3600 8475 Uniqueness of reflexivity proofs for equality on A\001
-4 0 -1 50 -1 0 12 0.0000 2 180 2865 3600 8775 Uniqueness of equality proofs on A\001
-4 0 -1 50 -1 0 12 0.0000 2 180 5220 3600 9375 Invariance by substitution of reflexivity proofs for equality on A\001
-4 0 -1 50 -1 2 12 0.0000 2 180 2145 9000 5175 Functional extensionality\001
-4 0 -1 50 -1 2 12 0.0000 2 180 3585 3600 9075 Injectivity of equality on Sigma-types on A\001
-4 0 -1 50 -1 2 12 0.0000 2 135 1515 6450 7275 Proof-irrelevance\001
-4 0 -1 50 -1 2 12 0.0000 2 180 1440 3150 1050 Operator epsilon\001
-4 0 -1 50 -1 2 12 0.0000 2 135 1080 3150 1650 Constructive\001
-4 0 -1 50 -1 2 12 0.0000 2 180 1785 3150 1875 indefinite description\001
-4 0 -1 50 -1 2 12 0.0000 2 135 2085 3150 3150 Functional choice axiom\001
-4 0 -1 50 -1 2 12 0.0000 2 135 1080 450 1650 Constructive\001
-4 0 -1 50 -1 2 12 0.0000 2 180 1620 450 1875 definite description\001
-4 0 -1 50 -1 2 12 0.0000 2 180 1980 450 3750 Axiom of unique choice\001
diff --git a/doc/faq/fk.bib b/doc/faq/fk.bib
deleted file mode 100644
index 3410427de..000000000
--- a/doc/faq/fk.bib
+++ /dev/null
@@ -1,2221 +0,0 @@
-%%%%%%% FAQ %%%%%%%
-
-@book{ProofsTypes,
-  Author="Girard, Jean-Yves and Yves Lafont and Paul Taylor",
-  Title="Proofs and Types",
-  Publisher="Cambrige Tracts in Theoretical Computer Science, Cambridge University Press",
-  Year="1989"
-}
-
-@misc{Types:Dowek,
-  author = "Gilles Dowek",
-  title = "Th{\'e}orie des types",
-  year = 2002,
-  howpublished = "Lecture notes",
-  url= "http://www.lix.polytechnique.fr/~dowek/Cours/theories_des_types.ps.gz"
-}
-
-@PHDTHESIS{EGThese,
-  author = {Eduardo Giménez},
-  title = {Un Calcul de Constructions Infinies et son application
-a la vérification de systèmes communicants},
-  type = {thèse d'Université},
-  school = {Ecole Normale Supérieure de Lyon},
-  month = {December},
-  year = {1996},
-}
-
-
-%%%%%%% Semantique %%%%%%%
-
-@misc{Sem:cours,
-  author = "François Pottier",
-  title =  "{Typage et Programmation}",
-  year = "2002",
-  howpublished = "Lecture notes",
-  note = "DEA PSPL"
-}
-
-@inproceedings{Sem:Dubois,
-  author    = {Catherine Dubois},
-  editor    = {Mark Aagaard and
-               John Harrison},
-  title     = "{Proving ML Type Soundness Within Coq}",
-  pages     = {126-144},
-  booktitle = {TPHOLs},
-  publisher = {Springer},
-  series    = {Lecture Notes in Computer Science},
-  volume    = {1869},
-  year      = {2000},
-  isbn      = {3-540-67863-8},
-  bibsource = {DBLP, http://dblp.uni-trier.de}
-}
-
-@techreport{Sem:Plotkin, 
-author = {Gordon D. Plotkin}, 
-institution = {Aarhus University}, 
-number = {{DAIMI FN-19}}, 
-title = {{A structural approach to operational semantics}}, 
-year = {1981} 
-} 
-
-@article{Sem:RemyV98,
-  author     = "Didier R{\'e}my and J{\'e}r{\^o}me Vouillon",
-  title =        "Objective {ML}: 
-                  An effective object-oriented extension to {ML}",
-  journal =      "Theory And Practice of Object Systems",
-  year =         1998,
-  volume =    "4",
-  number =    "1",
-  pages =     "27--50",
-  note =      {A preliminary version appeared in the proceedings
-                  of the 24th ACM Conference on Principles
-                  of Programming Languages, 1997}
-}
-
-@book{Sem:Winskel,
-  AUTHOR      = {Winskel, Glynn},
-  TITLE       = {The Formal Semantics of Programming Languages},
-  NOTE        = {WIN g2 93:1 P-Ex},
-  YEAR        = {1993},
-  PUBLISHER   = {The MIT Press},
-  SERIES      = {Foundations of Computing},
- }
-
-@Article{Sem:WrightFelleisen,
-  refkey =       "C1210",
-  title =        "A Syntactic Approach to Type Soundness",
-  author =       "Andrew K. Wright and Matthias Felleisen",
-  pages =        "38--94",
-  journal =      "Information and Computation",
-  month =        "15~" # nov,
-  year =         "1994",
-  volume =       "115",
-  number =       "1"
-}
-
-@inproceedings{Sem:Nipkow-MOD,
-  author={Tobias Nipkow},
-  title={Jinja: Towards a Comprehensive Formal Semantics for a
-       {J}ava-like Language},
-  booktitle={Proc.\ Marktobderdorf Summer School 2003},
-  publisher={IOS Press},editor={H. Schwichtenberg and K. Spies},
-  year=2003,
-  note={To appear}
-}
-
-%%%%%%% Coq %%%%%%%
-
-@book{Coq:coqart,
-  title = "Interactive Theorem Proving and Program Development,
-	  Coq'Art: The Calculus of Inductive Constructions",
-  author = "Yves Bertot and Pierre Castéran",
-  publisher = "Springer Verlag",
-  series = "Texts in Theoretical Computer Science. An
-	  EATCS series",
-  year = 2004
-}
-			 
-@phdthesis{Coq:Del01,
-	AUTHOR = "David Delahaye",
-	TITLE = "Conception de langages pour décrire les preuves et les 
-                  automatisations dans les outils d'aide à la preuve",
-	SCHOOL = {Universit\'e Paris~6},
-	YEAR = "2001",
-        Type = {Th\`ese de Doctorat}
-}
-
-@techreport{Coq:gimenez-tut,
-    author = "Eduardo Gim\'enez",
-    title = "A Tutorial on Recursive Types in Coq",
-    number = "RT-0221",
-    pages = "42 p.",
-    url = "citeseer.nj.nec.com/gimenez98tutorial.html" }
-
-@phdthesis{Coq:Mun97,
-	AUTHOR = "César Mu{\~{n}}oz",
-	TITLE = "Un calcul de substitutions pour la repr\'esentation
-                  de preuves partielles en th\'eorie de types",
-	SCHOOL = {Universit\'e Paris~7},
-        Number = {Unit\'e de recherche INRIA-Rocquencourt, TU-0488},
-	YEAR = "1997",
-        Note = {English version available as INRIA research report RR-3309},
-        Type = {Th\`ese de Doctorat}
-}
-
-@PHDTHESIS{Coq:Filliatre99,
-  AUTHOR = {J.-C. Filli\^atre},
-  TITLE = {{Preuve de programmes imp\'eratifs en th\'eorie des types}},
-  TYPE = {Th{\`e}se de Doctorat},
-  SCHOOL = {Universit\'e Paris-Sud},
-  YEAR = 1999,
-  MONTH = {July},
-}
-
-@manual{Coq:Tutorial,
-  AUTHOR = {G\'erard Huet and Gilles Kahn and Christine Paulin-Mohring},
-  TITLE = {{The Coq Proof Assistant A Tutorial}},
-  YEAR = 2004  
-}
-
-%%%%%%% PVS %%%%%%%
-
-@manual{PVS:prover,
-  title =        "{PVS} Prover Guide",
-  author =       "N. Shankar and S. Owre and J. M. Rushby and D. W. J.
-                 Stringer-Calvert",
-  month =        sep,
-  year =         "1999",
-  organization = "Computer Science Laboratory, SRI International",
-  address =      "Menlo Park, CA",
-}
-
-@techreport{PVS-Semantics:TR,
-  TITLE = {The Formal Semantics of {PVS}},
-  AUTHOR = {Sam Owre and Natarajan Shankar},
-  NUMBER = {CR-1999-209321},
-  INSTITUTION = {Computer Science Laboratory, SRI International},
-  ADDRESS = {Menlo Park, CA},
-  MONTH = may,
-  YEAR = 1999,
-}
-
-@techreport{PVS-Tactics:DiVito,
-  TITLE = {A {PVS} Prover Strategy Package for Common Manipulations},
-  AUTHOR = {Ben L. Di Vito},
-  NUMBER = {TM-2002-211647},
-  INSTITUTION = {Langley Research Center},
-  ADDRESS = {Hampton, VA},
-  MONTH = apr,
-  YEAR = 2002,
-}
-
-@misc{PVS-Tactics:cours,
-  author = "César Muñoz",
-  title = "Strategies in {PVS}",
-  howpublished = "Lecture notes",
-  note = "National Institute of Aerospace",
-  year = 2002
-}
-
-@techreport{PVS-Tactics:field,
-  author = "C. Mu{\~n}oz and M. Mayero",
-  title = "Real Automation in the Field",
-  institution = "ICASE-NASA Langley",
-  number = "NASA/CR-2001-211271 Interim ICASE Report No. 39",
-  month =  "dec",
-  year = "2001"
-}
-
-%%%%%%% Autres Prouveurs %%%%%%%
-
-@misc{ACL2:repNuPrl,
-  author = "James L. Caldwell and John Cowles",
-  title = "{Representing Nuprl Proof Objects in ACL2: toward a proof checker for Nuprl}",
-  url = "http://www.cs.uwyo.edu/~jlc/papers/proof_checking.ps" }
-
-@inproceedings{Elan:ckl-strat,
-  author    = {H. Cirstea and C. Kirchner and L. Liquori},
-  title     = "{Rewrite Strategies in the Rewriting Calculus}",
-  booktitle = {WRLA'02},
-  publisher = "{Elsevier Science B.V.}",
-  series    = {Electronic Notes in Theoretical Computer Science},
-  volume    = {71},
-  year      = {2003},
-}
-
-@book{LCF:GMW,
-  author = {M. Gordon and R. Milner and C. Wadsworth},
-  publisher = {sv},
-  series = {lncs},
-  volume = 78,
-  title = {Edinburgh {LCF}: A Mechanized Logic of Computation},
-  year = 1979
-}
-
-%%%%%%% LaTeX %%%%%%%
-
-@manual{LaTeX:symb,
-  title = "The Great, Big List of \LaTeX\ Symbols",
-  author = "David Carlisle and Scott Pakin and Alexander Holt",
-  month = feb,
-  year = 2001,
-}
-
-@manual{LaTeX:intro,
-  title = "The Not So Short Introduction to \LaTeX2e",
-  author = "Tobias Oetiker",
-  month = jan,
-  year = 1999,
-}
-
-@MANUAL{CoqManualV7,
-  AUTHOR = {{The {Coq} Development Team}},
-  TITLE = {{The Coq Proof Assistant Reference Manual -- Version
- V7.1}},
-  YEAR = {2001},
-  MONTH = OCT,
-  NOTE = {http://coq.inria.fr}
-}
-
-@MANUAL{CoqManual96,
-  TITLE = {The {Coq Proof Assistant Reference Manual} Version 6.1},
-  AUTHOR = {B. Barras and S. Boutin and C. Cornes and J. Courant and 
-                  J.-C. Filli\^atre and 
-                  H. Herbelin and G. Huet and P. Manoury and C. Mu{\~{n}}oz and
-                  C. Murthy and C. Parent and C. Paulin-Mohring and
-                  A. Sa{\"\i}bi and B. Werner},
-  ORGANIZATION = {{INRIA-Rocquencourt}-{CNRS-ENS Lyon}},
-  URL = {ftp://ftp.inria.fr/INRIA/coq/V6.1/doc/Reference-Manual.dvi.gz},
-  YEAR = 1996,
-  MONTH = DEC
-}
-
-@MANUAL{CoqTutorial99,
-  AUTHOR = {G.~Huet and G.~Kahn and Ch.~Paulin-Mohring},
-  TITLE = {The {\sf Coq} Proof Assistant - A tutorial - Version 6.3},
-  MONTH = JUL,
-  YEAR = {1999},
-  ABSTRACT = {http://coq.inria.fr/doc/tutorial.html}
-}
-
-@MANUAL{CoqTutorialV7,
-  AUTHOR = {G.~Huet and G.~Kahn and Ch.~Paulin-Mohring},
-  TITLE = {The {\sf Coq} Proof Assistant - A tutorial - Version 7.1},
-  MONTH = OCT,
-  YEAR = {2001},
-  NOTE = {http://coq.inria.fr}
-}
-
-@TECHREPORT{modelpa2000,
-  AUTHOR = {B. Bérard and P. Castéran and E. Fleury and L. Fribourg 
-                  and J.-F. Monin and C. Paulin and A. Petit and D. Rouillard},
-  TITLE = {Automates temporisés CALIFE},
-  INSTITUTION = {Calife},
-  YEAR = 2000,
-  URL = {http://www.loria.fr/projets/calife/WebCalifePublic/FOURNITURES/F1.1.ps.gz},
-  TYPE = {Fourniture {F1.1}}
-}
-
-@TECHREPORT{CaFrPaRo2000,
-  AUTHOR = {P. Castéran and E. Freund and C. Paulin and D. Rouillard},
-  TITLE = {Bibliothèques Coq et Isabelle-HOL pour les systèmes de transitions              et les p-automates},
-  INSTITUTION = {Calife},
-  YEAR = 2000,
-  URL = {http://www.loria.fr/projets/calife/WebCalifePublic/FOURNITURES/F5.4.ps.gz},
-  TYPE = {Fourniture {F5.4}}
-}
-
-@PROCEEDINGS{TPHOLs99,
-  TITLE = {International Conference on 
-                  Theorem Proving in Higher Order Logics (TPHOLs'99)},
-  YEAR = 1999,
-  EDITOR = {Y. Bertot and G. Dowek and C. Paulin-Mohring and L. Th{\'e}ry},
-  SERIES = {Lecture Notes in Computer Science},
-  MONTH = SEP,
-  PUBLISHER = {{Sprin\-ger-Verlag}},
-  ADDRESS = {Nice},
-  TYPE_PUBLI = {editeur}
-}
-
-@INPROCEEDINGS{Pau01,
-  AUTHOR = {Christine Paulin-Mohring},
-  TITLE = {Modelisation of Timed Automata in {Coq}},
-  BOOKTITLE = {Theoretical Aspects of Computer Software (TACS'2001)},
-  PAGES = {298--315},
-  YEAR = 2001,
-  EDITOR = {N. Kobayashi and B. Pierce},
-  VOLUME = 2215,
-  SERIES = {Lecture Notes in Computer Science},
-  PUBLISHER = {Springer-Verlag}
-}
-
-@PHDTHESIS{Moh89b,
-  AUTHOR = {C. Paulin-Mohring},
-  MONTH = JAN,
-  SCHOOL = {{Paris 7}},
-  TITLE = {Extraction de programmes dans le {Calcul des Constructions}},
-  TYPE = {Thèse d'université},
-  YEAR = {1989},
-  URL = {http://www.lri.fr/~paulin/these.ps.gz}
-}
-
-@ARTICLE{HuMo92,
-  AUTHOR = {G. Huet and C. Paulin-Mohring},
-  EDITION = {INRIA},
-  JOURNAL = {Courrier du CNRS - Informatique},
-  TITLE = {Preuves et Construction de Programmes},
-  YEAR = {1992},
-  CATEGORY = {national}
-}
-
-@INPROCEEDINGS{LePa94,
-  AUTHOR = {F. Leclerc and C. Paulin-Mohring},
-  TITLE = {Programming with Streams in {Coq}. A case study : The Sieve of Eratosthenes},
-  EDITOR = {H. Barendregt and T. Nipkow},
-  VOLUME = 806,
-  SERIES = {Lecture Notes in Computer Science},
-  BOOKTITLE = {{Types for Proofs and Programs, Types' 93}},
-  YEAR = 1994,
-  PUBLISHER = {Springer-Verlag}
-}
-
-@INPROCEEDINGS{Moh86,
-  AUTHOR = {C. Mohring},
-  ADDRESS = {Cambridge, MA},
-  BOOKTITLE = {Symposium on Logic in Computer Science},
-  PUBLISHER = {IEEE Computer Society Press},
-  TITLE = {Algorithm Development in the {Calculus of Constructions}},
-  YEAR = {1986}
-}
-
-@INPROCEEDINGS{Moh89a,
-  AUTHOR = {C. Paulin-Mohring},
-  ADDRESS = {Austin},
-  BOOKTITLE = {Sixteenth Annual ACM Symposium on Principles of Programming Languages},
-  MONTH = JAN,
-  PUBLISHER = {ACM},
-  TITLE = {Extracting ${F}_{\omega}$'s programs from proofs in the {Calculus of Constructions}},
-  YEAR = {1989}
-}
-
-@INCOLLECTION{Moh89c,
-  AUTHOR = {C. Paulin-Mohring},
-  TITLE = {{R\'ealisabilit\'e et extraction de programmes}},
-  BOOKTITLE = {Logique et Informatique : une introduction},
-  PUBLISHER = {INRIA},
-  YEAR = 1991,
-  EDITOR = {B. Courcelle},
-  VOLUME = 8,
-  SERIES = {Collection Didactique},
-  PAGES = {163-180},
-  CATEGORY = {national}
-}
-
-@INPROCEEDINGS{Moh93,
-  AUTHOR = {C. Paulin-Mohring},
-  BOOKTITLE = {Proceedings of the conference Typed Lambda Calculi a
-nd Applications},
-  EDITOR = {M. Bezem and J.-F. Groote},
-  INSTITUTION = {LIP-ENS Lyon},
-  NOTE = {LIP research report 92-49},
-  NUMBER = 664,
-  SERIES = {Lecture Notes in Computer Science},
-  TITLE = {{Inductive Definitions in the System {Coq} - Rules and Properties}},
-  TYPE = {research report},
-  YEAR = 1993
-}
-
-@ARTICLE{PaWe92,
-  AUTHOR = {C. Paulin-Mohring and B. Werner},
-  JOURNAL = {Journal of Symbolic Computation},
-  TITLE = {{Synthesis of ML programs in the system Coq}},
-  VOLUME = {15},
-  YEAR = {1993},
-  PAGES = {607--640}
-}
-
-@INPROCEEDINGS{Pau96,
-  AUTHOR = {C. Paulin-Mohring},
-  TITLE = {Circuits as streams in {Coq} : Verification of a sequential multiplier},
-  BOOKTITLE = {Types for Proofs and Programs, TYPES'95},
-  EDITOR = {S. Berardi and M. Coppo},
-  SERIES = {Lecture Notes in Computer Science},
-  YEAR = 1996,
-  VOLUME = 1158
-}
-
-@PHDTHESIS{Pau96b,
-  AUTHOR = {Christine Paulin-Mohring},
-  TITLE = {Définitions Inductives en Théorie des Types d'Ordre Supérieur},
-  SCHOOL = {Université Claude Bernard Lyon I},
-  YEAR = 1996,
-  MONTH = DEC,
-  TYPE = {Habilitation à diriger les recherches},
-  URL = {http://www.lri.fr/~paulin/habilitation.ps.gz}
-}
-
-@INPROCEEDINGS{PfPa89,
-  AUTHOR = {F. Pfenning and C. Paulin-Mohring},
-  BOOKTITLE = {Proceedings of Mathematical Foundations of Programming Semantics},
-  NOTE = {technical report CMU-CS-89-209},
-  PUBLISHER = {Springer-Verlag},
-  SERIES = {Lecture Notes in Computer Science},
-  VOLUME = 442,
-  TITLE = {Inductively defined types in the {Calculus of Constructions}},
-  YEAR = {1990}
-}
-
-@MISC{krakatoa02,
-  AUTHOR = {Claude March\'e and Christine Paulin and Xavier Urbain},
-  TITLE = {The \textsc{Krakatoa} proof tool},
-  YEAR = 2002,
-  NOTE = {\url{http://krakatoa.lri.fr/}}
-}
-
-@ARTICLE{marche03jlap,
-  AUTHOR = {Claude March{\'e} and Christine Paulin-Mohring and Xavier Urbain},
-  TITLE = {The \textsc{Krakatoa} Tool for Certification of \textsc{Java/JavaCard} Programs annotated in \textsc{JML}},
-  JOURNAL = {Journal of Logic and Algebraic Programming},
-  YEAR = 2003,
-  NOTE = {To appear},
-  URL = {http://krakatoa.lri.fr},
-  TOPICS = {team}
-}
-@ARTICLE{marche04jlap,
-  AUTHOR = {Claude March{\'e} and Christine Paulin-Mohring and Xavier Urbain},
-  TITLE = {The \textsc{Krakatoa} Tool for Certification of \textsc{Java/JavaCard} Programs annotated in \textsc{JML}},
-  JOURNAL = {Journal of Logic and Algebraic Programming},
-  YEAR = 2004,
-  VOLUME = 58,
-  NUMBER = {1--2},
-  PAGES = {89--106},
-  URL = {http://krakatoa.lri.fr},
-  TOPICS = {team}
-}
-
-@TECHREPORT{catano03deliv,
-  AUTHOR = {N{\'e}stor Cata{\~n}o and Marek Gawkowski and
-Marieke Huisman and Bart Jacobs and Claude March{\'e} and Christine Paulin
-and Erik Poll and Nicole Rauch and Xavier Urbain},
-  TITLE = {Logical Techniques for Applet Verification},
-  INSTITUTION = {VerifiCard Project},
-  YEAR = 2003,
-  TYPE = {Deliverable},
-  NUMBER = {5.2},
-  TOPICS = {team},
-  NOTE = {Available from \url{http://www.verificard.org}}
-}
-
-@TECHREPORT{kmu2002rr,
-  AUTHOR = {Keiichirou Kusakari and Claude Marché and Xavier Urbain},
-  TITLE = {Termination of Associative-Commutative Rewriting using Dependency Pairs Criteria},
-  INSTITUTION = {LRI},
-  YEAR = 2002,
-  TYPE = {Research Report},
-  NUMBER = 1304,
-  TYPE_PUBLI = {interne},
-  TOPICS = {team},
-  NOTE = {\url{http://www.lri.fr/~urbain/textes/rr1304.ps.gz}},
-  URL = {http://www.lri.fr/~urbain/textes/rr1304.ps.gz}
-}
-
-@ARTICLE{marche2004jsc,
-  AUTHOR = {Claude March\'e and Xavier Urbain},
-  TITLE = {Modular {\&} Incremental Proofs of {AC}-Termination},
-  JOURNAL = {Journal of Symbolic Computation},
-  YEAR = 2004,
-  TOPICS = {team}
-}
-
-@INPROCEEDINGS{contejean03wst,
-  AUTHOR = {Evelyne Contejean and Claude Marché and Benjamin Monate and Xavier Urbain},
-  TITLE = {{Proving Termination of Rewriting with {\sc C\textit{i}ME}}},
-  CROSSREF = {wst03},
-  PAGES = {71--73},
-  NOTE = {\url{http://cime.lri.fr/}},
-  URL = {http://cime.lri.fr/},
-  YEAR = 2003,
-  TYPE_PUBLI = {icolcomlec},
-  TOPICS = {team}
-}
-
-@TECHREPORT{contejean04rr,
-  AUTHOR = {Evelyne Contejean and Claude March{\'e} and Ana-Paula Tom{\'a}s and Xavier Urbain},
-  TITLE = {Mechanically proving termination using polynomial interpretations},
-  INSTITUTION = {LRI},
-  YEAR = {2004},
-  TYPE = {Research Report},
-  NUMBER = {1382},
-  TYPE_PUBLI = {interne},
-  TOPICS = {team},
-  URL = {http://www.lri.fr/~urbain/textes/rr1382.ps.gz}
-}
-
-@UNPUBLISHED{duran_sub,
-  AUTHOR = {Francisco Duran and Salvador Lucas and
-  Claude {March\'e} and {Jos\'e} Meseguer and Xavier Urbain},
-  TITLE = {Termination of Membership Equational Programs},
-  NOTE = {Submitted}
-}
-
-@PROCEEDINGS{comon95lncs,
-  TITLE = {Term Rewriting},
-  BOOKTITLE = {Term Rewriting},
-  TOPICS = {team, cclserver},
-  YEAR = 1995,
-  EDITOR = {Hubert Comon and Jean-Pierre Jouannaud},
-  SERIES = {Lecture Notes in Computer Science},
-  VOLUME = {909},
-  PUBLISHER = {{Sprin\-ger-Verlag}},
-  ORGANIZATION = {French Spring School of Theoretical Computer
-		  Science},
-  TYPE_PUBLI = {editeur},
-  CLEF_LABO = {CJ95}
-}
-
-@PROCEEDINGS{lics94,
-  TITLE = {Proceedings of the Ninth Annual IEEE Symposium on Logic
-			in Computer Science},
-  BOOKTITLE = {Proceedings of the Ninth Annual IEEE Symposium on Logic
-			in Computer Science},
-  YEAR = 1994,
-  MONTH = JUL,
-  ADDRESS = {Paris, France},
-  ORGANIZATION = {{IEEE} Comp. Soc. Press}
-}
-
-@PROCEEDINGS{rta91,
-  TITLE = {4th International Conference on Rewriting Techniques and
-                        Applications},
-  BOOKTITLE = {4th International Conference on Rewriting Techniques and
-                        Applications},
-  EDITOR = {Ronald. V. Book},
-  YEAR = 1991,
-  MONTH = APR,
-  ADDRESS = {Como, Italy},
-  PUBLISHER = {{Sprin\-ger-Verlag}},
-  SERIES = {Lecture Notes in Computer Science},
-  VOLUME = 488
-}
-
-@PROCEEDINGS{rta96,
-  TITLE = {7th International Conference on Rewriting Techniques and
-			Applications},
-  BOOKTITLE = {7th International Conference on Rewriting Techniques and
-			Applications},
-  EDITOR = {Harald Ganzinger},
-  PUBLISHER = {{Sprin\-ger-Verlag}},
-  YEAR = 1996,
-  MONTH = JUL,
-  ADDRESS = {New Brunswick, NJ, USA},
-  SERIES = {Lecture Notes in Computer Science},
-  VOLUME = 1103
-}
-
-@PROCEEDINGS{rta97,
-  TITLE = {8th International Conference on Rewriting Techniques and
-			Applications},
-  BOOKTITLE = {8th International Conference on Rewriting Techniques and
-			Applications},
-  EDITOR = {Hubert Comon},
-  PUBLISHER = {{Sprin\-ger-Verlag}},
-  YEAR = 1997,
-  MONTH = JUN,
-  ADDRESS = {Barcelona, Spain},
-  SERIES = {Lecture Notes in Computer Science},
-  VOLUME = {1232}
-}
-
-@PROCEEDINGS{rta98,
-  TITLE = {9th International Conference on Rewriting Techniques and
-			Applications},
-  BOOKTITLE = {9th International Conference on Rewriting Techniques and
-			Applications},
-  EDITOR = {Tobias Nipkow},
-  PUBLISHER = {{Sprin\-ger-Verlag}},
-  YEAR = 1998,
-  MONTH = APR,
-  ADDRESS = {Tsukuba, Japan},
-  SERIES = {Lecture Notes in Computer Science},
-  VOLUME = {1379}
-}
-
-@PROCEEDINGS{rta00,
-  TITLE = {11th International Conference on Rewriting Techniques and Applications},
-  BOOKTITLE = {11th International Conference on Rewriting Techniques and Applications},
-  EDITOR = {Leo Bachmair},
-  PUBLISHER = {{Sprin\-ger-Verlag}},
-  SERIES = {Lecture Notes in Computer Science},
-  VOLUME = 1833,
-  MONTH = JUL,
-  YEAR = 2000,
-  ADDRESS = {Norwich, UK}
-}
-
-@PROCEEDINGS{srt95,
-  TITLE = {Proceedings of the Conference on Symbolic Rewriting
-		  Techniques},
-  BOOKTITLE = {Proceedings of the Conference on Symbolic Rewriting
-		  Techniques},
-  YEAR = 1995,
-  EDITOR = {Manuel Bronstein and Volker Weispfenning},
-  ADDRESS = {Monte Verita, Switzerland}
-}
-
-@BOOK{comon01cclbook,
-  BOOKTITLE = {Constraints in Computational Logics},
-  TITLE = {Constraints in Computational Logics},
-  EDITOR = {Hubert Comon and Claude March{\'e} and Ralf Treinen},
-  YEAR = 2001,
-  PUBLISHER = {{Sprin\-ger-Verlag}},
-  SERIES = {Lecture Notes in Computer Science},
-  VOLUME = 2002,
-  TOPICS = {team},
-  TYPE_PUBLI = {editeur}
-}
-
-@PROCEEDINGS{wst03,
-  BOOKTITLE = {{Extended Abstracts of the 6th International Workshop on Termination, WST'03}},
-  TITLE = {{Extended Abstracts of the 6th International Workshop on Termination, WST'03}},
-  YEAR = {2003},
-  EDITOR = {Albert Rubio},
-  MONTH = JUN,
-  NOTE = {Technical Report DSIC II/15/03, Universidad Politécnica de Valencia, Spain}
-}
-
-@INPROCEEDINGS{FilliatreLetouzey03,
-  AUTHOR = {J.-C. Filli\^atre and P. Letouzey},
-  TITLE = {{Functors for Proofs and Programs}},
-  BOOKTITLE = {Proceedings of The European Symposium on Programming},
-  YEAR = 2004,
-  ADDRESS = {Barcelona, Spain},
-  MONTH = {March 29-April 2},
-  NOTE = {To appear},
-  URL = {http://www.lri.fr/~filliatr/ftp/publis/fpp.ps.gz}
-}
-
-@TECHREPORT{Filliatre03,
-  AUTHOR = {J.-C. Filli\^atre},
-  TITLE = {{Why: a multi-language multi-prover verification tool}},
-  INSTITUTION = {{LRI, Universit\'e Paris Sud}},
-  TYPE = {{Research Report}},
-  NUMBER = {1366},
-  MONTH = {March},
-  YEAR = 2003,
-  URL = {http://www.lri.fr/~filliatr/ftp/publis/why-tool.ps.gz}
-}
-
-@ARTICLE{FilliatrePottier02,
-  AUTHOR = {J.-C. Filli{\^a}tre and F. Pottier},
-  TITLE = {{Producing All Ideals of a Forest, Functionally}},
-  JOURNAL = {Journal of Functional Programming},
-  VOLUME = 13,
-  NUMBER = 5,
-  PAGES = {945--956},
-  MONTH = {September},
-  YEAR = 2003,
-  URL = {http://www.lri.fr/~filliatr/ftp/publis/kr-fp.ps.gz},
-  ABSTRACT = {
-  We present a functional implementation of Koda and Ruskey's
-  algorithm for generating all ideals of a forest poset as a Gray
-  code. Using a continuation-based approach, we give an extremely
-  concise formulation of the algorithm's core. Then, in a number of
-  steps, we derive a first-order version whose efficiency is
-  comparable to a C implementation given by Knuth.}
-}
-
-@UNPUBLISHED{FORS01,
-  AUTHOR = {J.-C. Filli{\^a}tre and S. Owre and H. Rue{\ss} and N. Shankar},
-  TITLE = {Deciding Propositional Combinations of Equalities and Inequalities},
-  NOTE = {Unpublished},
-  MONTH = OCT,
-  YEAR = 2001,
-  URL = {http://www.lri.fr/~filliatr/ftp/publis/ics.ps},
-  ABSTRACT = { 
-  We address the problem of combining individual decision procedures
-  into a single decision procedure.  Our combination approach is based
-  on using the canonizer obtained from Shostak's combination algorithm
-  for equality.  We illustrate our approach with a combination
-  algorithm for equality, disequality, arithmetic inequality, and
-  propositional logic.  Unlike the Nelson--Oppen combination where the
-  processing of equalities is distributed across different closed
-  decision procedures, our combination involves the centralized
-  processing of equalities in a single procedure.  The termination
-  argument for the combination is based on that for Shostak's
-  algorithm.  We also give soundness and completeness arguments.}
-}
-
-@INPROCEEDINGS{ICS,
-  AUTHOR = {J.-C. Filli{\^a}tre and S. Owre and H. Rue{\ss} and N. Shankar},
-  TITLE = {{ICS: Integrated Canonization and Solving (Tool presentation)}},
-  BOOKTITLE = {Proceedings of CAV'2001},
-  EDITOR = {G. Berry and H. Comon and A. Finkel},
-  PUBLISHER = {Springer-Verlag},
-  SERIES = {Lecture Notes in Computer Science},
-  VOLUME = 2102,
-  PAGES = {246--249},
-  YEAR = 2001
-}
-
-@INPROCEEDINGS{Filliatre01a,
-  AUTHOR = {J.-C. Filli\^atre},
-  TITLE = {La supériorité de l'ordre supérieur},
-  BOOKTITLE = {Journées Francophones des Langages Applicatifs},
-  PAGES = {15--26},
-  MONTH = {Janvier},
-  YEAR = 2002,
-  ADDRESS = {Anglet, France},
-  URL = {http://www.lri.fr/~filliatr/ftp/publis/sos.ps.gz},
-  CODE = {http://www.lri.fr/~filliatr/ftp/ocaml/misc/koda-ruskey.ps},
-  ABSTRACT = {
-  Nous présentons ici une écriture fonctionnelle de l'algorithme de
-  Koda-Ruskey, un algorithme pour engendrer une large famille
-  de codes de Gray. En s'inspirant de techniques de programmation par
-  continuation, nous aboutissons à un code de neuf lignes seulement,
-  bien plus élégant que les implantations purement impératives
-  proposées jusqu'ici, notamment par Knuth. Dans un second temps,
-  nous montrons comment notre code peut être légèrement modifié pour
-  aboutir à une version de complexité optimale.
-  Notre implantation en Objective Caml rivalise d'efficacité avec les
-  meilleurs codes C. Nous détaillons les calculs de complexité,
-  un exercice intéressant en présence d'ordre supérieur et d'effets de
-  bord combinés.}
-}
-
-@TECHREPORT{Filliatre00c,
-  AUTHOR = {J.-C. Filli\^atre},
-  TITLE = {{Design of a proof assistant: Coq version 7}},
-  INSTITUTION = {{LRI, Universit\'e Paris Sud}},
-  TYPE = {{Research Report}},
-  NUMBER = {1369},
-  MONTH = {October},
-  YEAR = 2000,
-  URL = {http://www.lri.fr/~filliatr/ftp/publis/coqv7.ps.gz},
-  ABSTRACT = {
-  We present the design and implementation of the new version of the
-  Coq proof assistant. The main novelty is the isolation of the
-  critical part of the system, which consists in a type checker for
-  the Calculus of Inductive Constructions. This kernel is now
-  completely independent of the rest of the system and has been
-  rewritten in a purely functional way. This leads to greater clarity
-  and safety, without compromising efficiency. It also opens the way to
-  the ``bootstrap'' of the Coq system, where the kernel will be
-  certified using Coq itself.}
-}
-
-@TECHREPORT{Filliatre00b,
-  AUTHOR = {J.-C. Filli\^atre},
-  TITLE = {{Hash consing in an ML framework}},
-  INSTITUTION = {{LRI, Universit\'e Paris Sud}},
-  TYPE = {{Research Report}},
-  NUMBER = {1368},
-  MONTH = {September},
-  YEAR = 2000,
-  URL = {http://www.lri.fr/~filliatr/ftp/publis/hash-consing.ps.gz},
-  ABSTRACT = {
-  Hash consing is a technique to share values that are structurally
-  equal. Beyond the obvious advantage of saving memory blocks, hash
-  consing may also be used to gain speed in several operations (like
-  equality test) and data structures (like sets or maps) when sharing is
-  maximal. However, physical adresses cannot be used directly for this
-  purpose when the garbage collector is likely to move blocks
-  underneath. We present an easy solution in such a framework, with
-  many practical benefits.}
-}
-
-@MISC{ocamlweb,
-  AUTHOR = {J.-C. Filli\^atre and C. March\'e},
-  TITLE = {{ocamlweb, a literate programming tool for Objective Caml}},
-  NOTE = {Available at \url{http://www.lri.fr/~filliatr/ocamlweb/}},
-  URL = {http://www.lri.fr/~filliatr/ocamlweb/}
-}
-
-@ARTICLE{Filliatre00a,
-  AUTHOR = {J.-C. Filli\^atre},
-  TITLE = {{Verification of Non-Functional Programs 
-                   using Interpretations in Type Theory}},
-  JOURNAL = {Journal of Functional Programming},
-  VOLUME = 13,
-  NUMBER = 4,
-  PAGES = {709--745},
-  MONTH = {July},
-  YEAR = 2003,
-  NOTE = {English translation of~\cite{Filliatre99}.},
-  URL = {http://www.lri.fr/~filliatr/ftp/publis/jphd.ps.gz},
-  ABSTRACT = {We study the problem of certifying programs combining imperative and
-  functional features within the general framework of type theory.
-  
-  Type theory constitutes a powerful specification language, which is
-  naturally suited for the proof of purely functional programs. To
-  deal with imperative programs, we propose a logical interpretation
-  of an annotated program as a partial proof of its specification. The
-  construction of the corresponding partial proof term is based on a
-  static analysis of the effects of the program, and on the use of
-  monads. The usual notion of monads is refined in order to account
-  for the notion of effect. The missing subterms in the partial proof
-  term are seen as proof obligations, whose actual proofs are left to
-  the user. We show that the validity of those proof obligations
-  implies the total correctness of the program.
-  We also establish a result of partial completeness.
-  
-  This work has been implemented in the Coq proof assistant.
-  It appears as a tactic taking an annotated program as argument and
-  generating a set of proof obligations. Several nontrivial
-  algorithms have been certified using this tactic.}
-}
-
-@ARTICLE{Filliatre99c,
-  AUTHOR = {J.-C. Filli\^atre},
-  TITLE = {{Formal Proof of a Program: Find}},
-  JOURNAL = {Science of Computer Programming},
-  YEAR = 2001,
-  NOTE = {To appear},
-  URL = {http://www.lri.fr/~filliatr/ftp/publis/find.ps.gz},
-  ABSTRACT = {In 1971, C.~A.~R.~Hoare gave the proof of correctness and termination of a
-  rather complex algorithm, in a paper entitled \emph{Proof of a
-    program: Find}. It is a hand-made proof, where the
-  program is given together with its formal specification and where
-  each step is fully 
-  justified by a mathematical reasoning.  We present here a formal
-  proof of the same program in the system Coq, using the
-  recent tactic of the system developed to establishing the total
-  correctness of 
-  imperative programs. We follow Hoare's paper as close as
-  possible, keeping the same program and the same specification. We
-  show that we get exactly the same proof obligations, which are
-  proved in a straightforward way, following the original paper.
-  We also explain how more informal reasonings of Hoare's proof are
-  formalized in the system Coq.
-  This demonstrates the adequacy of the system Coq in the
-  process of certifying imperative programs.}
-}
-
-@TECHREPORT{Filliatre99b,
-  AUTHOR = {J.-C. Filli\^atre},
-  TITLE = {{A theory of monads parameterized by effects}},
-  INSTITUTION = {{LRI, Universit\'e Paris Sud}},
-  TYPE = {{Research Report}},
-  NUMBER = {1367},
-  MONTH = {November},
-  YEAR = 1999,
-  URL = {http://www.lri.fr/~filliatr/ftp/publis/monads.ps.gz},
-  ABSTRACT = {Monads were introduced in computer science to express the semantics
-  of programs with computational effects, while type and effect
-  inference was introduced to mark out those effects.
-  In this article, we propose a combination of the notions of effects
-  and monads, where the monadic operators are parameterized by effects.
-  We establish some relationships between those generalized monads and
-  the classical ones.
-  Then we use a generalized monad to translate imperative programs
-  into purely functional ones. We establish the correctness of that
-  translation. This work has been put into practice in the Coq proof
-  assistant to establish the correctness of imperative programs.}
-}
-
-@PHDTHESIS{Filliatre99,
-  AUTHOR = {J.-C. Filli\^atre},
-  TITLE = {{Preuve de programmes imp\'eratifs en th\'eorie des types}},
-  TYPE = {Th{\`e}se de Doctorat},
-  SCHOOL = {Universit\'e Paris-Sud},
-  YEAR = 1999,
-  MONTH = {July},
-  URL = {http://www.lri.fr/~filliatr/ftp/publis/these.ps.gz},
-  ABSTRACT = {Nous étudions le problème de la certification de programmes mêlant
-  traits impératifs et fonctionnels dans le cadre de la théorie des
-  types.
-
-  La théorie des types constitue un puissant langage de spécification,
-  naturellement adapté à la preuve de programmes purement
-  fonctionnels.  Pour y certifier également des programmes impératifs,
-  nous commençons par exprimer leur sémantique de manière purement
-  fonctionnelle. Cette traduction repose sur une analyse statique des
-  effets de bord des programmes, et sur l'utilisation de la notion de
-  monade, notion que nous raffinons en l'associant à la notion d'effet
-  de manière générale.  Nous montrons que cette traduction est
-  sémantiquement correcte.
-
-  Puis, à partir d'un programme annoté, nous construisons une preuve
-  de sa spécification, traduite de manière fonctionnelle. Cette preuve
-  est bâtie sur la traduction fonctionnelle précédemment
-  introduite. Elle est presque toujours incomplète, les parties
-  manquantes étant autant d'obligations de preuve qui seront laissées
-  à la charge de l'utilisateur.  Nous montrons que la validité de ces
-  obligations entraîne la correction totale du programme.
-
-  Nous avons implanté notre travail dans l'assistant de preuve
-  Coq, avec lequel il est dès à présent distribué. Cette
-  implantation se présente sous la forme d'une tactique prenant en
-  argument un programme annoté et engendrant les obligations de
-  preuve.  Plusieurs algorithmes non triviaux ont été certifiés à
-  l'aide de cet outil (Find, Quicksort, Heapsort, algorithme de
-  Knuth-Morris-Pratt).}
-}
-
-@INPROCEEDINGS{FilliatreMagaud99,
-  AUTHOR = {J.-C. Filli\^atre and N. Magaud},
-  TITLE = {{Certification of sorting algorithms in the system Coq}},
-  BOOKTITLE = {Theorem Proving in Higher Order Logics: 
-                  Emerging Trends},
-  YEAR = 1999,
-  ABSTRACT = {We present the formal proofs of total correctness of three sorting
-  algorithms in the system Coq, namely \textit{insertion sort},
-  \textit{quicksort} and \textit{heapsort}. The implementations are
-  imperative programs working in-place on a given array. Those
-  developments demonstrate the usefulness of inductive types and higher-order
-  logic in the process of software certification. They also
-  show that the proof of rather complex algorithms may be done in a
-  small amount of time --- only a few days for each development ---
-  and without great difficulty.},
-  URL = {http://www.lri.fr/~filliatr/ftp/publis/Filliatre-Magaud.ps.gz}
-}
-
-@INPROCEEDINGS{Filliatre98,
-  AUTHOR = {J.-C. Filli\^atre},
-  TITLE = {{Proof of Imperative Programs in Type Theory}},
-  BOOKTITLE = {International Workshop, TYPES '98, Kloster Irsee, Germany},
-  PUBLISHER = {Springer-Verlag},
-  VOLUME = 1657,
-  SERIES = {Lecture Notes in Computer Science},
-  MONTH = MAR,
-  YEAR = {1998},
-  ABSTRACT = {We present a new approach to certifying imperative programs,
-  in the context of Type Theory.
-  The key is a functional translation of imperative programs, which is
-  made possible by an analysis of their effects.
-  On sequential imperative programs, we get the same proof
-  obligations as those given by Floyd-Hoare logic,
-  but our approach also includes functional constructions.
-  As a side-effect, we propose a way to eradicate the use of auxiliary
-  variables in specifications.
-  This work has been implemented in the Coq Proof Assistant and applied
-  on non-trivial examples.},
-  URL = {http://www.lri.fr/~filliatr/ftp/publis/types98.ps.gz}
-}
-
-@TECHREPORT{Filliatre97,
-  AUTHOR = {J.-C. Filli\^atre},
-  INSTITUTION = {LIP - ENS Lyon},
-  NUMBER = {97--04},
-  TITLE = {{Finite Automata Theory in Coq: 
-                              A constructive proof of Kleene's theorem}},
-  TYPE = {Research Report},
-  MONTH = {February},
-  YEAR = {1997},
-  ABSTRACT = {We describe here a development in the system Coq
-  of a piece of Finite Automata Theory. The main result is the Kleene's
-  theorem, expressing that regular expressions and finite automata
-  define the same languages. From a constructive proof of this result,
-  we automatically obtain a functional program that compiles any
-  regular expression into a finite automata, which constitutes the main
-  part of the implementation of {\tt grep}-like programs. This
-  functional program is obtained by the automatic method of {\em
-  extraction} which removes the logical parts of the proof to keep only
-  its informative contents.  Starting with an idea of what we would
-  have written in ML, we write the specification and do the proofs in
-  such a way that we obtain the expected program, which is therefore
-  efficient.},
-  URL = {ftp://ftp.ens-lyon.fr/pub/LIP/Rapports/RR/RR97/RR97-04.ps.Z}
-}
-
-@TECHREPORT{Filliatre95,
-  AUTHOR = {J.-C. Filli\^atre},
-  INSTITUTION = {LIP - ENS Lyon},
-  NUMBER = {96--25},
-  TITLE = {{A decision procedure for Direct Predicate
-                              Calculus: study and implementation in
-                              the Coq system}},
-  TYPE = {Research Report},
-  MONTH = {February},
-  YEAR = {1995},
-  ABSTRACT = {The paper of J. Ketonen and R. Weyhrauch \emph{A
-  decidable fragment of Predicate Calculus} defines a decidable
-  fragment of first-order predicate logic - Direct Predicate Calculus
-  - as the subset which is provable in Gentzen sequent calculus
-  without the contraction rule, and gives an effective decision
-  procedure for it. This report is a detailed study of this
-  procedure. We extend the decidability to non-prenex formulas. We
-  prove that the intuitionnistic fragment is still decidable, with a
-  refinement of the same procedure. An intuitionnistic version has
-  been implemented in the Coq system using a translation into
-  natural deduction.},
-  URL = {ftp://ftp.ens-lyon.fr/pub/LIP/Rapports/RR/RR96/RR96-25.ps.Z}
-}
-
-@TECHREPORT{Filliatre94,
-  AUTHOR = {J.-C. Filli\^atre},
-  MONTH = {Juillet},
-  INSTITUTION = {Ecole Normale Sup\'erieure},
-  TITLE = {{Une proc\'edure de d\'ecision pour le Calcul des Pr\'edicats Direct~: \'etude et impl\'ementation dans le syst\`eme Coq}},
-  TYPE = {Rapport de {DEA}},
-  YEAR = {1994},
-  URL = {ftp://ftp.lri.fr/LRI/articles/filliatr/memoire.dvi.gz}
-}
-
-@TECHREPORT{CourantFilliatre93,
-  AUTHOR = {J. Courant et J.-C. Filli\^atre},
-  MONTH = {Septembre},
-  INSTITUTION = {Ecole Normale Sup\'erieure},
-  TITLE = {{Formalisation de la th\'eorie des langages 
-                              formels en Coq}},
-  TYPE = {Rapport de ma\^{\i}trise},
-  YEAR = {1993},
-  URL = {http://www.ens-lyon.fr/~jcourant/stage_maitrise.dvi.gz},
-  URL2 = {http://www.ens-lyon.fr/~jcourant/stage_maitrise.ps.gz}
-}
-
-@INPROCEEDINGS{tphols2000-Letouzey,
-        crossref        = "tphols2000",
-        title           = "Formalizing {S}t{\aa}lmarck's algorithm in {C}oq",
-        author          = "Pierre Letouzey and Laurent Th{\'e}ry",
-        pages           = "387--404"}
-
-@PROCEEDINGS{tphols2000,
-        editor          = "J. Harrison and M. Aagaard",
-        booktitle       = "Theorem Proving in Higher Order Logics:
-                           13th International Conference, TPHOLs 2000",
-        series          = "Lecture Notes in Computer Science",
-        volume          = 1869,
-        year            = 2000,
-        publisher       = "Springer-Verlag"}
-
-@InCollection{howe,
-  author =       {Doug Howe},
-  title =        {Computation Meta theory in Nuprl},
-  booktitle =    {The Proceedings of the Ninth International Conference of Autom
-ated Deduction},
-  volume =       {310},
-  editor =       {E. Lusk and R. Overbeek},
-  publisher =    {Springer-Verlag},
-  pages =        {238--257},
-  year =         {1988}
-}
-
-@TechReport{harrison,
-  author =       {John Harrison},
-  title =        {Meta theory and Reflection in Theorem Proving:a Survey and Cri
-tique},
-  institution =  {SRI International Cambridge Computer Science Research Center},
-  year =         {1995},
-  number =       {CRC-053}
-}
-
-@InCollection{cc,
-  author =       {Thierry Coquand and Gérard Huet},
-  title =        {The Calculus of Constructions},
-  booktitle =    {Information and Computation},
-  year =         {1988},
-  volume =       {76},
-  number =       {2/3}
-}
-
-
-@InProceedings{coquandcci,
-  author =       {Thierry Coquand and Christine Paulin-Mohring},
-  title =        {Inductively defined types},
-  booktitle =    {Proceedings of Colog'88},
-  year =         {1990},
-  editor =       {P. Martin-Löf and G. Mints},
-  volume =       {417},
-  series =       {LNCS},
-  publisher = {Springer-Verlag}
-}
-
-
-@InProceedings{boutin,
-  author =       {Samuel Boutin},
-  title =        {Using reflection to build efficient and certified decision pro
-cedures.},
-  booktitle =    {Proceedings of TACS'97},
-  year =         {1997},
-  editor =       {M. Abadi and T. Ito},
-  volume =       {1281},
-  series =       {LNCS},
-  publisher =    {Springer-Verlag}
-}
-
-@Manual{Coq:manual,
-  title =        {The Coq proof assistant reference manual},
-  author =       {\mbox{The Coq development team}},
-  organization = {LogiCal Project},
-  note =         {Version 8.0},
-  year =         {2004},
-  url =          "http://coq.inria.fr"
-}
-
-@string{jfp = "Journal of Functional Programming"}
-@STRING{lncs="Lecture Notes in Computer Science"}
-@STRING{lnai="Lecture Notes in Artificial Intelligence"}
-@string{SV = "{Sprin\-ger-Verlag}"}
-
-@INPROCEEDINGS{Aud91,
-        AUTHOR             = {Ph. Audebaud},
-        BOOKTITLE          = {Proceedings of the sixth Conf. on Logic in Computer Science.},
-        PUBLISHER          = {IEEE},
-        TITLE              = {Partial {Objects} in the {Calculus of Constructions}},
-        YEAR               = {1991}
-}
-
-@PHDTHESIS{Aud92,
-        AUTHOR             = {Ph. Audebaud},
-        SCHOOL             = {{Universit\'e} Bordeaux I},
-        TITLE              = {Extension du Calcul des Constructions par Points fixes},
-        YEAR               = {1992}
-}
-
-@INPROCEEDINGS{Audebaud92b,
-        AUTHOR             = {Ph. Audebaud},
-        BOOKTITLE          = {{Proceedings of the 1992 Workshop on Types for Proofs and Programs}},
-        EDITOR             = {{B. Nordstr\"om and K. Petersson and G. Plotkin}},
-        NOTE               = {Also Research Report LIP-ENS-Lyon},
-        PAGES              = {pp 21--34},
-        TITLE              = {{CC+ : an extension of the Calculus of Constructions with fixpoints}},
-        YEAR               = {1992}
-}
-
-@INPROCEEDINGS{Augustsson85,
-        AUTHOR             = {L. Augustsson},
-        TITLE              = {{Compiling Pattern Matching}},
-        BOOKTITLE          = {Conference Functional Programming and
-Computer Architecture},
-        YEAR               = {1985}
-}
-
-@ARTICLE{BaCo85,
-        AUTHOR             = {J.L. Bates and R.L. Constable},
-        JOURNAL            = {ACM transactions on Programming Languages and Systems},
-        TITLE              = {Proofs as {Programs}},
-        VOLUME             = {7},
-        YEAR               = {1985}
-}
-
-@BOOK{Bar81,
-        AUTHOR             = {H.P. Barendregt},
-        PUBLISHER          = {North-Holland},
-        TITLE              = {The Lambda Calculus its Syntax and Semantics},
-        YEAR               = {1981}
-}
-
-@TECHREPORT{Bar91,
-        AUTHOR             = {H. Barendregt},
-        INSTITUTION        = {Catholic University Nijmegen},
-        NOTE               = {In Handbook of Logic in Computer Science, Vol II},
-        NUMBER             = {91-19},
-        TITLE              = {Lambda {Calculi with Types}},
-        YEAR               = {1991}
-}
-
-@ARTICLE{BeKe92,
-        AUTHOR             = {G. Bellin and J. Ketonen},
-        JOURNAL            = {Theoretical Computer Science},
-        PAGES              = {115--142},
-        TITLE              = {A decision procedure revisited : Notes on direct logic, linear logic and its implementation},
-        VOLUME             = {95},
-        YEAR               = {1992}
-}
-
-@BOOK{Bee85,
-        AUTHOR             = {M.J. Beeson},
-        PUBLISHER          = SV,
-        TITLE              = {Foundations of Constructive Mathematics, Metamathematical Studies},
-        YEAR               = {1985}
-}
-
-@BOOK{Bis67,
-        AUTHOR             = {E. Bishop},
-        PUBLISHER          = {McGraw-Hill},
-        TITLE              = {Foundations of Constructive Analysis},
-        YEAR               = {1967}
-}
-
-@BOOK{BoMo79,
-        AUTHOR             = {R.S. Boyer and J.S. Moore},
-        KEY                = {BoMo79},
-        PUBLISHER          = {Academic Press},
-        SERIES             = {ACM Monograph},
-        TITLE              = {A computational logic},
-        YEAR               = {1979}
-}
-
-@MASTERSTHESIS{Bou92,
-        AUTHOR             = {S. Boutin},
-        MONTH              = sep,
-        SCHOOL             = {{Universit\'e Paris 7}},
-        TITLE              = {Certification d'un compilateur {ML en Coq}},
-        YEAR               = {1992}
-}
-
-@inproceedings{Bou97,
-   title = {Using reflection to build efficient and certified decision procedure
-s},
-   author = {S. Boutin},
-   booktitle = {TACS'97},
-   editor = {Martin Abadi and Takahashi Ito},
-   publisher = SV,
-   series = lncs,
-   volume=1281, 
-   PS={http://pauillac.inria.fr/~boutin/public_w/submitTACS97.ps.gz}, 
-   year = {1997}
-}
-
-@PhdThesis{Bou97These,
-  author =       {S. Boutin},
-  title =        {R\'eflexions sur les quotients},
-  school =       {Paris 7},
-  year =         1997,
-  type =         {th\`ese d'Universit\'e},
-  month =        apr
-}
-
-@ARTICLE{Bru72,
-        AUTHOR             = {N.J. de Bruijn},
-        JOURNAL            = {Indag. Math.},
-        TITLE              = {{Lambda-Calculus Notation with Nameless Dummies, a Tool for Automatic Formula Manipulation, with Application to the Church-Rosser Theorem}},
-        VOLUME             = {34},
-        YEAR               = {1972}
-}
-
-
-@INCOLLECTION{Bru80,
-        AUTHOR             = {N.J. de Bruijn},
-        BOOKTITLE          = {to H.B. Curry : Essays on Combinatory Logic, Lambda Calculus and Formalism.},
-        EDITOR             = {J.P. Seldin and J.R. Hindley},
-        PUBLISHER          = {Academic Press},
-        TITLE              = {A survey of the project {Automath}},
-        YEAR               = {1980}
-}
-
-@TECHREPORT{COQ93,
-        AUTHOR             = {G. Dowek and A. Felty and H. Herbelin and G. Huet and C. Murthy and C. Parent and C. Paulin-Mohring and B. Werner},
-        INSTITUTION        = {INRIA},
-        MONTH              = may,
-        NUMBER             = {154},
-        TITLE              = {{The Coq Proof Assistant User's Guide Version 5.8}},
-        YEAR               = {1993}
-}
-
-@TECHREPORT{CPar93,
-        AUTHOR             = {C. Parent},
-        INSTITUTION        = {Ecole {Normale} {Sup\'erieure} de {Lyon}},
-        MONTH              = oct,
-        NOTE               = {Also in~\cite{Nijmegen93}},
-        NUMBER             = {93-29},
-        TITLE              = {Developing certified programs in the system {Coq}- {The} {Program} tactic},
-        YEAR               = {1993}
-}
-
-@PHDTHESIS{CPar95,
-        AUTHOR             = {C. Parent},
-        SCHOOL             = {Ecole {Normale} {Sup\'erieure} de {Lyon}},
-        TITLE              = {{Synth\`ese de preuves de programmes dans le Calcul des Constructions Inductives}},
-        YEAR               = {1995}
-}
-
-@BOOK{Caml,
-        AUTHOR             = {P. Weis and X. Leroy},
-        PUBLISHER          = {InterEditions},
-        TITLE              = {Le langage Caml},
-        YEAR               = {1993}
-}
-
-@INPROCEEDINGS{ChiPotSimp03,
-  AUTHOR    = {Laurent Chicli and Lo\"{\i}c Pottier and Carlos Simpson},
-  ADDRESS   = {Berg en Dal, The Netherlands},
-  TITLE     = {Mathematical Quotients and Quotient Types in Coq},
-  BOOKTITLE = {TYPES'02},
-  PUBLISHER = SV,
-  SERIES    = LNCS,
-  VOLUME    = {2646},
-  YEAR      = {2003}
-}
-
-@TECHREPORT{CoC89,
-        AUTHOR             = {Projet Formel},
-        INSTITUTION        = {INRIA},
-        NUMBER             = {110},
-        TITLE              = {{The Calculus of Constructions. Documentation and user's guide, Version 4.10}},
-        YEAR               = {1989}
-}
-
-@INPROCEEDINGS{CoHu85a,
-        AUTHOR             = {Thierry Coquand and Gérard Huet},
-        ADDRESS            = {Linz},
-        BOOKTITLE          = {EUROCAL'85},
-        PUBLISHER          = SV,
-        SERIES             = LNCS,
-        TITLE              = {{Constructions : A Higher Order Proof System for Mechanizing Mathematics}},
-        VOLUME             = {203},
-        YEAR               = {1985}
-}
-
-@INPROCEEDINGS{CoHu85b,
-        AUTHOR             = {Thierry Coquand and Gérard Huet},
-        BOOKTITLE          = {Logic Colloquium'85},
-        EDITOR             = {The Paris Logic Group},
-        PUBLISHER          = {North-Holland},
-        TITLE              = {{Concepts Math\'ematiques et Informatiques formalis\'es dans le Calcul des Constructions}},
-        YEAR               = {1987}
-}
-
-@ARTICLE{CoHu86,
-        AUTHOR             = {Thierry Coquand and Gérard Huet},
-        JOURNAL            = {Information and Computation},
-        NUMBER             = {2/3},
-        TITLE              = {The {Calculus of Constructions}},
-        VOLUME             = {76},
-        YEAR               = {1988}
-}
-
-@INPROCEEDINGS{CoPa89,
-        AUTHOR             = {Thierry Coquand and Christine Paulin-Mohring},
-        BOOKTITLE          = {Proceedings of Colog'88},
-        EDITOR             = {P. Martin-L\"of and G. Mints},
-        PUBLISHER          = SV,
-        SERIES             = LNCS,
-        TITLE              = {Inductively defined types},
-        VOLUME             = {417},
-        YEAR               = {1990}
-}
-
-@BOOK{Con86,
-        AUTHOR             = {R.L. {Constable et al.}},
-        PUBLISHER          = {Prentice-Hall},
-        TITLE              = {{Implementing Mathematics with the Nuprl Proof Development System}},
-        YEAR               = {1986}
-}
-
-@PHDTHESIS{Coq85,
-        AUTHOR             = {Thierry Coquand},
-        MONTH              = jan,
-        SCHOOL             = {Universit\'e Paris~7},
-        TITLE              = {Une Th\'eorie des Constructions},
-        YEAR               = {1985}
-}
-
-@INPROCEEDINGS{Coq86,
-        AUTHOR             = {Thierry Coquand},
-        ADDRESS            = {Cambridge, MA},
-        BOOKTITLE          = {Symposium on Logic in Computer Science},
-        PUBLISHER          = {IEEE Computer Society Press},
-        TITLE              = {{An Analysis of Girard's Paradox}},
-        YEAR               = {1986}
-}
-
-@INPROCEEDINGS{Coq90,
-        AUTHOR             = {Thierry Coquand},
-        BOOKTITLE          = {Logic and Computer Science},
-        EDITOR             = {P. Oddifredi},
-        NOTE               = {INRIA Research Report 1088, also in~\cite{CoC89}},
-        PUBLISHER          = {Academic Press},
-        TITLE              = {{Metamathematical Investigations of a Calculus of Constructions}},
-        YEAR               = {1990}
-}
-
-@INPROCEEDINGS{Coq91,
-        AUTHOR             = {Thierry Coquand},
-        BOOKTITLE          = {Proceedings 9th Int. Congress of Logic, Methodology and Philosophy of Science},
-        TITLE              = {{A New Paradox in Type Theory}},
-        MONTH              = {August},
-        YEAR               = {1991}
-}
-
-@INPROCEEDINGS{Coq92,
-        AUTHOR             = {Thierry Coquand},
-        TITLE              = {{Pattern Matching with Dependent Types}},
-        YEAR               = {1992},
-        crossref = {Bastad92}
-}
-
-@INPROCEEDINGS{Coquand93,
-        AUTHOR             = {Thierry Coquand},
-        TITLE              = {{Infinite Objects in Type Theory}},
-        YEAR               = {1993},
-        crossref = {Nijmegen93}
-}
-
-@MASTERSTHESIS{Cou94a,
-        AUTHOR             = {J. Courant},
-        MONTH              = sep,
-        SCHOOL             = {DEA d'Informatique, ENS Lyon},
-        TITLE              = {Explicitation de preuves par r\'ecurrence implicite},
-        YEAR               = {1994}
-}
-
-@INPROCEEDINGS{Del99,
-  author    = "Delahaye, D.",
-  title     = "Information Retrieval in a Coq Proof Library using
-               Type Isomorphisms",
-  booktitle = {Proceedings of TYPES'99, L\"okeberg},
-  publisher = SV,
-  series = lncs,
-  year      = "1999",
-  url      =
-    "\\{\sf ftp://ftp.inria.fr/INRIA/Projects/coq/David.Delahaye/papers/}"#
-    "{\sf TYPES99-SIsos.ps.gz}"
-}
-
-@INPROCEEDINGS{Del00,
-  author    = "Delahaye, D.",
-  title     = "A {T}actic {L}anguage for the {S}ystem {{\sf Coq}}",
-  booktitle = "Proceedings of Logic for Programming and Automated Reasoning
-               (LPAR), Reunion Island",
-  publisher = SV,
-  series =  LNCS,
-  volume    = "1955",
-  pages     = "85--95",
-  month     = "November",
-  year      = "2000",
-  url      =
-    "{\sf ftp://ftp.inria.fr/INRIA/Projects/coq/David.Delahaye/papers/}"#
-    "{\sf LPAR2000-ltac.ps.gz}"
-}
-
-@INPROCEEDINGS{DelMay01,
-  author    = "Delahaye, D. and Mayero, M.",
-  title     = {{\tt Field}: une proc\'edure de d\'ecision pour les nombres r\'eels
-               en {\Coq}},
-  booktitle = "Journ\'ees Francophones des Langages Applicatifs, Pontarlier",
-  publisher = "INRIA",
-  month     = "Janvier",
-  year      = "2001",
-  url      =
-    "\\{\sf ftp://ftp.inria.fr/INRIA/Projects/coq/David.Delahaye/papers/}"#
-    "{\sf JFLA2000-Field.ps.gz}"
-}
-
-@TECHREPORT{Dow90,
-        AUTHOR             = {G. Dowek},
-        INSTITUTION        = {INRIA},
-        NUMBER             = {1283},
-        TITLE              = {Naming and Scoping in a Mathematical Vernacular},
-        TYPE               = {Research Report},
-        YEAR               = {1990}
-}
-
-@ARTICLE{Dow91a,
-        AUTHOR             = {G. Dowek},
-        JOURNAL            = {Compte-Rendus de l'Acad\'emie des Sciences},
-        NOTE               = {The undecidability of Third Order Pattern Matching in Calculi with Dependent Types or Type Constructors},
-        NUMBER             = {12},
-        PAGES              = {951--956},
-        TITLE              = {L'Ind\'ecidabilit\'e du Filtrage du Troisi\`eme Ordre dans les Calculs avec Types D\'ependants ou Constructeurs de Types}, 
-        VOLUME             = {I, 312},
-        YEAR               = {1991}
-}		  
-
-@INPROCEEDINGS{Dow91b,
-        AUTHOR             = {G. Dowek},
-        BOOKTITLE          = {Proceedings of Mathematical Foundation of Computer Science},
-        NOTE               = {Also INRIA Research Report},
-        PAGES              = {151--160},
-        PUBLISHER          = SV,
-        SERIES             = LNCS,
-        TITLE              = {A Second Order Pattern Matching Algorithm in the Cube of Typed $\lambda$-calculi},
-        VOLUME             = {520},
-        YEAR               = {1991}
-}
-                  
-@PHDTHESIS{Dow91c,
-        AUTHOR             = {G. Dowek},
-        MONTH              = dec,
-        SCHOOL             = {Universit\'e Paris 7},
-        TITLE              = {D\'emonstration automatique dans le Calcul des Constructions},
-        YEAR               = {1991}
-}
-
-@article{Dow92a,
-        AUTHOR             = {G. Dowek},
-        TITLE              = {The Undecidability of Pattern Matching in Calculi where Primitive Recursive Functions are Representable},
-        YEAR               = 1993,
-        journal = tcs,
-        volume = 107,
-        number = 2,
-        pages = {349-356}
-}
-
-
-@ARTICLE{Dow94a,
-        AUTHOR             = {G. Dowek},
-        JOURNAL            = {Annals of Pure and Applied Logic},
-        VOLUME             = {69},
-        PAGES              = {135--155},
-        TITLE              = {Third order matching is decidable},
-        YEAR               = {1994}
-}
-
-@INPROCEEDINGS{Dow94b,
-        AUTHOR             = {G. Dowek},
-        BOOKTITLE          = {Proceedings of the second international conference on typed lambda calculus and applications},
-        TITLE              = {Lambda-calculus, Combinators and the Comprehension Schema},
-        YEAR               = {1995}
-}
-
-@INPROCEEDINGS{Dyb91,
-        AUTHOR             = {P. Dybjer},
-        BOOKTITLE          = {Logical Frameworks},
-        EDITOR             = {G. Huet and G. Plotkin},
-        PAGES              = {59--79},
-        PUBLISHER          = {Cambridge University Press},
-        TITLE              = {Inductive sets and families in {Martin-L{\"o}f's}
- Type Theory and their set-theoretic semantics: An inversion principle for {Martin-L\"of's} type theory}, 
-        VOLUME             = {14},
-        YEAR               = {1991}
-}
-
-@ARTICLE{Dyc92,
-        AUTHOR             = {Roy Dyckhoff},
-        JOURNAL            = {The Journal of Symbolic Logic},
-        MONTH              = sep,
-        NUMBER             = {3},
-        TITLE              = {Contraction-free sequent calculi for intuitionistic logic},
-        VOLUME             = {57},
-        YEAR               = {1992}
-}
-
-@MASTERSTHESIS{Fil94,
-        AUTHOR             = {J.-C. Filli\^atre},
-        MONTH              = sep,
-        SCHOOL             = {DEA d'Informatique, ENS Lyon},
-        TITLE              = {Une proc\'edure de d\'ecision pour le Calcul des Pr\'edicats Direct. {\'E}tude et impl\'ementation dans le syst\`eme {\Coq}},
-        YEAR               = {1994}
-}
-
-@TECHREPORT{Filliatre95,
-        AUTHOR             = {J.-C. Filli\^atre},
-        INSTITUTION        = {LIP-ENS-Lyon},
-        TITLE              = {A decision procedure for Direct Predicate Calculus},
-        TYPE               = {Research report},
-        NUMBER             = {96--25},
-        YEAR               = {1995}
-}
-
-@Article{Filliatre03jfp,
-  author = 	 {J.-C. Filli{\^a}tre},
-  title = 	 {Verification of Non-Functional Programs 
-                   using Interpretations in Type Theory},
-  journal =      jfp,
-  volume =       13,
-  number =       4,
-  pages =        {709--745},
-  month =	 jul,
-  year =	 2003,
-  note = 	 {[English translation of \cite{Filliatre99}]},
-  url =          {http://www.lri.fr/~filliatr/ftp/publis/jphd.ps.gz},
-  topics =       "team, lri",
-  type_publi =   "irevcomlec"
-}
-
-
-@PhdThesis{Filliatre99,
-  author = 	 {J.-C. Filli\^atre},
-  title = 	 {Preuve de programmes imp\'eratifs en th\'eorie des types},
-  type =         {Th{\`e}se de Doctorat},
-  school = 	 {Universit\'e Paris-Sud},
-  year = 	 1999,
-  month =	 {July},
-  url =         {\url{http://www.lri.fr/~filliatr/ftp/publis/these.ps.gz}}
-}
-
-@Unpublished{Filliatre99c,
-  author = 	 {J.-C. Filli\^atre},
-  title = 	 {{Formal Proof of a Program: Find}},
-  month =        {January},
-  year =         2000,
-  note = 	 {Submitted to \emph{Science of Computer Programming}},
-  url =         {\url{http://www.lri.fr/~filliatr/ftp/publis/find.ps.gz}}
-}
-
-@InProceedings{FilliatreMagaud99,
-  author = 	 {J.-C. Filli\^atre and N. Magaud},
-  title = 	 {Certification of sorting algorithms in the system {\Coq}},
-  booktitle =    {Theorem Proving in Higher Order Logics: 
-                  Emerging Trends},
-  year =	 1999,
-  url = {\url{http://www.lri.fr/~filliatr/ftp/publis/Filliatre-Magaud.ps.gz}}
-}
-
-@UNPUBLISHED{Fle90,
-        AUTHOR             = {E. Fleury},
-        MONTH              = jul,
-        NOTE               = {Rapport de Stage},
-        TITLE              = {Implantation des algorithmes de {Floyd et de Dijkstra} dans le {Calcul des Constructions}},
-        YEAR               = {1990}
-}
-
-@BOOK{Fourier,
-        AUTHOR             = {Jean-Baptiste-Joseph Fourier},
-        PUBLISHER          = {Gauthier-Villars},
-        TITLE              = {Fourier's method to solve linear 
-                              inequations/equations systems.},
-        YEAR               = {1890}
-}
-
-@INPROCEEDINGS{Gim94,
-        AUTHOR             = {Eduardo Gim\'enez},
-        BOOKTITLE          = {Types'94 : Types for Proofs and Programs},
-        NOTE               = {Extended version in LIP research report 95-07, ENS Lyon},
-        PUBLISHER          = SV,
-        SERIES             = LNCS,
-        TITLE              = {Codifying guarded definitions with recursive schemes},
-        VOLUME             = {996},
-        YEAR               = {1994}
-}
-
-@TechReport{Gim98,
-  author = 	 {E. Gim\'enez},
-  title = 	 {A Tutorial on Recursive Types in Coq},
-  institution =  {INRIA},
-  year = 	 1998,
-  month =	 mar
-}
-
-@INPROCEEDINGS{Gimenez95b,
-        AUTHOR             = {E. Gim\'enez},
-        BOOKTITLE          = {Workshop on Types for Proofs and Programs},
-        SERIES             = LNCS,
-        NUMBER             = {1158},
-        PAGES              = {135-152},
-        TITLE              = {An application of co-Inductive types in Coq: 
-		               verification of the Alternating Bit Protocol},
-        EDITORS            = {S. Berardi and M. Coppo},
-        PUBLISHER          = SV,
-        YEAR               = {1995}
-}
-
-@INPROCEEDINGS{Gir70,
-        AUTHOR             = {Jean-Yves Girard},
-        BOOKTITLE          = {Proceedings of the 2nd Scandinavian Logic Symposium},
-        PUBLISHER          = {North-Holland},
-        TITLE              = {Une extension de l'interpr\'etation de {G\"odel} \`a l'analyse, et son application \`a l'\'elimination des coupures dans l'analyse et la th\'eorie des types},
-        YEAR               = {1970}
-}
-
-@PHDTHESIS{Gir72,
-        AUTHOR             = {Jean-Yves Girard},
-        SCHOOL             = {Universit\'e Paris~7},
-        TITLE              = {Interpr\'etation fonctionnelle et \'elimination des coupures de l'arithm\'etique d'ordre sup\'erieur},
-        YEAR               = {1972}
-}
-
-
-
-@BOOK{Gir89,
-        AUTHOR             = {Jean-Yves Girard and Yves Lafont and Paul Taylor},
-        PUBLISHER          = {Cambridge University Press},
-        SERIES             = {Cambridge Tracts in Theoretical Computer Science 7},
-        TITLE              = {Proofs and Types},
-        YEAR               = {1989}
-}
-
-@TechReport{Har95,
-  author = 	 {John Harrison},
-  title = 	 {Metatheory and Reflection in Theorem Proving: A Survey and Critique},
-  institution =  {SRI International Cambridge Computer Science Research Centre,},
-  year = 	 1995,
-  type =	 {Technical Report},
-  number =	 {CRC-053},
-  abstract =	 {http://www.cl.cam.ac.uk/users/jrh/papers.html}
-}
-
-@MASTERSTHESIS{Hir94,
-        AUTHOR             = {Daniel Hirschkoff},
-        MONTH              = sep,
-        SCHOOL             = {DEA IARFA, Ecole des Ponts et Chauss\'ees, Paris},
-        TITLE              = {{\'E}criture d'une tactique arithm\'etique pour le syst\`eme {\Coq}},
-        YEAR               = {1994}
-}
-
-@INPROCEEDINGS{HofStr98,
-        AUTHOR        = {Martin Hofmann and Thomas Streicher},
-        TITLE         = {The groupoid interpretation of type theory},
-        BOOKTITLE     = {Proceedings of the meeting Twenty-five years of constructive type theory},
-        PUBLISHER     = {Oxford University Press},
-        YEAR          = {1998}
-} 
-
-@INCOLLECTION{How80,
-        AUTHOR             = {W.A. Howard},
-        BOOKTITLE          = {to H.B. Curry : Essays on Combinatory Logic, Lambda Calculus and Formalism.},
-        EDITOR             = {J.P. Seldin and J.R. Hindley},
-        NOTE               = {Unpublished 1969 Manuscript},
-        PUBLISHER          = {Academic Press},
-        TITLE              = {The Formulae-as-Types Notion of Constructions},
-        YEAR               = {1980}
-}
-
-
-
-@InProceedings{Hue87tapsoft,
-  author = 	 {G. Huet},
-  title = 	 {Programming of Future Generation Computers},
-  booktitle = 	 {Proceedings of TAPSOFT87},
-       series = LNCS,
-        volume = 249,
-  pages =	 {276--286},
-  year =	 1987,
-  publisher =	 SV
-}
-
-@INPROCEEDINGS{Hue87,
-        AUTHOR             = {G. Huet},
-        BOOKTITLE          = {Programming of Future Generation Computers},
-        EDITOR             = {K. Fuchi and M. Nivat},
-        NOTE               = {Also in \cite{Hue87tapsoft}},
-        PUBLISHER          = {Elsevier Science},
-        TITLE              = {Induction Principles Formalized in the {Calculus of Constructions}},
-        YEAR               = {1988}
-}
-
-
-
-@INPROCEEDINGS{Hue88,
-        AUTHOR             = {G. Huet},
-        BOOKTITLE          = {A perspective in Theoretical Computer Science. Commemorative Volume for Gift Siromoney},
-        EDITOR             = {R. Narasimhan},
-        NOTE               = {Also in~\cite{CoC89}},
-        PUBLISHER          = {World Scientific Publishing},
-        TITLE              = {{The Constructive Engine}},
-        YEAR               = {1989}
-}
-
-@BOOK{Hue89,
-        EDITOR             = {G. Huet},
-        PUBLISHER          = {Addison-Wesley},
-        SERIES             = {The UT Year of Programming Series},
-        TITLE              = {Logical Foundations of Functional Programming},
-        YEAR               = {1989}
-}
-
-@INPROCEEDINGS{Hue92,
-        AUTHOR             = {G. Huet},
-        BOOKTITLE          = {Proceedings of 12th FST/TCS Conference, New Delhi},
-        PAGES              = {229--240},
-        PUBLISHER          = SV,
-        SERIES             = LNCS,
-        TITLE              = {The Gallina Specification Language : A case study},
-        VOLUME             = {652},
-        YEAR               = {1992}
-}
-
-@ARTICLE{Hue94,
-        AUTHOR             = {G. Huet},
-        JOURNAL            = {J. Functional Programming},
-        PAGES              = {371--394},
-        PUBLISHER          = {Cambridge University Press},
-        TITLE              = {Residual theory in $\lambda$-calculus: a formal development},
-        VOLUME             = {4,3},
-        YEAR               = {1994}
-}
-
-@INCOLLECTION{HuetLevy79,
-        AUTHOR             = {G. Huet and J.-J. L\'{e}vy},
-        TITLE              = {Call by Need Computations in Non-Ambigous
-Linear Term Rewriting Systems},
-        NOTE               = {Also research report 359, INRIA, 1979},
-        BOOKTITLE          = {Computational Logic, Essays in Honor of
-Alan Robinson},
-        EDITOR             = {J.-L. Lassez and G. Plotkin},
-        PUBLISHER          = {The MIT press},
-        YEAR               = {1991}
-}
-
-@ARTICLE{KeWe84,
-        AUTHOR             = {J. Ketonen and R. Weyhrauch},
-        JOURNAL            = {Theoretical Computer Science},
-        PAGES              = {297--307},
-        TITLE              = {A decidable fragment of {P}redicate {C}alculus},
-        VOLUME             = {32},
-        YEAR               = {1984}
-}
-
-@BOOK{Kle52,
-        AUTHOR             = {S.C. Kleene},
-        PUBLISHER          = {North-Holland},
-        SERIES             = {Bibliotheca Mathematica},
-        TITLE              = {Introduction to Metamathematics},
-        YEAR               = {1952}
-}
-
-@BOOK{Kri90,
-        AUTHOR             = {J.-L. Krivine},
-        PUBLISHER          = {Masson},
-        SERIES             = {Etudes et recherche en informatique},
-        TITLE              = {Lambda-calcul {types et mod\`eles}},
-        YEAR               = {1990}
-}
-
-@BOOK{LE92,
-        EDITOR             = {G. Huet and G. Plotkin},
-        PUBLISHER          = {Cambridge University Press},
-        TITLE              = {Logical Environments},
-        YEAR               = {1992}
-}
-
-@BOOK{LF91,
-        EDITOR             = {G. Huet and G. Plotkin},
-        PUBLISHER          = {Cambridge University Press},
-        TITLE              = {Logical Frameworks},
-        YEAR               = {1991}
-}
-
-@ARTICLE{Laville91,
-        AUTHOR             = {A. Laville},
-        TITLE              = {Comparison of Priority Rules in Pattern
-Matching and Term Rewriting},
-        JOURNAL            = {Journal of Symbolic Computation},
-        VOLUME             = {11},
-        PAGES              = {321--347},
-        YEAR               = {1991}
-}
-
-@INPROCEEDINGS{LePa94,
-        AUTHOR             = {F. Leclerc and C. Paulin-Mohring},
-        BOOKTITLE          = {{Types for Proofs and Programs, Types' 93}},
-        EDITOR             = {H. Barendregt and T. Nipkow},
-        PUBLISHER          = SV,
-        SERIES             = {LNCS},
-        TITLE              = {{Programming with Streams in Coq. A case study : The Sieve of Eratosthenes}},
-        VOLUME             = {806},
-        YEAR               = {1994}
-}
-
-@TECHREPORT{Leroy90,
-        AUTHOR             = {X. Leroy},
-        TITLE              = {The {ZINC} experiment: an economical implementation
-of the {ML} language},
-        INSTITUTION        = {INRIA},
-        NUMBER             = {117},
-        YEAR               = {1990}
-}
-
-@INPROCEEDINGS{Let02,
-        author          = {P. Letouzey},
-        title           = {A New Extraction for Coq},
-        booktitle       = {Proceedings of the TYPES'2002 workshop},
-        year            = 2002,
-        note            = {to appear},
-        url            = {draft at \url{http://www.lri.fr/~letouzey/download/extraction2002.ps.gz}}
-}
-
-@BOOK{MaL84,
-        AUTHOR             = {{P. Martin-L\"of}},
-        PUBLISHER          = {Bibliopolis},
-        SERIES             = {Studies in Proof Theory},
-        TITLE              = {Intuitionistic Type Theory},
-        YEAR               = {1984}
-}
-
-@ARTICLE{MaSi94,
-        AUTHOR             = {P. Manoury and M. Simonot},
-        JOURNAL            = {TCS},
-        TITLE              = {Automatizing termination proof of recursively defined function},
-        YEAR               = {To appear}
-}
-
-@INPROCEEDINGS{Moh89a,
-        AUTHOR             = {Christine Paulin-Mohring},
-        ADDRESS            = {Austin},
-        BOOKTITLE          = {Sixteenth Annual ACM Symposium on Principles of Programming Languages},
-        MONTH              = jan,
-        PUBLISHER          = {ACM},
-        TITLE              = {Extracting ${F}_{\omega}$'s programs from proofs in the {Calculus of Constructions}},
-        YEAR               = {1989}
-}
-
-@PHDTHESIS{Moh89b,
-        AUTHOR             = {Christine Paulin-Mohring},
-        MONTH              = jan,
-        SCHOOL             = {{Universit\'e Paris 7}},
-        TITLE              = {Extraction de programmes dans le {Calcul des Constructions}},
-        YEAR               = {1989}
-}
-
-@INPROCEEDINGS{Moh93,
-        AUTHOR             = {Christine Paulin-Mohring},
-        BOOKTITLE          = {Proceedings of the conference Typed Lambda Calculi and Applications},
-        EDITOR             = {M. Bezem and J.-F. Groote},
-        NOTE               = {Also LIP research report 92-49, ENS Lyon},
-        NUMBER             = {664},
-        PUBLISHER          = SV,
-        SERIES             = {LNCS},
-        TITLE              = {{Inductive Definitions in the System Coq - Rules and Properties}},
-        YEAR               = {1993}
-}
-
-@BOOK{Moh97,
-        AUTHOR             = {Christine Paulin-Mohring},
-        MONTH              = jan,
-        PUBLISHER          = {{ENS Lyon}},
-        TITLE              = {{Le syst\`eme Coq. \mbox{Th\`ese d'habilitation}}},
-        YEAR               = {1997}
-}
-
-@MASTERSTHESIS{Mun94,
-        AUTHOR             = {C. Mu{\~n}oz},
-        MONTH              = sep,
-        SCHOOL             = {DEA d'Informatique Fondamentale, Universit\'e Paris 7},
-        TITLE              = {D\'emonstration automatique dans la logique propositionnelle intuitionniste},
-        YEAR               = {1994}
-}
-
-@PHDTHESIS{Mun97d,
-        AUTHOR = "C. Mu{\~{n}}oz",
-        TITLE = "Un calcul de substitutions pour la repr\'esentation
-                  de preuves partielles en th\'eorie de types",
-        SCHOOL = {Universit\'e Paris 7},
-        YEAR = "1997",
-        Note = {Version en anglais disponible comme rapport de 
-                recherche INRIA RR-3309},        
-        Type = {Th\`ese de Doctorat}
-}
-
-@BOOK{NoPS90,
-        AUTHOR             = {B. {Nordstr\"om} and K. Peterson and J. Smith},
-        BOOKTITLE          = {Information Processing 83},
-        PUBLISHER          = {Oxford Science Publications},
-        SERIES             = {International Series of Monographs on Computer Science},
-        TITLE              = {Programming in {Martin-L\"of's} Type Theory},
-        YEAR               = {1990}
-}
-
-@ARTICLE{Nor88,
-        AUTHOR             = {B. {Nordstr\"om}},
-        JOURNAL            = {BIT},
-        TITLE              = {Terminating General Recursion},
-        VOLUME             = {28},
-        YEAR               = {1988}
-}
-
-@BOOK{Odi90,
-        EDITOR             = {P. Odifreddi},
-        PUBLISHER          = {Academic Press},
-        TITLE              = {Logic and Computer Science},
-        YEAR               = {1990}
-}
-
-@INPROCEEDINGS{PaMS92,
-        AUTHOR             = {M. Parigot and P. Manoury and M. Simonot},
-        ADDRESS            = {St. Petersburg, Russia},
-        BOOKTITLE          = {Logic Programming and automated reasoning},
-        EDITOR             = {A. Voronkov},
-        MONTH              = jul,
-        NUMBER             = {624},
-        PUBLISHER          = SV,
-        SERIES             = {LNCS},
-        TITLE              = {{ProPre : A Programming language with proofs}},
-        YEAR               = {1992}
-}
-
-@ARTICLE{PaWe92,
-        AUTHOR             = {Christine Paulin-Mohring and Benjamin Werner},
-        JOURNAL            = {Journal of Symbolic Computation},
-        PAGES              = {607--640},
-        TITLE              = {{Synthesis of ML programs in the system Coq}},
-        VOLUME             = {15},
-        YEAR               = {1993}
-}
-
-@ARTICLE{Par92,
-        AUTHOR             = {M. Parigot},
-        JOURNAL            = {Theoretical Computer Science},
-        NUMBER             = {2},
-        PAGES              = {335--356},
-        TITLE              = {{Recursive Programming with Proofs}},
-        VOLUME             = {94},
-        YEAR               = {1992}
-}
-
-@INPROCEEDINGS{Parent95b,
-        AUTHOR             = {C. Parent},
-        BOOKTITLE          = {{Mathematics of Program Construction'95}},
-        PUBLISHER          = SV,
-        SERIES             = {LNCS},
-        TITLE              = {{Synthesizing proofs from programs in
-the Calculus of Inductive Constructions}},
-        VOLUME             = {947},
-        YEAR               = {1995}
-}
-
-@INPROCEEDINGS{Prasad93,
-        AUTHOR             = {K.V. Prasad},
-        BOOKTITLE          = {{Proceedings of CONCUR'93}},
-        PUBLISHER          = SV,
-        SERIES             = {LNCS},
-        TITLE              = {{Programming with broadcasts}},
-        VOLUME             = {715},
-        YEAR               = {1993}
-}
-
-@BOOK{RC95,
-  author = "di~Cosmo, R.",
-  title  = "Isomorphisms of Types: from $\lambda$-calculus to information
-            retrieval and language design",
-  series = "Progress in Theoretical Computer Science",
-  publisher = "Birkhauser",
-  year = "1995",
-  note = "ISBN-0-8176-3763-X"
-}
-
-@TECHREPORT{Rou92,
-        AUTHOR             = {J. Rouyer},
-        INSTITUTION        = {INRIA},
-        MONTH              = nov,
-        NUMBER             = {1795},
-        TITLE              = {{D{\'e}veloppement de l'Algorithme d'Unification dans le Calcul des Constructions}},
-        YEAR               = {1992}
-}
-
-@TECHREPORT{Saibi94,
-        AUTHOR             = {A. Sa\"{\i}bi},
-        INSTITUTION        = {INRIA},
-        MONTH              = dec,
-        NUMBER             = {2345},
-        TITLE              = {{Axiomatization of a lambda-calculus with explicit-substitutions in the Coq System}},
-        YEAR               = {1994}
-}
-
-
-@MASTERSTHESIS{Ter92,
-        AUTHOR             = {D. Terrasse},
-        MONTH              = sep,
-        SCHOOL             = {IARFA},
-        TITLE              = {{Traduction de TYPOL en COQ. Application \`a Mini ML}},
-        YEAR               = {1992}
-}
-
-@TECHREPORT{ThBeKa92,
-        AUTHOR             = {L. Th\'ery and Y. Bertot and G. Kahn},
-        INSTITUTION        = {INRIA Sophia},
-        MONTH              = may,
-        NUMBER             = {1684},
-        TITLE              = {Real theorem provers deserve real user-interfaces},
-        TYPE               = {Research Report},
-        YEAR               = {1992}
-}
-
-@BOOK{TrDa89,
-        AUTHOR             = {A.S. Troelstra and D. van Dalen},
-        PUBLISHER          = {North-Holland},
-        SERIES             = {Studies in Logic and the foundations of Mathematics, volumes 121 and 123},
-        TITLE              = {Constructivism in Mathematics, an introduction},
-        YEAR               = {1988}
-}
-
-@PHDTHESIS{Wer94,
-        AUTHOR             = {B. Werner},
-        SCHOOL             = {Universit\'e Paris 7},
-        TITLE              = {Une th\'eorie des constructions inductives},
-        TYPE               = {Th\`ese de Doctorat},
-        YEAR               = {1994}
-}
-
-@PHDTHESIS{Bar99,
-        AUTHOR             = {B. Barras},
-        SCHOOL             = {Universit\'e Paris 7},
-        TITLE              = {Auto-validation d'un système de preuves avec familles inductives},
-        TYPE               = {Th\`ese de Doctorat},
-        YEAR               = {1999}
-}
-
-@UNPUBLISHED{ddr98,
-	AUTHOR	           = {D. de Rauglaudre},
-        TITLE              = {Camlp4 version 1.07.2},
-        YEAR               = {1998},
-        NOTE               = {In Camlp4 distribution}
-}
-
-@ARTICLE{dowek93,
-        AUTHOR             = {G. Dowek},
-        TITLE              = {{A Complete Proof Synthesis Method for the Cube of Type Systems}},
-        JOURNAL            = {Journal Logic Computation},
-        VOLUME             = {3},
-        NUMBER             = {3},
-        PAGES              = {287--315},
-        MONTH              = {June},
-        YEAR               = {1993}
-}
-
-@INPROCEEDINGS{manoury94,
-        AUTHOR             = {P. Manoury},
-        TITLE              = {{A User's Friendly Syntax to Define
-Recursive Functions as Typed $\lambda-$Terms}},
-        BOOKTITLE          = {{Types for Proofs and Programs, TYPES'94}},
-        SERIES             = {LNCS},
-        VOLUME             = {996},
-        MONTH              = jun,
-        YEAR               = {1994}
-}
-
-@TECHREPORT{maranget94,
-        AUTHOR             = {L. Maranget},
-        INSTITUTION        = {INRIA},
-        NUMBER             = {2385},
-        TITLE              = {{Two Techniques for Compiling Lazy Pattern Matching}},
-        YEAR               = {1994}
-}
-
-@INPROCEEDINGS{puel-suarez90,
-        AUTHOR             = {L.Puel and A. Su\'arez},
-        BOOKTITLE          = {{Conference Lisp and Functional Programming}},
-        SERIES             = {ACM},
-        PUBLISHER          = SV,
-        TITLE              = {{Compiling Pattern Matching by Term
-Decomposition}},
-        YEAR               = {1990}
-}
-
-@MASTERSTHESIS{saidi94,
-        AUTHOR             = {H. Saidi},
-        MONTH              = sep,
-        SCHOOL             = {DEA d'Informatique Fondamentale, Universit\'e Paris 7},
-        TITLE              = {R\'esolution d'\'equations dans le syst\`eme T
- de G\"odel},
-        YEAR               = {1994}
-}
-
-@misc{streicher93semantical,
-  author = "T. Streicher",
-  title = "Semantical Investigations into Intensional Type Theory",
-  note = "Habilitationsschrift, LMU Munchen.",
-  year = "1993" }
-
-
-
-@Misc{Pcoq,
-  author =	 {Lemme Team},
-  title =	 {Pcoq a graphical user-interface for {Coq}},
-  note =	 {\url{http://www-sop.inria.fr/lemme/pcoq/}}
-}
-
-
-@Misc{ProofGeneral,
-  author =	 {David Aspinall},
-  title =	 {Proof General},
-  note =	 {\url{https://proofgeneral.github.io/}}
-}
-
-
-
-@Book{CoqArt,
-  author =	 {Yves bertot and Pierre Castéran},
-  title = 	 {Coq'Art},
-  publisher = 	 {Springer-Verlag},
-  year = 	 2004,
-  note =	 {To appear}
-}
-
-@INCOLLECTION{wadler87,
-        AUTHOR             = {P. Wadler},
-        TITLE              = {Efficient  Compilation of Pattern Matching},
-        BOOKTITLE          = {The Implementation of Functional Programming
-Languages},
-        EDITOR             = {S.L. Peyton Jones},
-        PUBLISHER          = {Prentice-Hall},
-        YEAR               = {1987}
-}
-
-
-@COMMENT{cross-references, must be at end}
-
-@BOOK{Bastad92,
-        EDITOR             = {B. Nordstr\"om and K. Petersson and G. Plotkin},
-        PUBLISHER          = {Available by ftp at site ftp.inria.fr},
-        TITLE              = {Proceedings of the 1992 Workshop on Types for Proofs and Programs},
-        YEAR               = {1992}
-}
-
-@BOOK{Nijmegen93,
-        EDITOR             = {H. Barendregt and T. Nipkow},
-        PUBLISHER          = SV,
-        SERIES             = LNCS,
-        TITLE              = {Types for Proofs and Programs},
-        VOLUME             = {806},
-        YEAR               = {1994}
-}
-
-@PHDTHESIS{Luo90,
-        AUTHOR             = {Z. Luo},
-        TITLE              = {An Extended Calculus of Constructions},
-        SCHOOL             = {University of Edinburgh},
-        YEAR               = {1990}
-}
diff --git a/doc/faq/hevea.sty b/doc/faq/hevea.sty
deleted file mode 100644
index 6d49aa8ce..000000000
--- a/doc/faq/hevea.sty
+++ /dev/null
@@ -1,78 +0,0 @@
-% hevea  : hevea.sty
-% This is a very basic style file for latex document to be processed
-% with hevea. It contains definitions of LaTeX environment which are
-% processed in a special way by the translator. 
-%  Mostly :
-%     - latexonly, not processed by hevea, processed by latex.
-%     - htmlonly , the reverse.
-%     - rawhtml,  to include raw HTML in hevea output.
-%     - toimage, to send text to the image file.
-% The package also provides hevea logos, html related commands (ahref
-% etc.), void cutting and image commands.
-\NeedsTeXFormat{LaTeX2e}
-\ProvidesPackage{hevea}[2002/01/11]
-\RequirePackage{comment}
-\newif\ifhevea\heveafalse
-\@ifundefined{ifimagen}{\newif\ifimagen\imagenfalse}
-\makeatletter%
-\newcommand{\heveasmup}[2]{%
-\raise #1\hbox{$\m@th$%
-  \csname S@\f@size\endcsname
-  \fontsize\sf@size 0%
-  \math@fontsfalse\selectfont
-#2%
-}}%
-\DeclareRobustCommand{\hevea}{H\kern-.15em\heveasmup{.2ex}{E}\kern-.15emV\kern-.15em\heveasmup{.2ex}{E}\kern-.15emA}%
-\DeclareRobustCommand{\hacha}{H\kern-.15em\heveasmup{.2ex}{A}\kern-.15emC\kern-.1em\heveasmup{.2ex}{H}\kern-.15emA}%
-\DeclareRobustCommand{\html}{\protect\heveasmup{0.ex}{HTML}}
-%%%%%%%%% Hyperlinks hevea style
-\newcommand{\ahref}[2]{{#2}}
-\newcommand{\ahrefloc}[2]{{#2}}
-\newcommand{\aname}[2]{{#2}}
-\newcommand{\ahrefurl}[1]{\texttt{#1}}
-\newcommand{\footahref}[2]{#2\footnote{\texttt{#1}}}
-\newcommand{\mailto}[1]{\texttt{#1}}
-\newcommand{\imgsrc}[2][]{}
-\newcommand{\home}[1]{\protect\raisebox{-.75ex}{\char126}#1}
-\AtBeginDocument
-{\@ifundefined{url}
-{%url package is not loaded
-\let\url\ahref\let\oneurl\ahrefurl\let\footurl\footahref}
-{}}
-%% Void cutting instructions
-\newcounter{cuttingdepth}
-\newcommand{\tocnumber}{}
-\newcommand{\notocnumber}{}
-\newcommand{\cuttingunit}{}
-\newcommand{\cutdef}[2][]{}
-\newcommand{\cuthere}[2]{}
-\newcommand{\cutend}{}
-\newcommand{\htmlhead}[1]{}
-\newcommand{\htmlfoot}[1]{}
-\newcommand{\htmlprefix}[1]{}
-\newenvironment{cutflow}[1]{}{}
-\newcommand{\cutname}[1]{}
-\newcommand{\toplinks}[3]{}
-%%%% Html only
-\excludecomment{rawhtml}
-\newcommand{\rawhtmlinput}[1]{}
-\excludecomment{htmlonly}
-%%%% Latex only
-\newenvironment{latexonly}{}{}
-\newenvironment{verblatex}{}{}
-%%%% Image file stuff
-\def\toimage{\endgroup}
-\def\endtoimage{\begingroup\def\@currenvir{toimage}}
-\def\verbimage{\endgroup}
-\def\endverbimage{\begingroup\def\@currenvir{verbimage}}
-\newcommand{\imageflush}[1][]{}
-%%% Bgcolor definition
-\newsavebox{\@bgcolorbin}
-\newenvironment{bgcolor}[2][]
-  {\newcommand{\@mycolor}{#2}\begin{lrbox}{\@bgcolorbin}\vbox\bgroup}
-  {\egroup\end{lrbox}%
-   \begin{flushleft}%
-   \colorbox{\@mycolor}{\usebox{\@bgcolorbin}}%
-   \end{flushleft}}
-%%% Postlude
-\makeatother
diff --git a/doc/faq/interval_discr.v b/doc/faq/interval_discr.v
deleted file mode 100644
index 671dc988a..000000000
--- a/doc/faq/interval_discr.v
+++ /dev/null
@@ -1,419 +0,0 @@
-(** Sketch of the proof of {p:nat|p<=n} = {p:nat|p<=m} -> n=m
-
-  - preliminary results on the irrelevance of boundedness proofs
-  - introduce the notion of finite cardinal |A|
-  - prove that |{p:nat|p<=n}| = n
-  - prove that |A| = n /\ |A| = m -> n = m if equality is decidable on A
-  - prove that equality is decidable on A
-  - conclude
-*)
-
-(** * Preliminary results on [nat] and [le] *)
-
-(** Proving axiom K on [nat] *)
-
-Require Import Eqdep_dec.
-Require Import Arith.
-
-Theorem eq_rect_eq_nat :
-  forall (p:nat) (Q:nat->Type) (x:Q p) (h:p=p), x = eq_rect p Q x p h.
-Proof.
-intros.
-apply K_dec_set with (p := h).
-apply eq_nat_dec.
-reflexivity.
-Qed.
-
-(** Proving unicity of proofs of [(n<=m)%nat] *)
-
-Scheme le_ind' := Induction for le Sort Prop.
-
-Theorem le_uniqueness_proof : forall (n m : nat) (p q : n <= m), p = q.
-Proof.
-induction p using le_ind'; intro q.
- replace (le_n n) with
-  (eq_rect _ (fun n0 => n <= n0) (le_n n) _ eq_refl).
- 2:reflexivity.
-  generalize (eq_refl n).
-    pattern n at 2 4 6 10, q; case q; [intro | intros m l e].
-     rewrite <- eq_rect_eq_nat; trivial.
-     contradiction (le_Sn_n m); rewrite <- e; assumption.
- replace (le_S n m p) with
-  (eq_rect _ (fun n0 => n <= n0) (le_S n m p) _ eq_refl).
- 2:reflexivity.
-  generalize (eq_refl (S m)).
-    pattern (S m) at 1 3 4 6, q; case q; [intro Heq | intros m0 l HeqS].
-     contradiction (le_Sn_n m); rewrite Heq; assumption.
-     injection HeqS; intro Heq; generalize l HeqS.
-      rewrite <- Heq; intros; rewrite <- eq_rect_eq_nat.
-      rewrite (IHp l0); reflexivity.
-Qed.
-
-(** Proving irrelevance of boundedness proofs while building
-    elements of interval *)
-
-Lemma dep_pair_intro :
-  forall (n x y:nat) (Hx : x<=n) (Hy : y<=n), x=y ->
-    exist (fun x => x <= n) x Hx = exist (fun x => x <= n) y Hy.
-Proof.
-intros n x y Hx Hy Heq.
-generalize Hy.
-rewrite <- Heq.
-intros.
-rewrite (le_uniqueness_proof x n Hx Hy0).
-reflexivity.
-Qed.
-
-(** * Proving that {p:nat|p<=n} = {p:nat|p<=m} -> n=m *)
-
-(** Definition of having finite cardinality [n+1] for a set [A] *)
-
-Definition card (A:Set) n :=
-  exists f,
-    (forall x:A, f x <= n) /\
-    (forall x y:A, f x = f y -> x = y) /\
-    (forall m, m <= n -> exists x:A, f x = m).
-
-Require Import Arith.
-
-(** Showing that the interval [0;n] has cardinality [n+1] *)
-
-Theorem card_interval : forall n, card {x:nat|x<=n} n.
-Proof.
-intro n.
-exists (fun x:{x:nat|x<=n} => proj1_sig x).
-split.
-(* bounded *)
-intro x; apply (proj2_sig x).
-split.
-(* injectivity *)
-intros (p,Hp) (q,Hq).
-simpl.
-intro Hpq.
-apply dep_pair_intro; assumption.
-(* surjectivity *)
-intros m Hmn.
-exists (exist (fun x : nat => x <= n) m Hmn).
-reflexivity.
-Qed.
-
-(** Showing that equality on the interval [0;n] is decidable *)
-
-Lemma interval_dec :
-  forall n (x y : {m:nat|m<=n}), {x=y}+{x<>y}.
-Proof.
-intros n (p,Hp).
-induction p; intros ([|q],Hq).
-left.
-  apply dep_pair_intro.
-  reflexivity.
-right.
-  intro H; discriminate H.
-right.
-  intro H; discriminate H.
-assert (Hp' : p <= n).
-  apply le_Sn_le; assumption.
-assert (Hq' : q <= n).
-  apply le_Sn_le; assumption.
-destruct (IHp Hp' (exist (fun m => m <= n) q Hq'))
-  as [Heq|Hneq].
-left.
-  injection Heq; intro Heq'.
-  apply dep_pair_intro.
-  apply eq_S.
-  assumption.
-right.
-  intro HeqS.
-  injection HeqS; intro Heq.
-  apply Hneq.
-  apply dep_pair_intro.
-  assumption.
-Qed.
-
-(** Showing that the cardinality relation is functional on decidable sets *)
-
-Lemma card_inj_aux :
-  forall (A:Type) f g n,
-    (forall x:A, f x <= 0) ->
-    (forall x y:A, f x = f y -> x = y) ->
-    (forall m, m <= S n -> exists x:A, g x = m)
-     -> False.
-Proof.
-intros A f g n Hfbound Hfinj Hgsurj.
-destruct (Hgsurj (S n) (le_n _)) as (x,Hx).
-destruct (Hgsurj n (le_S _ _ (le_n _))) as (x',Hx').
-assert (Hfx : 0 = f x).
-apply le_n_O_eq.
-apply Hfbound.
-assert (Hfx' : 0 = f x').
-apply le_n_O_eq.
-apply Hfbound.
-assert (x=x').
-apply Hfinj.
-rewrite <- Hfx.
-rewrite <- Hfx'.
-reflexivity.
-rewrite H in Hx.
-rewrite Hx' in Hx.
-apply (n_Sn _ Hx).
-Qed.
-
-(** For [dec_restrict], we use a lemma on the negation of equality
-that requires proof-irrelevance. It should be possible to avoid this
-lemma by generalizing over a first-order definition of [x<>y], say
-[neq] such that [{x=y}+{neq x y}] and [~(x=y /\ neq x y)]; for such
-[neq], unicity of proofs could be proven *)
-
-  Require Import Classical.
-  Lemma neq_dep_intro :
-   forall (A:Set) (z x y:A) (p:x<>z) (q:y<>z), x=y ->
-      exist (fun x => x <> z) x p = exist (fun x => x <> z) y q.
-  Proof.
-  intros A z x y p q Heq.
-   generalize q; clear q; rewrite <- Heq; intro q.
-   rewrite (proof_irrelevance _ p q); reflexivity.
-  Qed.
-
-Lemma dec_restrict :
-  forall (A:Set),
-    (forall x y :A, {x=y}+{x<>y}) ->
-     forall z (x y :{a:A|a<>z}), {x=y}+{x<>y}.
-Proof.
-intros A Hdec z (x,Hx) (y,Hy).
-destruct (Hdec x y) as [Heq|Hneq].
-left; apply neq_dep_intro; assumption.
-right; intro Heq; injection Heq; exact Hneq.
-Qed.
-
-Lemma pred_inj : forall n m,
-  0 <> n -> 0 <> m -> pred m = pred n -> m = n.
-Proof.
-destruct n.
-intros m H; destruct H; reflexivity.
-destruct m.
-intros _ H; destruct H; reflexivity.
-simpl; intros _ _ H.
-rewrite H.
-reflexivity.
-Qed.
-
-Lemma le_neq_lt : forall n m, n <= m -> n<>m -> n < m.
-Proof.
-intros n m Hle Hneq.
-destruct (le_lt_eq_dec n m Hle).
-assumption.
-contradiction.
-Qed.
-
-Lemma inj_restrict :
-  forall (A:Set) (f:A->nat) x y z,
-    (forall x y : A, f x = f y -> x = y)
-    -> x <> z -> f y < f z -> f z <= f x
-    -> pred (f x) = f y
-    -> False.
-
-(* Search error sans le type de f !! *)
-Proof.
-intros A f x y z Hfinj Hneqx Hfy Hfx Heq.
-assert (f z <> f x).
-  apply not_eq_sym.
-  intro Heqf.
-  apply Hneqx.
-  apply Hfinj.
-  assumption.
-assert (f x = S (f y)).
-  assert (0 < f x).
-    apply le_lt_trans with (f z).
-    apply le_O_n.
-    apply le_neq_lt; assumption.
-  apply pred_inj.
-  apply O_S.
-  apply lt_O_neq; assumption.
-  exact Heq.
-assert (f z <= f y).
-destruct (le_lt_or_eq _ _ Hfx).
-  apply lt_n_Sm_le.
-  rewrite <- H0.
-  assumption.
-  contradiction Hneqx.
-  symmetry.
-  apply Hfinj.
-  assumption.
-contradiction (lt_not_le (f y) (f z)).
-Qed.
-
-Theorem card_inj : forall m n (A:Set),
-  (forall x y :A, {x=y}+{x<>y}) ->
-  card A m -> card A n -> m = n.
-Proof.
-induction m; destruct n;
-intros A Hdec
- (f,(Hfbound,(Hfinj,Hfsurj)))
- (g,(Hgbound,(Hginj,Hgsurj))).
-(* 0/0 *)
-reflexivity.
-(* 0/Sm *)
-destruct (card_inj_aux _ _ _ _ Hfbound Hfinj Hgsurj).
-(* Sn/0 *)
-destruct (card_inj_aux _ _ _ _ Hgbound Hginj Hfsurj).
-(* Sn/Sm *)
-destruct (Hgsurj (S n) (le_n _)) as (xSn,HSnx).
-rewrite IHm with (n:=n) (A := {x:A|x<>xSn}).
-reflexivity.
-(* decidability of eq on {x:A|x<>xSm} *)
-apply dec_restrict.
-assumption.
-(* cardinality of {x:A|x<>xSn} is m *)
-pose (f' := fun x' : {x:A|x<>xSn} =>
-    let (x,Hneq) := x' in
-    if le_lt_dec (f xSn) (f x)
-    then pred (f x)
-    else f x).
-exists f'.
-split.
-(* f' is bounded *)
-unfold f'.
-intros (x,_).
-destruct (le_lt_dec (f xSn) (f x)) as [Hle|Hge].
-change m with (pred (S m)).
-apply le_pred.
-apply Hfbound.
-apply le_S_n.
-apply le_trans with (f xSn).
-exact Hge.
-apply Hfbound.
-split.
-(* f' is injective *)
-unfold f'.
-intros (x,Hneqx) (y,Hneqy) Heqf'.
-destruct (le_lt_dec (f xSn) (f x)) as [Hlefx|Hgefx];
-destruct (le_lt_dec (f xSn) (f y)) as [Hlefy|Hgefy].
-(* f xSn <= f x et f xSn <= f y *)
-assert (Heq : x = y).
-  apply Hfinj.
-  assert (f xSn <> f y).
-    apply not_eq_sym.
-    intro Heqf.
-    apply Hneqy.
-    apply Hfinj.
-    assumption.
-  assert (0 < f y).
-    apply le_lt_trans with (f xSn).
-    apply le_O_n.
-    apply le_neq_lt; assumption.
-  assert (f xSn <> f x).
-    apply not_eq_sym.
-    intro Heqf.
-    apply Hneqx.
-    apply Hfinj.
-    assumption.
-  assert (0 < f x).
-    apply le_lt_trans with (f xSn).
-    apply le_O_n.
-    apply le_neq_lt; assumption.
-  apply pred_inj.
-  apply lt_O_neq; assumption.
-  apply lt_O_neq; assumption.
-  assumption.
-apply neq_dep_intro; assumption.
-(* f y < f xSn <= f x *)
-destruct (inj_restrict A f x y xSn); assumption.
-(* f x < f xSn <= f y *)
-symmetry in Heqf'.
-destruct (inj_restrict A f y x xSn); assumption.
-(* f x < f xSn et f y < f xSn *)
-assert (Heq : x=y).
-  apply Hfinj; assumption.
-apply neq_dep_intro; assumption.
-(* f' is surjective *)
-intros p Hlep.
-destruct (le_lt_dec (f xSn) p) as [Hle|Hlt].
-(* case f xSn <= p *)
-destruct (Hfsurj (S p) (le_n_S _ _ Hlep)) as (x,Hx).
-assert (Hneq : x <> xSn).
-  intro Heqx.
-  rewrite Heqx in Hx.
-  rewrite Hx in Hle.
-  apply le_Sn_n with p; assumption.
-exists (exist (fun a => a<>xSn) x Hneq).
-unfold f'.
-destruct (le_lt_dec (f xSn) (f x)) as [Hle'|Hlt'].
-rewrite Hx; reflexivity.
-rewrite Hx in Hlt'.
-contradiction (le_not_lt (f xSn) p).
-apply lt_trans with (S p).
-apply lt_n_Sn.
-assumption.
-(* case p < f xSn *)
-destruct (Hfsurj p (le_S _ _ Hlep)) as (x,Hx).
-assert (Hneq : x <> xSn).
-  intro Heqx.
-  rewrite Heqx in Hx.
-  rewrite Hx in Hlt.
-  apply (lt_irrefl p).
-  assumption.
-exists (exist (fun a => a<>xSn) x Hneq).
-unfold f'.
-destruct (le_lt_dec (f xSn) (f x)) as [Hle'|Hlt'].
-  rewrite Hx in Hle'.
-  contradiction (lt_irrefl p).
-  apply lt_le_trans with (f xSn); assumption.
-  assumption.
-(* cardinality of {x:A|x<>xSn} is n *)
-pose (g' := fun x' : {x:A|x<>xSn} =>
-   let (x,Hneq) := x' in
-   if Hdec x xSn then 0 else g x).
-exists g'.
-split.
-(* g is bounded *)
-unfold g'.
-intros (x,_).
-destruct (Hdec x xSn) as [_|Hneq].
-apply le_O_n.
-assert (Hle_gx:=Hgbound x).
-destruct (le_lt_or_eq _ _ Hle_gx).
-apply lt_n_Sm_le.
-assumption.
-contradiction Hneq.
-apply Hginj.
-rewrite HSnx.
-assumption.
-split.
-(* g is injective *)
-unfold g'.
-intros (x,Hneqx) (y,Hneqy) Heqg'.
-destruct (Hdec x xSn) as [Heqx|_].
-contradiction Hneqx.
-destruct (Hdec y xSn) as [Heqy|_].
-contradiction Hneqy.
-assert (Heq : x=y).
-  apply Hginj; assumption.
-apply neq_dep_intro; assumption.
-(* g is surjective *)
-intros p Hlep.
-destruct (Hgsurj p (le_S _ _ Hlep)) as (x,Hx).
-assert (Hneq : x<>xSn).
-  intro Heq.
-  rewrite Heq in Hx.
-  rewrite Hx in HSnx.
-  rewrite HSnx in Hlep.
-  contradiction (le_Sn_n _ Hlep).
-exists (exist (fun a => a<>xSn) x Hneq).
-simpl.
-destruct (Hdec x xSn) as [Heqx|_].
-contradiction Hneq.
-assumption.
-Qed.
-
-(** Conclusion *)
-
-Theorem interval_discr :
-  forall n m, {p:nat|p<=n} = {p:nat|p<=m} -> n=m.
-Proof.
-intros n m Heq.
-apply card_inj with (A := {p:nat|p<=n}).
-apply interval_dec.
-apply card_interval.
-rewrite Heq.
-apply card_interval.
-Qed.
diff --git a/doc/refman/AddRefMan-pre.tex b/doc/refman/AddRefMan-pre.tex
index eee41a679..856a823de 100644
--- a/doc/refman/AddRefMan-pre.tex
+++ b/doc/refman/AddRefMan-pre.tex
@@ -4,6 +4,7 @@
 \setheaders{Presentation of the Addendum}
 %END LATEX
 \chapter*{Presentation of the Addendum}
+%HEVEA\cutname{addendum.html}
 
 Here you will find several pieces of additional documentation for the
 \Coq\ Reference Manual. Each of this chapters is concentrated on a
diff --git a/doc/refman/AsyncProofs.tex b/doc/refman/AsyncProofs.tex
index 1609e4a04..8f9d876cb 100644
--- a/doc/refman/AsyncProofs.tex
+++ b/doc/refman/AsyncProofs.tex
@@ -1,4 +1,5 @@
-\achapter{Asynchronous and Parallel Proof Processing}
+\achapter{Asynchronous and Parallel Proof Processing\label{Asyncprocessing}}
+%HEVEA\cutname{async-proofs.html}
 \aauthor{Enrico Tassi}
 
 \label{pralitp}
diff --git a/doc/refman/CanonicalStructures.tex b/doc/refman/CanonicalStructures.tex
index 275e1c2d5..8961b0096 100644
--- a/doc/refman/CanonicalStructures.tex
+++ b/doc/refman/CanonicalStructures.tex
@@ -1,4 +1,5 @@
 \achapter{Canonical Structures}
+%HEVEA\cutname{canonical-structures.html}
 \aauthor{Assia Mahboubi and Enrico Tassi}
 
 \label{CS-full}
diff --git a/doc/refman/Cases.tex b/doc/refman/Cases.tex
index a95d8114f..376ef031d 100644
--- a/doc/refman/Cases.tex
+++ b/doc/refman/Cases.tex
@@ -1,4 +1,5 @@
 \achapter{Extended pattern-matching}
+%HEVEA\cutname{cases.html}
 %BEGIN LATEX
 \defaultheaders
 %END LATEX
@@ -279,6 +280,18 @@ Fail Check
      end).
 \end{coq_example}
 
+The option {\tt Set Asymmetric Patterns} \optindex{Asymmetric Patterns}
+(off by default) removes parameters from constructors in patterns:
+\begin{coq_example}
+  Set Asymmetric Patterns.
+  Check (fun l:List nat =>
+    match l with
+    | nil => nil
+    | cons _ l' => l'
+    end)
+  Unset Asymmetric Patterns.
+\end{coq_example}
+
 \paragraph{Implicit arguments in patterns}
 By default, implicit arguments are omitted in patterns. So we write:
 
diff --git a/doc/refman/Classes.tex b/doc/refman/Classes.tex
index 7e07868a3..6e76d04e7 100644
--- a/doc/refman/Classes.tex
+++ b/doc/refman/Classes.tex
@@ -6,6 +6,7 @@
 \newcommand\tele[1]{\overrightarrow{#1}}
 
 \achapter{\protect{Type Classes}}
+%HEVEA\cutname{type-classes.html}
 \aauthor{Matthieu Sozeau}
 \label{typeclasses}
 
@@ -461,11 +462,18 @@ 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 Axioms Are Instances}
+\optindex{Typeclasses Axioms Are Instances}
+
+This option (off by default since 8.8) automatically declares axioms
+whose type is a typeclass at declaration time as instances of that
+class.
+
 \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 
+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.
@@ -518,14 +526,14 @@ potentially more expensive proof-search (i.e. more useless
 backtracking).
 
 \subsection{\tt Set Typeclass Resolution After Apply}
-\optindex{Typeclasses Resolution After Apply}
+\optindex{Typeclass 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}
+\optindex{Typeclass Resolution For Conversion}
 
 This option (on by default) controls the use of typeclass resolution
 when a unification problem cannot be solved during
diff --git a/doc/refman/Coercion.tex b/doc/refman/Coercion.tex
index 16006a6ad..ec46e1eb5 100644
--- a/doc/refman/Coercion.tex
+++ b/doc/refman/Coercion.tex
@@ -1,4 +1,5 @@
 \achapter{Implicit Coercions}
+%HEVEA\cutname{coercions.html}
 \aauthor{Amokrane Saïbi}
 
 \label{Coercions-full}
diff --git a/doc/refman/Extraction.tex b/doc/refman/Extraction.tex
index 499239b6f..cff7be3e9 100644
--- a/doc/refman/Extraction.tex
+++ b/doc/refman/Extraction.tex
@@ -1,4 +1,5 @@
-\achapter{Extraction of programs in Objective Caml and Haskell}
+\achapter{Extraction of programs in OCaml and Haskell}
+%HEVEA\cutname{extraction.html}
 \label{Extraction}
 \aauthor{Jean-Christophe Filliâtre and Pierre Letouzey}
 \index{Extraction}
@@ -94,12 +95,12 @@ one monolithic file or one file per \Coq\ library.
 \begin{description}
 \item {\tt Extraction TestCompile} \qualid$_1$ \dots\ \qualid$_n$. ~\par
   All the globals (or modules) \qualid$_1$ \dots\ \qualid$_n$ and all
-  their dependencies are extracted to a temporary Ocaml file, just as in
+  their dependencies are extracted to a temporary {\ocaml} file, just as in
   {\tt Extraction "{\em file}"}. Then this temporary file and its
-  signature are compiled with the same Ocaml compiler used to built
-  \Coq. This command succeeds only if the extraction and the Ocaml
+  signature are compiled with the same {\ocaml} compiler used to built
+  \Coq. This command succeeds only if the extraction and the {\ocaml}
   compilation succeed (and it fails if the current target language
-  of the extraction is not Ocaml).
+  of the extraction is not {\ocaml}).
 \end{description}
 
 \asection{Extraction options}
@@ -108,26 +109,26 @@ one monolithic file or one file per \Coq\ library.
 \comindex{Extraction Language}
 
 The ability to fix target language is the first and more important
-of the extraction options. Default is Ocaml.
+of the extraction options. Default is {\ocaml}.
 \begin{description}
-\item {\tt Extraction Language Ocaml}.
+\item {\tt Extraction Language OCaml}.
 \item {\tt Extraction Language Haskell}.
 \item {\tt Extraction Language Scheme}.
 \end{description}
 
 \asubsection{Inlining and optimizations}
 
-Since Objective Caml is a strict language, the extracted code has to
+Since {\ocaml} is a strict language, the extracted code has to
 be optimized in order to be efficient (for instance, when using
 induction principles we do not want to compute all the recursive calls
 but only the needed ones). So the extraction mechanism provides an
 automatic optimization routine that will be called each time the user
-want to generate Ocaml programs. The optimizations can be split in two
+want to generate {\ocaml} programs. The optimizations can be split in two
 groups: the type-preserving ones -- essentially constant inlining and
 reductions -- and the non type-preserving ones -- some function
 abstractions of dummy types are removed when it is deemed safe in order
 to have more elegant types. Therefore some constants may not appear in the
-resulting monolithic Ocaml program. In the case of modular extraction,
+resulting monolithic {\ocaml} program. In the case of modular extraction,
 even if some inlining is done, the inlined constant are nevertheless
 printed, to ensure session-independent programs.
 
@@ -366,15 +367,15 @@ As for {\tt Extract Inductive}, this command should be used with care:
 \item Extracting an inductive type to a pre-existing ML inductive type
 is quite sound. But extracting to a general type (by providing an
 ad-hoc pattern-matching) will often \emph{not} be fully rigorously
-correct.  For instance, when extracting {\tt nat} to Ocaml's {\tt
+correct.  For instance, when extracting {\tt nat} to {\ocaml}'s {\tt
 int}, it is theoretically possible to build {\tt nat} values that are
-larger than Ocaml's {\tt max\_int}. It is the user's responsibility to
+larger than {\ocaml}'s {\tt max\_int}. It is the user's responsibility to
 be sure that no overflow or other bad events occur in practice.
 
 \item Translating an inductive type to an ML type does \emph{not}
 magically improve the asymptotic complexity of functions, even if the
 ML type is an efficient representation. For instance, when extracting
-{\tt nat} to Ocaml's {\tt int}, the function {\tt mult} stays
+{\tt nat} to {\ocaml}'s {\tt int}, the function {\tt mult} stays
 quadratic. It might be interesting to associate this translation with
 some specific {\tt Extract Constant} when primitive counterparts exist.
 \end{itemize}
@@ -390,16 +391,18 @@ Extract Inductive bool => "bool" [ "true" "false" ].
 Extract Inductive sumbool => "bool" [ "true" "false" ].
 \end{coq_example}
 
-\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. 
+\noindent When extracting to {\ocaml}, if an inductive constructor or type
+has arity 2 and the corresponding string is enclosed by parentheses,
+and the string meets {\ocaml}'s lexical criteria for an infix symbol,
+then the rest of the string is used as infix constructor or type.
+
 \begin{coq_example}
 Extract Inductive list => "list" [ "[]" "(::)" ].
 Extract Inductive prod => "(*)"  [ "(,)" ].
 \end{coq_example}
 
 \noindent As an example of translation to a non-inductive datatype, let's turn
-{\tt nat} into Ocaml's {\tt int} (see caveat above):
+{\tt nat} into {\ocaml}'s {\tt int} (see caveat above):
 \begin{coq_example}
 Extract Inductive nat => int [ "0" "succ" ]
  "(fun fO fS n -> if n=0 then fO () else fS (n-1))".
@@ -414,7 +417,7 @@ directly depends from the names of the \Coq\ files. It may happen that
 these filenames are in conflict with already existing files, 
 either in the standard library of the target language or in other
 code that is meant to be linked with the extracted code. 
-For instance the module {\tt List} exists both in \Coq\ and in Ocaml.
+For instance the module {\tt List} exists both in \Coq\ and in {\ocaml}.
 It is possible to instruct the extraction not to use particular filenames.
 
 \begin{description}
@@ -427,7 +430,7 @@ It is possible to instruct the extraction not to use particular filenames.
   Allow the extraction to use any filename.
 \end{description}
 
-\noindent 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}
@@ -435,7 +438,7 @@ It is possible to instruct the extraction not to use particular filenames.
 
 Due to differences between \Coq\ and ML type systems, 
 some extracted programs are not directly typable in ML. 
-We now solve this problem (at least in Ocaml) by adding 
+We now solve this problem (at least in {\ocaml}) by adding
 when needed some unsafe casting {\tt Obj.magic}, which give
 a generic type {\tt 'a} to any term.
 
@@ -452,7 +455,7 @@ Definition dp :=
  fun (A B:Set)(x:A)(y:B)(f:forall C:Set, C->C) => (f A x, f B y).
 \end{verbatim}
 
-In Ocaml, for instance, the direct extracted term would be
+In {\ocaml}, for instance, the direct extracted term would be
 \begin{verbatim}
 let dp x y f = Pair((f () x),(f () y))
 \end{verbatim}
@@ -477,13 +480,13 @@ Inductive anything : Type := dummy : forall A:Set, A -> anything.
 \end{verbatim}
 
 which corresponds to the definition of an ML dynamic type.
-In Ocaml, we must cast any argument of the constructor dummy.
+In {\ocaml}, we must cast any argument of the constructor dummy.
 
 \end{itemize}
 
 \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 
+ill-typed to the {\ocaml} type-checker, it can't go wrong: it comes
 from a Coq well-typed terms, so for example inductives will always 
 have the correct number of arguments, etc. 
 
diff --git a/doc/refman/Micromega.tex b/doc/refman/Micromega.tex
index 4daf98f87..2617142f5 100644
--- a/doc/refman/Micromega.tex
+++ b/doc/refman/Micromega.tex
@@ -1,4 +1,5 @@
 \achapter{Micromega: tactics for solving arithmetic goals over ordered rings}
+%HEVEA\cutname{micromega.html}
 \aauthor{Frédéric Besson and Evgeny Makarov}
 \newtheorem{theorem}{Theorem}
 
diff --git a/doc/refman/Misc.tex b/doc/refman/Misc.tex
index e953d2f70..ab00fbfe3 100644
--- a/doc/refman/Misc.tex
+++ b/doc/refman/Misc.tex
@@ -1,4 +1,5 @@
 \achapter{\protect{Miscellaneous extensions}}
+%HEVEA\cutname{miscellaneous.html}
 
 \asection{Program derivation}
 
diff --git a/doc/refman/Nsatz.tex b/doc/refman/Nsatz.tex
index 70e36a5ee..1401af10f 100644
--- a/doc/refman/Nsatz.tex
+++ b/doc/refman/Nsatz.tex
@@ -1,4 +1,5 @@
 \achapter{Nsatz: tactics for proving equalities in integral domains}
+%HEVEA\cutname{nsatz.html}
 \aauthor{Loïc Pottier}
 
 The tactic \texttt{nsatz} proves goals of the form
diff --git a/doc/refman/Omega.tex b/doc/refman/Omega.tex
index 1610305e7..82765da6e 100644
--- a/doc/refman/Omega.tex
+++ b/doc/refman/Omega.tex
@@ -1,5 +1,6 @@
 \achapter{Omega: a solver of quantifier-free problems in
 Presburger Arithmetic}
+%HEVEA\cutname{omega.html}
 \aauthor{Pierre Crégut}
 \label{OmegaChapter}
 
@@ -148,6 +149,32 @@ intro; omega.
 
 % Other examples can be found in \verb+$COQLIB/theories/DEMOS/OMEGA+.
 
+\section{Options}
+
+\begin{quote}
+  \optindex{Stable Omega}
+  {\tt Unset Stable Omega}
+\end{quote}
+This deprecated option (on by default) is for compatibility with Coq
+pre 8.5. It resets internal name counters to make executions of
+{\tt omega} independent.
+
+\begin{quote}
+  \optindex{Omega UseLocalDefs}
+  {\tt Unset Omega UseLocalDefs}
+\end{quote}
+This option (on by default) allows {\tt omega} to use the bodies of
+local variables.
+
+\begin{quote}
+  \optindex{Omega System}
+  {\tt Set Omega System}
+  \optindex{Omega Action}
+  {\tt Set Omega Action}
+\end{quote}
+These two options (off by default) activate the printing of debug
+information.
+
 \asection{Technical data}
 \label{technical}
 
diff --git a/doc/refman/Polynom.tex b/doc/refman/Polynom.tex
index 77d592834..d9b8b8c52 100644
--- a/doc/refman/Polynom.tex
+++ b/doc/refman/Polynom.tex
@@ -1,4 +1,5 @@
 \achapter{The \texttt{ring} and \texttt{field} tactic families}
+%HEVEA\cutname{ring.html}
 \aauthor{Bruno Barras, Benjamin Gr\'egoire, Assia
   Mahboubi, Laurent Th\'ery\footnote{based on previous work from
   Patrick Loiseleur and Samuel Boutin}}
diff --git a/doc/refman/Program.tex b/doc/refman/Program.tex
index f60908da6..1e204dc83 100644
--- a/doc/refman/Program.tex
+++ b/doc/refman/Program.tex
@@ -1,4 +1,5 @@
 \achapter{\Program{}}
+%HEVEA\cutname{program.html}
 \label{Program}
 \aauthor{Matthieu Sozeau}
 \index{Program}
diff --git a/doc/refman/RefMan-add.tex b/doc/refman/RefMan-add.tex
deleted file mode 100644
index 2094c9d2d..000000000
--- a/doc/refman/RefMan-add.tex
+++ /dev/null
@@ -1,58 +0,0 @@
-\chapter[List of additional documentation]{List of additional documentation\label{Addoc}}
-
-\section[Tutorials]{Tutorials\label{Tutorial}}
-A companion volume to this reference manual, the \Coq\ Tutorial, is
-aimed at gently introducing new users to developing proofs in \Coq\
-without assuming prior knowledge of type theory. In a second step, the
-user can read also the tutorial on recursive types (document {\tt
-RecTutorial.ps}).
-
-\section[The \Coq\ standard library]{The \Coq\ standard library\label{Addoc-library}}
-A brief description of the \Coq\ standard library is given in the additional
-document {\tt Library.dvi}.
-
-\section[Installation and un-installation procedures]{Installation and un-installation procedures\label{Addoc-install}}
-A \verb!INSTALL! file in the distribution explains how to install
-\Coq.
-
-\section[{\tt Extraction} of programs]{{\tt Extraction} of programs\label{Addoc-extract}}
-{\tt Extraction} is a package offering some special facilities to
-extract ML program files. It is described in the separate document
-{\tt Extraction.dvi}
-\index{Extraction of programs}
-
-\section[{\tt Program}]{A tool for {\tt Program}-ing\label{Addoc-program}}
-{\tt Program} is a package offering some special facilities to
-extract ML program files. It is described in the separate document
-{\tt Program.dvi}
-\index{Program-ing}
-
-\section[Proof printing in {\tt Natural} language]{Proof printing in {\tt Natural} language\label{Addoc-natural}}
-{\tt Natural} is a tool to print proofs in natural language.
-It is described in the separate document {\tt Natural.dvi}.
-\index{Natural@{\tt Print Natural}}
-\index{Printing in natural language}
-
-\section[The {\tt Omega} decision tactic]{The {\tt Omega} decision tactic\label{Addoc-omega}}
-{\bf Omega} is a tactic to automatically solve arithmetical goals in
-Presburger arithmetic (i.e. arithmetic without multiplication). 
-It is described in the separate document {\tt Omega.dvi}.
-\index{Omega@{\tt Omega}}
-
-\section[Simplification on rings]{Simplification on rings\label{Addoc-polynom}}
-A documentation of the package {\tt polynom} (simplification on rings)
-can be found in the document {\tt Polynom.dvi}
-\index{Polynom@{\tt Polynom}}
-\index{Simplification on rings}
-
-%\section[Anomalies]{Anomalies\label{Addoc-anomalies}}
-%The separate document {\tt Anomalies.*} gives a list of known
-%anomalies and bugs of the system.  Before communicating us an
-%anomalous behavior, please check first whether it has been already
-%reported in this document.
-
-
-%%% Local Variables: 
-%%% mode: latex
-%%% TeX-master: "Reference-Manual"
-%%% End: 
diff --git a/doc/refman/RefMan-cic.tex b/doc/refman/RefMan-cic.tex
index ad795d406..2695c5eee 100644
--- a/doc/refman/RefMan-cic.tex
+++ b/doc/refman/RefMan-cic.tex
@@ -2,6 +2,7 @@
 \label{Cic}
 \index{Cic@\textsc{CIC}}
 \index{Calculus of Inductive Constructions}}
+%HEVEA\cutname{cic.html}
 
 The underlying formal language of {\Coq} is a {\em Calculus of
 Inductive Constructions} (\CIC) whose inference rules are presented in
@@ -882,56 +883,60 @@ the type $V$ satisfies the nested positivity condition for $X$
 \settowidth\framecharacterwidth{\hh}
 \newcommand\ws{\hbox{}\hskip\the\framecharacterwidth}
 \newcommand\ruleref[1]{\hskip.25em\dots\hskip.2em{\em (bullet #1)}}
+\newcommand{\NatTree}{\mbox{\textsf{nattree}}}
+\newcommand{\NatTreeA}{\mbox{\textsf{nattree}}~\ensuremath{A}}
+\newcommand{\cnode}{\mbox{\textsf{node}}}
+\newcommand{\cleaf}{\mbox{\textsf{leaf}}}
 
-\noindent For instance, if one considers the type
+\noindent For instance, if one considers the following variant of a tree type branching over the natural numbers
 
 \begin{verbatim}
-Inductive tree (A:Type) : Type :=
- | leaf : list A
- | node : A -> (nat -> tree A) -> tree A
+Inductive nattree (A:Type) : Type :=
+ | leaf : nattree A
+ | node : A -> (nat -> nattree A) -> nattree A
 \end{verbatim}
 
 \begin{latexonly}
-\noindent Then every instantiated constructor of $\ListA$ satisfies the nested positivity condition for $\List$\\
+\noindent Then every instantiated constructor of $\NatTreeA$ satisfies the nested positivity condition for $\NatTree$\\
 \noindent
 \ws\ws\vv\\
-\ws\ws\vh\hh\ws concerning type $\ListA$ of constructor $\Nil$:\\
-\ws\ws\vv\ws\ws\ws\ws Type $\ListA$ of constructor $\Nil$ satisfies the positivity condition for $\List$\\
-\ws\ws\vv\ws\ws\ws\ws because $\List$ does not appear in any (real) arguments of the type of that constructor\\
-\ws\ws\vv\ws\ws\ws\ws (primarily because $\List$ does not have any (real) arguments)\ruleref1\\
+\ws\ws\vh\hh\ws concerning type $\NatTreeA$ of constructor $\cleaf$:\\
+\ws\ws\vv\ws\ws\ws\ws Type $\NatTreeA$ of constructor $\cleaf$ satisfies the positivity condition for $\NatTree$\\
+\ws\ws\vv\ws\ws\ws\ws because $\NatTree$ does not appear in any (real) arguments of the type of that constructor\\
+\ws\ws\vv\ws\ws\ws\ws (primarily because $\NatTree$ does not have any (real) arguments)\ruleref1\\
 \ws\ws\vv\\
-\ws\ws\hv\hh\ws concerning type $\forall~A\ra\ListA\ra\ListA$ of constructor $\cons$:\\
-\ws\ws\ws\ws\ws\ws\ws Type $\forall~A:\Type,A\ra\ListA\ra\ListA$ of constructor $\cons$\\
-\ws\ws\ws\ws\ws\ws\ws satisfies the positivity condition for $\List$ because:\\
+\ws\ws\hv\hh\ws concerning type $\forall~A\ra(\NN\ra\NatTreeA)\ra\NatTreeA$ of constructor $\cnode$:\\
+    \ws\ws\ws\ws\ws\ws\ws Type $\forall~A:\Type,A\ra(\NN\ra\NatTreeA)\ra\NatTreeA$ of constructor $\cnode$\\
+\ws\ws\ws\ws\ws\ws\ws satisfies the positivity condition for $\NatTree$ because:\\
 \ws\ws\ws\ws\ws\ws\ws\vv\\
-\ws\ws\ws\ws\ws\ws\ws\vh\hh\ws $\List$ occurs only strictly positively in $\Type$\ruleref3\\
+\ws\ws\ws\ws\ws\ws\ws\vh\hh\ws $\NatTree$ occurs only strictly positively in $\Type$\ruleref1\\
 \ws\ws\ws\ws\ws\ws\ws\vv\\
-\ws\ws\ws\ws\ws\ws\ws\vh\hh\ws $\List$ occurs only strictly positively in $A$\ruleref3\\
+\ws\ws\ws\ws\ws\ws\ws\vh\hh\ws $\NatTree$ occurs only strictly positively in $A$\ruleref1\\
 \ws\ws\ws\ws\ws\ws\ws\vv\\
-\ws\ws\ws\ws\ws\ws\ws\vh\hh\ws $\List$ occurs only strictly positively in $\ListA$\ruleref4\\
+    \ws\ws\ws\ws\ws\ws\ws\vh\hh\ws $\NatTree$ occurs only strictly positively in $\NN\ra\NatTreeA$\ruleref{3+2}\\
 \ws\ws\ws\ws\ws\ws\ws\vv\\
-\ws\ws\ws\ws\ws\ws\ws\hv\hh\ws $\List$ satisfies the positivity condition for $\ListA$\ruleref1
+\ws\ws\ws\ws\ws\ws\ws\hv\hh\ws $\NatTree$ satisfies the positivity condition for $\NatTreeA$\ruleref1
 \end{latexonly}
 \begin{rawhtml}
 <pre>
-<span style="font-family:serif">Then every instantiated constructor of <span style="font-family:monospace">list A</span> satisfies the nested positivity condition for <span style="font-family:monospace">list</span></span>
+<span style="font-family:serif">Then every instantiated constructor of <span style="font-family:monospace">nattree A</span> satisfies the nested positivity condition for <span style="font-family:monospace">nattree</span></span>
   │
-  ├─ <span style="font-family:serif">concerning type <span style="font-family:monospace">list A</span> of constructor <span style="font-family:monospace">nil</span>:</span>
-  │    <span style="font-family:serif">Type <span style="font-family:monospace">list A</span> of constructor <span style="font-family:monospace">nil</span> satisfies the positivity condition for <span style="font-family:monospace">list</span></span>
-  │    <span style="font-family:serif">because <span style="font-family:monospace">list</span> does not appear in any (real) arguments of the type of that constructor</span>
-  │    <span style="font-family:serif">(primarily because list does not have any (real) arguments) ... <span style="font-style:italic">(bullet 1)</span></span>
+  ├─ <span style="font-family:serif">concerning type <span style="font-family:monospace">nattree A</span> of constructor <span style="font-family:monospace">nil</span>:</span>
+  │    <span style="font-family:serif">Type <span style="font-family:monospace">nattree A</span> of constructor <span style="font-family:monospace">nil</span> satisfies the positivity condition for <span style="font-family:monospace">nattree</span></span>
+  │    <span style="font-family:serif">because <span style="font-family:monospace">nattree</span> does not appear in any (real) arguments of the type of that constructor</span>
+  │    <span style="font-family:serif">(primarily because nattree does not have any (real) arguments) ... <span style="font-style:italic">(bullet 1)</span></span>
   │
-  ╰─ <span style="font-family:serif">concerning type <span style="font-family:monospace">∀ A → list A → list A</span> of constructor <span style="font-family:monospace">cons</span>:</span>
-       <span style="font-family:serif">Type <span style="font-family:monospace">∀ A : Type, A → list A → list A</span> of constructor <span style="font-family:monospace">cons</span></span>
-       <span style="font-family:serif">satisfies the positivity condition for <span style="font-family:monospace">list</span> because:</span>
+  ╰─ <span style="font-family:serif">concerning type <span style="font-family:monospace">∀ A → (nat → nattree A) → nattree A</span> of constructor <span style="font-family:monospace">cons</span>:</span>
+       <span style="font-family:serif">Type <span style="font-family:monospace">∀ A : Type, A → (nat → nattree A) → nattree A</span> of constructor <span style="font-family:monospace">cons</span></span>
+       <span style="font-family:serif">satisfies the positivity condition for <span style="font-family:monospace">nattree</span> because:</span>
        │
-       ├─ <span style="font-family:serif"><span style="font-family:monospace">list</span> occurs only strictly positively in <span style="font-family:monospace">Type</span> ... <span style="font-style:italic">(bullet 3)</span></span>
+       ├─ <span style="font-family:serif"><span style="font-family:monospace">nattree</span> occurs only strictly positively in <span style="font-family:monospace">Type</span> ... <span style="font-style:italic">(bullet 1)</span></span>
        │
-       ├─ <span style="font-family:serif"><span style="font-family:monospace">list</span> occurs only strictly positively in <span style="font-family:monospace">A</span> ... <span style="font-style:italic">(bullet 3)</span></span>
+       ├─ <span style="font-family:serif"><span style="font-family:monospace">nattree</span> occurs only strictly positively in <span style="font-family:monospace">A</span> ... <span style="font-style:italic">(bullet 1)</span></span>
        │
-       ├─ <span style="font-family:serif"><span style="font-family:monospace">list</span> occurs only strictly positively in <span style="font-family:monospace">list A</span> ... <span style="font-style:italic">(bullet 4)</span></span>
+       ├─ <span style="font-family:serif"><span style="font-family:monospace">nattree</span> occurs only strictly positively in <span style="font-family:monospace">nat → nattree A</span> ... <span style="font-style:italic">(bullet 3+2)</span></span>
        │
-       ╰─ <span style="font-family:serif"><span style="font-family:monospace">list</span> satisfies the positivity condition for <span style="font-family:monospace">list A</span> ... <span style="font-style:italic">(bullet 1)</span></span>
+       ╰─ <span style="font-family:serif"><span style="font-family:monospace">nattree</span> satisfies the positivity condition for <span style="font-family:monospace">nattree A</span> ... <span style="font-style:italic">(bullet 1)</span></span>
 </pre>
 \end{rawhtml}
 
diff --git a/doc/refman/RefMan-coi.tex b/doc/refman/RefMan-coi.tex
deleted file mode 100644
index dac3c60bd..000000000
--- a/doc/refman/RefMan-coi.tex
+++ /dev/null
@@ -1,405 +0,0 @@
-%\documentstyle[11pt,../tools/coq-tex/coq]{article}
-%\input{title}
- 
-%\include{macros}
-%\begin{document}
-
-%\coverpage{Co-inductive types in Coq}{Eduardo Gim\'enez}
-\chapter[Co-inductive types in Coq]{Co-inductive types in Coq\label{Co-inductives}}
-
-%\begin{abstract}
-{\it Co-inductive} types are types whose elements may not be well-founded.
-A formal study of the Calculus of Constructions extended by 
-co-inductive types has been presented
-in \cite{Gim94}. It is based on the notion of
-{\it guarded definitions} introduced by Th. Coquand
-in \cite{Coquand93}. The implementation is by E. Gim\'enez.
-%\end{abstract}
-
-\section{A short introduction to co-inductive types}
-
-We assume that the reader is rather familiar with inductive types.
-These types are characterized by their {\it constructors}, which can be 
-regarded as the basic methods from which the elements 
-of the type can be built up. It is implicit in the definition 
-of an inductive type that 
-its elements are the result of a {\it finite} number of 
-applications of its constructors. Co-inductive types arise from 
-relaxing this implicit condition and admitting that an element of
-the type can also be introduced by a non-ending (but effective) process 
-of construction defined in terms of the basic methods which characterize the
-type. So we could think in the wider notion of types defined by
-constructors (let us call them {\it recursive types}) and classify
-them into inductive and co-inductive ones, depending on whether or not
-we consider non-ending methods as admissible for constructing elements
-of the type. Note that in both cases we obtain a ``closed type'', all whose 
-elements are pre-determined in advance (by the constructors). When we
-know that $a$ is an element of a recursive type (no matter if it is 
-inductive or co-inductive) what we know is that it is the result of applying
-one of the basic forms of construction allowed for the type.
-So the more primitive way of eliminating an element of a recursive type is 
-by case analysis, i.e. by considering through which constructor it could have
-been introduced. In the case of inductive sets, the additional knowledge that
-constructors can be applied only a finite number of times provide
-us with a more powerful way of eliminating their elements, say,  
-the principle of
-induction. This principle is obviously not valid for co-inductive types,
-since it is just the expression of this extra knowledge attached to inductive 
-types.
-
-
-An example of a co-inductive type is the type of infinite sequences formed with
-elements of type $A$, or streams for shorter. In Coq, 
-it can be introduced using the \verb!CoInductive! command~:
-\begin{coq_example}
-CoInductive Stream (A:Set) : Set :=
-    cons : A -> Stream A -> Stream A.
-\end{coq_example}
-
-The syntax of this command is the same as the 
-command \verb!Inductive! (cf. section
-\ref{gal_Inductive_Definitions}).
-Definition of mutually co-inductive types are possible.
-
-As was already said, there are not principles of 
-induction for co-inductive sets, the only way of eliminating these
-elements is by case analysis. 
-In the example of streams, this elimination principle can be
-used for instance to define the well known 
-destructors on streams $\hd : (\Str\;A)\rightarrow A$ 
-and $\tl: (\Str\;A)\rightarrow (\Str\;A)$  :
-\begin{coq_example}
-Section Destructors.
-Variable A : Set.
-Definition hd (x:Stream A) := match x with
-                              | cons a s => a
-                              end.
-Definition tl (x:Stream A) := match x with
-                              | cons a s => s
-                              end.
-\end{coq_example}
-\begin{coq_example*}
-End Destructors.
-\end{coq_example*}
-
-\subsection{Non-ending methods of construction}
-
-At this point the reader should have realized that we have left unexplained
-what is a ``non-ending but effective process of
-construction'' of a stream. In the widest sense, a 
-method is a non-ending process of construction if we can eliminate the
-stream that it introduces, in other words, if we can reduce
-any case analysis on it. In this sense, the following ways of 
-introducing a stream are not acceptable. 
-\begin{center}
-$\zeros = (\cons\;\nat\;\nO\;(\tl\;\zeros))\;\;:\;\;(\Str\;\nat)$\\[12pt]
-$\filter\;(\cons\;A\;a\;s) = \si\;\;(P\;a)\;\;\alors\;\;(\cons\;A\;a\;(\filter\;s))\;\;\sinon\;\;(\filter\;s) )\;\;:\;\;(\Str\;A)$
-\end{center}
-\noindent The former it is not valid since the stream can not be eliminated 
-to obtain its tail. In the latter, a stream is naively defined as
-the result of erasing from another (arbitrary) stream 
-all the elements which does not verify a certain property $P$. This
-does not always makes sense, for example it does not when all the elements
-of the stream verify $P$, in which case we can not eliminate it to
-obtain its head\footnote{Note that there is no notion of ``the empty
-stream'', a stream is always infinite and build by a \texttt{cons}.}. 
-On the contrary, the following definitions are acceptable methods for
-constructing a stream~:
-\begin{center}
-$\zeros = (\cons\;\nat\;\nO\;\zeros)\;\;:\;\;(\Str\;\nat)\;\;\;(*)$\\[12pt]
-$(\from\;n) = (\cons\;\nat\;n\;(\from\;(\nS\;n)))\;:\;(\Str\;\nat)$\\[12pt]
-$\alter  = (\cons\;\bool\;\true\;(\cons\;\bool\;\false\;\alter))\;:\;(\Str\;\bool)$.
-\end{center}
-\noindent The first one introduces a stream containing all the natural numbers
-greater than a given one, and the second the stream which infinitely
-alternates the booleans true and false.
-
-In general it is not evident to realise when a definition can 
-be accepted or not. However, there is a class of definitions that
-can be easily recognised as being valid :  those 
-where (1) all the recursive calls of the method  are done 
-after having explicitly mentioned  which is (at least) the first constructor 
-to start building the element, and (2) no other 
-functions apart from constructors are applied to recursive calls. 
-This class of definitions is usually
-referred as {\it guarded-by-constructors} 
-definitions \cite{Coquand93,Gim94}. 
-The methods $\from$ 
-and $\alter$ are examples of definitions which are guarded by constructors.
-The definition of function $\filter$ is not, because there is no 
-constructor to guard 
-the recursive call in the {\it else} branch. Neither is the one of
-$\zeros$, since there is function applied to the recursive call
-which is not a constructor. However, there is a difference between 
-the definition of $\zeros$ and $\filter$. The former may be seen as a
-wrong way of characterising an object which makes sense, and it can
-be reformulated in an admissible way using the equation (*). On the contrary, 
-the definition of
-$\filter$ can not be patched, since is the idea itself 
-of traversing an infinite
-construction searching for an element whose existence is not ensured
-which does not make sense.
-
-
-
-Guarded definitions are exactly the kind of non-ending process of 
-construction which are allowed in Coq. The way of introducing 
-a guarded definition in Coq is using the special command 
-{\tt CoFixpoint}.  This command verifies that the definition introduces an
-element of a co-inductive type, and checks if it is guarded by constructors. 
-If we try to 
-introduce the definitions above, $\from$ and $\alter$ will be accepted,
-while $\zeros$ and $\filter$ will be rejected giving some explanation 
-about why.
-\begin{coq_example}
-CoFixpoint zeros  : Stream nat := cons nat 0%N (tl nat zeros).
-CoFixpoint zeros  : Stream nat := cons nat 0%N zeros.
-CoFixpoint from (n:nat) : Stream nat := cons nat n (from (S n)).
-\end{coq_example}
-
-As in the \verb!Fixpoint! command (see Section~\ref{Fixpoint}), it is possible 
-to introduce a block of mutually dependent methods. The general syntax
-for this case is :
-
-{\tt CoFixpoint {\ident$_1$}  :{\term$_1$} := {\term$_1'$}\\
-     with\\
-        \mbox{}\hspace{0.1cm} $\ldots$  \\
-        with {\ident$_m$}   : {\term$_m$} := {\term$_m'$}}
-
-
-\subsection{Non-ending methods and reduction}
-
-The elimination of a stream introduced by a \verb!CoFixpoint! definition 
-is done lazily, i.e. its definition can be expanded only when it occurs 
-at the head of an application which is the argument of a case expression. 
-Isolately it is considered as a canonical expression which 
-is completely evaluated. We can test this using the command \verb!compute! 
-to calculate the normal forms of some terms~:
-\begin{coq_example}
-Eval compute in (from 0).
-Eval compute in (hd nat (from 0)).
-Eval compute in (tl nat (from 0)).
-\end{coq_example}
-\noindent Thus, the equality 
-$(\from\;n)\equiv(\cons\;\nat\;n\;(\from \; (\S\;n)))$
-does not hold as definitional one. Nevertheless, it can be proved 
-as a propositional  equality, in the sense of Leibniz's equality. 
-The version {\it à la Leibniz} of the equality above follows from
-a general lemma stating that eliminating and then re-introducing a stream
-yields the same stream.
-\begin{coq_example}
-Lemma unfold_Stream :
-   forall x:Stream nat, x = match x with
-                            | cons a s => cons nat a s
-                            end.
-\end{coq_example}
- 
-\noindent The proof is immediate from the analysis of 
-the possible cases for $x$, which transforms 
-the equality in a trivial one.
-
-\begin{coq_example}
-olddestruct x.
-trivial.
-\end{coq_example}
-\begin{coq_eval}
-Qed.
-\end{coq_eval}
-The application of this lemma to  $(\from\;n)$ puts this
-constant at the head of an application which is an  argument 
-of a case analysis, forcing its expansion. 
-We can test the type of this application using Coq's command \verb!Check!,
-which infers the type of a given term. 
-\begin{coq_example}
-Check (fun n:nat => unfold_Stream (from n)).
-\end{coq_example}
- \noindent  Actually, The elimination of $(\from\;n)$ has actually 
-no effect, because it is followed by a re-introduction, 
-so the type of this application is in fact 
-definitionally equal to the
-desired proposition. We can test this computing
-the normal form of the application above to see its type.  
-\begin{coq_example}
-Transparent unfold_Stream.
-Eval compute in (fun n:nat => unfold_Stream (from n)).
-\end{coq_example}
-
-
-\section{Reasoning about infinite objects}
-
-At a first sight, it might seem that 
-case analysis does not provide a very powerful way
-of reasoning about infinite objects. In fact, what we can prove about 
-an infinite object using
-only case analysis is just what we can prove unfolding its method
-of construction a finite number of times, which is not always
-enough. Consider for example the following method for appending 
-two streams~:
-\begin{coq_example}
-Variable A : Set.
-CoFixpoint conc (s1 s2:Stream A) : Stream A :=
-  cons A (hd A s1) (conc (tl A s1) s2).
-\end{coq_example}
-
-Informally speaking, we expect that for all pair of streams $s_1$ and $s_2$, 
-$(\conc\;s_1\;s_2)$ 
-defines the ``the same'' stream as $s_1$, 
-in the sense that if we would be able to unfold the definition 
-``up to the infinite'', we would obtain definitionally equal normal forms.
-However, no finite unfolding of the definitions gives definitionally 
-equal terms. Their equality can not be proved just using case analysis.
-
-
-The weakness of the elimination principle proposed for infinite objects
-contrast with the power provided by the inductive 
-elimination principles, but it is not actually surprising. It just means
-that we can not expect to prove very interesting things about infinite
-objects doing finite proofs. To take advantage of infinite objects we
-have to consider infinite proofs as well. For example,
-if we want to catch up the equality between $(\conc\;s_1\;s_2)$ and 
-$s_1$ we have to introduce first the type of the infinite proofs 
-of equality between streams. This is a 
-co-inductive type, whose elements are build up from a 
-unique constructor, requiring a proof of the equality of the
-heads of the streams, and an (infinite) proof of the equality 
-of their tails. 
-
-\begin{coq_example}
-CoInductive EqSt : Stream A -> Stream A -> Prop :=
-    eqst :
-      forall s1 s2:Stream A,
-        hd A s1 = hd A s2 -> EqSt (tl A s1) (tl A s2) -> EqSt s1 s2.
-\end{coq_example}
-\noindent Now the equality of both streams can be proved introducing
-an infinite object of type 
-
-\noindent $(\EqSt\;s_1\;(\conc\;s_1\;s_2))$ by a \verb!CoFixpoint!
-definition.
-\begin{coq_example}
-CoFixpoint eqproof (s1 s2:Stream A) : EqSt s1 (conc s1 s2) :=
-  eqst s1 (conc s1 s2) (eq_refl (hd A (conc s1 s2)))
-    (eqproof (tl A s1) s2).
-\end{coq_example}
-\begin{coq_eval}
-Reset eqproof.
-\end{coq_eval}
-\noindent Instead of giving an explicit definition, 
-we can use the proof editor of Coq to help us in 
-the construction of the proof.
-A tactic \verb!Cofix! allows placing a \verb!CoFixpoint! definition
-inside a proof. 
-This tactic introduces a variable in the context which has
-the same type as the current goal, and its application stands
-for a recursive call in the construction of the proof. If no name is
-specified for this variable, the name of the lemma  is chosen by
-default.
-%\pagebreak 
-
-\begin{coq_example}
-Lemma eqproof : forall s1 s2:Stream A, EqSt s1 (conc s1 s2).
-cofix.
-\end{coq_example}
-
-\noindent An easy (and wrong!) way of finishing the proof is just to apply the
-variable \verb!eqproof!, which has the same type as the goal. 
-
-\begin{coq_example}
-intros.
-apply eqproof.
-\end{coq_example}
-
-\noindent The ``proof'' constructed in this way 
-would correspond to the \verb!CoFixpoint! definition
-\begin{coq_example*}
-CoFixpoint eqproof  : forall s1 s2:Stream A, EqSt s1 (conc s1 s2) :=
-  eqproof.
-\end{coq_example*}
-
-\noindent which is obviously non-guarded. This means that 
-we can use the proof editor to
-define a method of construction which does not make sense. However,
-the system will never accept to include it as part of the theory,
-because the guard condition is always verified before saving the proof.
-
-\begin{coq_example}
-Qed.
-\end{coq_example}
-
-\noindent Thus, the user must be careful in the 
-construction of infinite proofs 
-with the tactic \verb!Cofix!. Remark that once it has been used 
-the application of tactics performing automatic proof search in 
-the environment (like for example \verb!Auto!)
-could introduce unguarded recursive calls in the proof.
-The command \verb!Guarded! verifies
-that the guarded condition has been not violated 
-during the construction of the proof. This command can be
-applied even if the proof term is not complete.
-
-
-
-\begin{coq_example}
-Restart.
-cofix.
-auto.
-Guarded.
-Undo.
-Guarded.
-\end{coq_example}
-
-\noindent To finish with this example, let us restart from the
-beginning and show how to construct an admissible proof~:
-
-\begin{coq_example} 
-Restart.
- cofix.
-\end{coq_example}
-
-%\pagebreak
-
-\begin{coq_example}
-intros.
-apply eqst.
-trivial.
-simpl.
-apply eqproof.
-Qed.
-\end{coq_example}
-
-
-\section{Experiments with co-inductive types}
-
-Some examples involving co-inductive types are available with
-the distributed system, in the theories library and in the contributions
-of the Lyon site. Here we present a short description of their contents~:
-\begin{itemize}
-\item Directory \verb!theories/LISTS! : 
-        \begin{itemize}
-                \item File \verb!Streams.v! : The type of streams and the 
-extensional equality between streams. 
-        \end{itemize}
-
-\item Directory \verb!contrib/Lyon/COINDUCTIVES! : 
-      \begin{itemize}
-                \item Directory \verb!ARITH! : An arithmetic where $\infty$
-is an explicit constant of the language instead of a metatheoretical notion.
-                \item Directory \verb!STREAM! :
-      \begin{itemize}
-                \item File \verb!Examples! :
-Several examples of guarded definitions, as well as 
-of frequent errors in the introduction of a stream. A different 
-way of defining the extensional equality of two streams,
-and the proofs showing that it is equivalent to the one in \verb!theories!.
-                \item File \verb!Alter.v! : An example showing how 
-an infinite proof introduced by a guarded definition can be also described
-using an operator of co-recursion \cite{Gimenez95b}.
-                 \end{itemize}
-\item Directory \verb!PROCESSES! : A proof of the alternating 
-bit protocol based on Pra\-sad's Calculus of Broadcasting Systems \cite{Prasad93},
-and the verification of an interpreter for this calculus. 
-See \cite{Gimenez95b} for a complete description about this development.
-        \end{itemize}
-\end{itemize}
-
-%\end{document}
-
diff --git a/doc/refman/RefMan-com.tex b/doc/refman/RefMan-com.tex
index 45230fb6e..04a8a25c1 100644
--- a/doc/refman/RefMan-com.tex
+++ b/doc/refman/RefMan-com.tex
@@ -2,6 +2,7 @@
 \ttindex{coqtop}
 \ttindex{coqc}
 \ttindex{coqchk}}
+%HEVEA\cutname{commands.html}
 
 There are three \Coq~commands: 
 \begin{itemize}
@@ -106,6 +107,15 @@ The following command-line options are recognized by the commands {\tt
   recursively available from {\Coq} using absolute names (extending
   the {\dirpath} prefix) (see Section~\ref{LongNames}).
 
+  Note that only those subdirectories and files which obey the lexical
+  conventions of what is an {\ident} (see Section~\ref{lexical})
+  are taken into account. Conversely, the underlying file systems or
+  operating systems may be more restrictive than {\Coq}. While Linux's
+  ext4 file system supports any {\Coq} recursive layout
+  (within the limit of 255 bytes per file name), the default on NTFS
+  (Windows) or HFS+ (MacOS X) file systems is on the contrary to
+  disallow two files differing only in the case in the same directory.
+
   \SeeAlso Section~\ref{Libraries}.
 
 \item[{\tt -R} {\em directory} {\dirpath}]\ %
@@ -204,11 +214,6 @@ The following command-line options are recognized by the commands {\tt
 %
 %  Switch on the debug flag.
 
-\item[{\tt -with-geoproof} (yes|no)]\ %
-
-  Enable or not special functions for Geoproof within {\CoqIDE} (default
-  is yes).
-
 \item[{\tt -color} (on|off|auto)]\ %
 
   Enable or not the coloring of output of {\tt coqtop}. Default is auto,
@@ -294,8 +299,9 @@ The following command-line options are recognized by the commands {\tt
 
 \section{Compiled libraries checker ({\tt coqchk})}
 
-The {\tt coqchk} command takes a list of library paths as argument.
-The corresponding compiled libraries (.vo files) are searched in the
+The {\tt coqchk} command takes a list of library paths as argument, described
+either by their logical name or by their physical filename, which must end in
+{\tt .vo}. The corresponding compiled libraries (.vo files) are searched in the
 path, recursively processing the libraries they depend on. The content
 of all these libraries is then type-checked. The effect of {\tt
   coqchk} is only to return with normal exit code in case of success,
@@ -325,9 +331,12 @@ code, it cannot be guaranteed that the produced compiled libraries are
 correct. {\tt coqchk} is a standalone verifier, and thus it cannot be
 tainted by such malicious code.
 
-Command-line options {\tt -I}, {\tt -R}, {\tt -where} and
+Command-line options {\tt -Q}, {\tt -R}, {\tt -where} and
 {\tt -impredicative-set} are supported by {\tt coqchk} and have the
-same meaning as for {\tt coqtop}. Extra options are:
+same meaning as for {\tt coqtop}. As there is no notion of relative paths in
+object files {\tt -Q} and {\tt -R} have exactly the same meaning.
+
+Extra options are:
 \begin{description}
 \item[{\tt -norec} {\em module}]\ %
 
diff --git a/doc/refman/RefMan-ext.tex b/doc/refman/RefMan-ext.tex
index 713f344cb..a1950d136 100644
--- a/doc/refman/RefMan-ext.tex
+++ b/doc/refman/RefMan-ext.tex
@@ -1,4 +1,5 @@
 \chapter[Extensions of \Gallina{}]{Extensions of \Gallina{}\label{Gallina-extension}\index{Gallina}}
+%HEVEA\cutname{gallina-ext.html}
 
 {\gallina} is the kernel language of {\Coq}. We describe here extensions of
 the Gallina's syntax.
@@ -279,15 +280,78 @@ of the chapter devoted to coercions.
 \label{prim-proj}
 
 The option {\tt Set Primitive Projections} turns on the use of primitive
-projections when defining subsequent records. Primitive projections
+projections when defining subsequent records (even through the {\tt
+  Inductive} and {\tt CoInductive} commands). Primitive projections
 extended the Calculus of Inductive Constructions with a new binary term
 constructor {\tt r.(p)} representing a primitive projection p applied to
 a record object {\tt r} (i.e., primitive projections are always
 applied). Even if the record type has parameters, these do not appear at
 applications of the projection, considerably reducing the sizes of terms
 when manipulating parameterized records and typechecking time. On the
-user level, primitive projections are a transparent replacement
-for the usual defined ones.
+user level, primitive projections can be used as a replacement for the
+usual defined ones, although there are a few notable differences.
+
+The internally omitted parameters can be reconstructed at printing time
+even though they are absent in the actual AST manipulated by the kernel. This
+can be obtained by setting the {\tt Printing Primitive Projection Parameters}
+flag. Another compatibility printing can be activated thanks to the
+{\tt Printing Primitive Projection Compatibility} option which governs the
+printing of pattern-matching over primitive records.
+
+\subsubsection{Primitive Record Types}
+When the {\tt Set Primitive Projections} option is on, definitions of
+record types change meaning. When a type is declared with primitive
+projections, its {\tt match} construct is disabled (see
+\ref{primproj:compat} though). To eliminate the (co-)inductive type, one
+must use its defined primitive projections.
+
+There are currently two ways to introduce primitive records types:
+\begin{itemize}
+\item Through the {\tt Record} command, in which case the type has to be
+  non-recursive. The defined type enjoys eta-conversion definitionally,
+  that is the generalized form of surjective pairing for records:
+  {\tt $r$ = Build\_R ($r$.($p_1$) .. $r$.($p_n$))}. Eta-conversion allows to define
+  dependent elimination for these types as well.
+\item Through the {\tt Inductive} and {\tt CoInductive} commands, when
+  the body of the definition is a record declaration of the form {\tt
+    Build\_R \{ $p_1$ : $t_1$; .. ; $p_n$ : $t_n$ \}}. In this case the types can be
+  recursive and eta-conversion is disallowed. These kind of record types
+  differ from their traditional versions in the sense that dependent
+  elimination is not available for them and only non-dependent case analysis
+  can be defined.
+\end{itemize}
+
+\subsubsection{Reduction}
+
+The basic reduction rule of a primitive projection is {\tt $p_i$
+  (Build\_R $t_1$ .. $t_n$) $\rightarrow_{\iota}$ $t_i$}. However, to take the $\delta$ flag into
+account, projections can be in two states: folded or unfolded. An
+unfolded primitive projection application obeys the rule above, while
+the folded version delta-reduces to the unfolded version. This allows to
+precisely mimic the usual unfolding rules of constants. Projections
+obey the usual {\tt simpl} flags of the {\tt Arguments} command in particular.
+
+There is currently no way to input unfolded primitive projections at the
+user-level, and one must use the {\tt Printing Primitive Projection
+  Compatibility} to display unfolded primitive projections as matches
+and distinguish them from folded ones.
+
+\subsubsection{Compatibility Projections and {\tt match}}
+\label{primproj:compat}
+To ease compatibility with ordinary record types, each primitive
+projection is also defined as a ordinary constant taking parameters and
+an object of the record type as arguments, and whose body is an
+application of the unfolded primitive projection of the same name. These
+constants are used when elaborating partial applications of the
+projection. One can distinguish them from applications of the primitive
+projection if the {\tt Printing Primitive Projection Parameters} option
+is off: for a primitive projection application, parameters are printed
+as underscores while for the compatibility projections they are printed
+as usual.
+
+Additionally, user-written {\tt match} constructs on primitive records
+are desugared into substitution of the projections, they cannot be
+printed back as {\tt match} constructs.
 
   % - r.(p) and (p r) elaborate to native projection application, and
   %   the parameters cannot be mentioned. The following arguments are
@@ -305,13 +369,6 @@ for the usual defined ones.
   % - [pattern x at n], [rewrite x at n] and in general abstraction and selection
   %   of occurrences may fail due to the disappearance of parameters.
 
-The internally omitted parameters can be reconstructed at printing time
-even though they are absent in the actual AST manipulated by the kernel. This
-can be obtained by setting the {\tt Printing Primitive Projection Parameters}
-flag. Another compatibility printing can be activated thanks to the
-{\tt Printing Primitive Projection Compatibility} option which governs the
-printing of pattern-matching over primitive records.
-
 \section{Variants and extensions of {\mbox{\tt match}}
 \label{Extensions-of-match}
 \index{match@{\tt match\ldots with\ldots end}}}
@@ -493,6 +550,60 @@ the same way as the {\Coq} kernel handles them.
 This tells if the printing matching mode is on or off. The default is
 on.
 
+\subsubsection{Factorization of clauses with same right-hand side}
+\label{SetPrintingFactorizableMatchPatterns}
+\optindex{Printing Factorizable Match Patterns}
+
+When several patterns share the same right-hand side, it is
+additionally possible to share the clauses using disjunctive patterns.
+Assuming that the printing matching mode is on, whether {\Coq}'s
+printer shall try to do this kind of factorization is governed by the
+following commands:
+
+\begin{quote}
+{\tt Set Printing Factorizable Match Patterns.}
+\end{quote}
+This tells {\Coq}'s printer to try to use disjunctive patterns. This is the default
+behavior.
+
+\begin{quote}
+{\tt Unset Printing Factorizable Match Patterns.}
+\end{quote}
+This tells {\Coq}'s printer not to try to use disjunctive patterns.
+
+\begin{quote}
+{\tt Test Printing Factorizable Match Patterns.}
+\end{quote}
+This tells if the factorization of clauses with same right-hand side is
+on or off.
+
+\subsubsection{Use of a default clause}
+\label{SetPrintingAllowDefaultClause}
+\optindex{Printing Allow Default Clause}
+
+When several patterns share the same right-hand side which do not
+depend on the arguments of the patterns, yet an extra factorization is
+possible: the disjunction of patterns can be replaced with a ``{\tt
+  \_}'' default clause. Assuming that the printing matching mode and
+the factorization mode are on, whether {\Coq}'s printer shall try to
+use a default clause is governed by the following commands:
+
+\begin{quote}
+{\tt Set Printing Allow Default Clause.}
+\end{quote}
+This tells {\Coq}'s printer to use a default clause when relevant. This is the default
+behavior.
+
+\begin{quote}
+{\tt Unset Printing Allow Default Clause.}
+\end{quote}
+This tells {\Coq}'s printer not to use a default clause.
+
+\begin{quote}
+{\tt Test Printing Allow Default Clause.}
+\end{quote}
+This tells if the use of a default clause is allowed.
+
 \subsubsection{Printing of wildcard pattern
 \optindex{Printing Wildcard}}
 
@@ -1664,7 +1775,7 @@ to be given as if none arguments were implicit. By symmetry, this also
 affects printing. To restore parsing and normal printing of implicit
 arguments, use:
 \begin{quote}
-{\tt Set Parsing Explicit.}
+{\tt Unset Parsing Explicit.}
 \end{quote}
 
 \subsection{Canonical structures
@@ -1783,6 +1894,9 @@ This is useful for declaring the implicit type of a single variable.
 \subsection{Implicit generalization
 \label{implicit-generalization}
 \comindex{Generalizable Variables}}
+% \textquoteleft since \` doesn't do what we want
+\index{0genimpl@{\textquoteleft\{\ldots\}}}
+\index{0genexpl@{\textquoteleft(\ldots)}}
 
 Implicit generalization is an automatic elaboration of a statement with
 free variables into a closed statement where these variables are
diff --git a/doc/refman/RefMan-gal.tex b/doc/refman/RefMan-gal.tex
index ef12fe416..41ea0a5dc 100644
--- a/doc/refman/RefMan-gal.tex
+++ b/doc/refman/RefMan-gal.tex
@@ -1,5 +1,6 @@
 \chapter{The \gallina{} specification language
 \label{Gallina}\index{Gallina}}
+%HEVEA\cutname{gallina.html}
 \label{BNF-syntax} % Used referred to as a chapter label
 
 This chapter describes \gallina, the specification language of {\Coq}.
@@ -433,6 +434,7 @@ be shortened in {\tt fun~x~y~z~:~A~=>~t}).
 \subsection{Abstractions
 \label{abstractions}
 \index{abstractions}}
+\index{fun@{{\tt fun \ldots => \ldots}}}
 
 The expression ``{\tt fun} {\ident} {\tt :} {\type} {\tt =>}~{\term}''
 defines the {\em abstraction} of the variable {\ident}, of type
@@ -454,6 +456,7 @@ occurs in the list of binders, it is expanded to a let-in definition
 \subsection{Products
 \label{products}
 \index{products}}
+\index{forall@{{\tt forall \ldots, \ldots}}}
 
 The expression ``{\tt forall}~{\ident}~{\tt :}~{\type}{\tt
 ,}~{\term}'' denotes the {\em product} of the variable {\ident} of
@@ -494,6 +497,7 @@ arguments is used for making explicit the value of implicit arguments
 \subsection{Type cast
 \label{typecast}
 \index{Cast}}
+\index{cast@{{\tt(\ldots: \ldots)}}}
 
 The expression ``{\term}~{\tt :}~{\type}'' is a type cast
 expression. It enforces the type of {\term} to be {\type}.
@@ -513,6 +517,7 @@ symbol ``\_'' and {\Coq} will guess the missing piece of information.
 \label{let-in}
 \index{Let-in definitions}
 \index{let-in}}
+\index{let@{{\tt let \ldots := \ldots in \ldots}}}
 
 
 {\tt let}~{\ident}~{\tt :=}~{\term$_1$}~{\tt in}~{\term$_2$} denotes
diff --git a/doc/refman/RefMan-ide.tex b/doc/refman/RefMan-ide.tex
index c6fbd1c53..2d9853430 100644
--- a/doc/refman/RefMan-ide.tex
+++ b/doc/refman/RefMan-ide.tex
@@ -1,5 +1,6 @@
 \chapter[\Coq{} Integrated Development Environment]{\Coq{} Integrated Development Environment\label{Addoc-coqide}
 \ttindex{coqide}}
+%HEVEA\cutname{coqide.html}
 
 The \Coq{} Integrated Development Environment is a graphical tool, to
 be used as a user-friendly replacement to \texttt{coqtop}. Its main
@@ -12,8 +13,7 @@ line. Without argument, the main screen is displayed with an ``unnamed
 buffer'', and with a file name as argument, another buffer displaying
 the contents of that file. Additionally, \verb|coqide| accepts the same
 options as \verb|coqtop|, given in Chapter~\ref{Addoc-coqc}, the ones having
-obviously no meaning for \CoqIDE{} being ignored. Additionally, \verb|coqide| accepts the option \verb|-enable-geoproof| to enable the support for \emph{GeoProof} \footnote{\emph{GeoProof} is dynamic geometry software which can be used in conjunction with \CoqIDE{} to interactively build a Coq statement corresponding to a geometric figure. More information about \emph{GeoProof} can be found here: \url{http://home.gna.org/geoproof/} }. 
-  
+obviously no meaning for \CoqIDE{} being ignored.
 
 \begin{figure}[t]
 \begin{center}
@@ -44,9 +44,10 @@ bottom is the status bar.
 In the script window, you may open arbitrarily many buffers to
 edit. The \emph{File} menu allows you to open files or create some,
 save them, print or export them into various formats. Among all these
-buffers, there is always one which is the current \emph{running
-  buffer}, whose name is displayed on a green background, which is the
-one where Coq commands are currently executed. 
+buffers, there is always one which is the current
+\emph{running buffer}, whose name is displayed on a background in the
+\emph{processed} color (green by default), which is the one where Coq commands
+are currently executed.
 
 Buffers may be edited as in any text editor, and classical basic
 editing commands (Copy/Paste, \ldots) are available in the \emph{Edit}
@@ -58,12 +59,13 @@ menu.
 \section{Interactive navigation into \Coq{} scripts}
 
 The running buffer is the one where navigation takes place. The
-toolbar proposes five basic commands for this. The first one,
+toolbar offers five basic navigation commands. The first one,
 represented by a down arrow icon, is for going forward executing one
 command. If that command is successful, the part of the script that
-has been executed is displayed on a green background. If that command
-fails, the error message is displayed in the message window, and the
-location of the error is emphasized by a red underline.
+has been executed is displayed on a background with the
+processed color. If that command fails, the error message is
+displayed in the message window, and the location of the error is
+emphasized by an underline in the error foreground color (red by default).
 
 On Figure~\ref{fig:coqide}, the running buffer is \verb|Fermat.v|, all
 commands until the \verb|Theorem| have been already executed, and the
@@ -71,23 +73,41 @@ user tried to go forward executing \verb|Induction n|. That command
 failed because no such tactic exist (tactics are now in
 lowercase\ldots), and the wrong word is underlined. 
 
-Notice that the green part of the running buffer is not editable. If
+Notice that the processed part of the running buffer is not editable. If
 you ever want to modify something you have to go backward using the up
 arrow tool, or even better, put the cursor where you want to go back
 and use the \textsf{goto} button. Unlike with \verb|coqtop|, you
 should never use \verb|Undo| to go backward.
 
-Two additional tool buttons exist, one to go directly to the end and
-one to go back to the beginning. If you try to go to the end, or in
-general to run several commands using the \textsf{goto} button, the
-  execution will stop whenever an error is found.
+There are two additional buttons for navigation within the running buffer.
+The ``down'' button with a line goes directly to the end; the ``up'' button
+with a line goes back to the beginning. The handling of errors when using the
+go-to-the-end button depends on whether \Coq{} is running in asynchronous mode or not
+(see Chapter~\ref{Asyncprocessing}). If it is not running in that mode, execution stops
+as soon as an error is found. Otherwise, execution continues, and the
+error is marked with an underline in the error foreground color, with a background in
+the error background color (pink by default). The same characterization of
+error-handling applies when running several commands using the \textsf{goto} button.
 
 If you ever try to execute a command which happens to run during a
 long time, and would like to abort it before its
 termination, you may use the interrupt button (the white cross on a red circle).
  
-Finally, notice that these navigation buttons are also available in
-the menu, where their keyboard shortcuts are given.
+There are other buttons on the \CoqIDE{} toolbar: a button to save the running
+buffer; a button to close the current buffer (an ``X''); buttons to switch among
+buffers (left and right arrows); an ``information'' button; and a ``gears'' button.
+
+The ``information'' button is described in Section~\ref{sec:trytactics}.
+
+The ``gears'' button submits proof terms to the \Coq{} kernel for type-checking.
+When \Coq{} uses asynchronous processing (see Chapter~\ref{Asyncprocessing}), proofs may
+have been completed without kernel-checking of generated proof terms. The presence of
+unchecked proof terms is indicated by \texttt{Qed} statements
+that have a subdued \emph{being-processed} color (light blue by default),
+rather than the processed color, though their preceding proofs have the processed color.
+
+Notice that for all these buttons, except for the ``gears'' button, their operations
+are also available in the menu, where their keyboard shortcuts are given.
 
 \section[Try tactics automatically]{Try tactics automatically\label{sec:trytactics}}
 
@@ -96,8 +116,8 @@ trying to solve the current goal using simple tactics. If such a
 tactic succeeds in solving the goal, then its text is automatically
 inserted into the script. There is finally a combination of these
 tactics, called the \emph{proof wizard} which will try each of them in
-turn. This wizard is also available as a tool button (the light
-bulb).  The set of tactics tried by the wizard is customizable in
+turn. This wizard is also available as a tool button (the ``information''
+button).  The set of tactics tried by the wizard is customizable in
 the preferences.
 
 These tactics are general ones, in particular they do not refer to
@@ -132,7 +152,7 @@ arguments.
 
 \begin{figure}[t]
 \begin{center}
-%HEVEA\imgsrc[alt="coqide query window"]{coqide-queries.png}
+%HEVEA\imgsrc[alt="coqide query"]{coqide-queries.png}
 %BEGIN LATEX
 \ifpdf  % si on est en pdflatex
 \includegraphics[width=1.0\textwidth]{coqide-queries.png}
@@ -141,27 +161,21 @@ arguments.
 \fi
 %END LATEX
 \end{center}
-\caption{\CoqIDE{}: the query window}
-\label{fig:querywindow}
+\caption{\CoqIDE{}: a Print query on a selected phrase}
+\label{fig:queryselected}
 \end{figure}
 
-
-We call \emph{query} any vernacular command that do not change the
-current state, such as \verb|Check|, \verb|Search|, etc. Those
-commands are of course useless during compilation of a file, hence
-should not be included in scripts. To run such commands without
-writing them in the script, \CoqIDE{} offers another input window
-called the \emph{query window}. This window can be displayed on
-demand, either by using the \texttt{Window} menu, or directly using
-shortcuts given in the \texttt{Queries} menu. Indeed, with \CoqIDE{}
-the simplest way to perform a \texttt{Search} on some identifier
-is to select it using the mouse, and pressing \verb|F2|. This will
-both make appear the query window and run the \texttt{Search} in
-it, displaying the result. Shortcuts \verb|F3| and \verb|F4| are for
-\verb|Check| and \verb|Print| respectively.
-Figure~\ref{fig:querywindow} displays the query window after selection
-of the word ``mult'' in the script windows, and pressing \verb|F4| to
-print its definition.
+We call \emph{query} any vernacular command that does not change the
+current state, such as \verb|Check|, \verb|Search|, etc.
+To run such commands interactively, without writing them in scripts,
+\CoqIDE{} offers a \emph{query pane}.
+The query pane can be displayed on demand by using the \texttt{View} menu,
+or using the shortcut \verb|F1|. Queries can also be performed by
+selecting a particular phrase, then choosing an item from the
+\texttt{Queries} menu. The response then appears in the message window.
+Figure~\ref{fig:queryselected} shows the result after selecting
+of the phrase \verb|Nat.mul| in the script window, and choosing \verb|Print|
+from the \texttt{Queries} menu.
 
 \section{Compilation}
 
diff --git a/doc/refman/RefMan-int.tex b/doc/refman/RefMan-int.tex
index 2b9e4e605..f802a3595 100644
--- a/doc/refman/RefMan-int.tex
+++ b/doc/refman/RefMan-int.tex
@@ -2,6 +2,7 @@
 \setheaders{Introduction}
 %END LATEX
 \chapter*{Introduction}
+%HEVEA\cutname{introduction.html}
 
 This document is the Reference Manual of version \coqversion{} of the \Coq\ 
 proof assistant. A companion volume, the \Coq\ Tutorial, is provided
diff --git a/doc/refman/RefMan-lib.tex b/doc/refman/RefMan-lib.tex
index 4ebb484e7..89f5be843 100644
--- a/doc/refman/RefMan-lib.tex
+++ b/doc/refman/RefMan-lib.tex
@@ -1,4 +1,5 @@
 \chapter[The {\Coq} library]{The {\Coq} library\index{Theories}\label{Theories}}
+%HEVEA\cutname{stdlib.html}
 
 The \Coq\ library is structured into two parts:
 
@@ -54,6 +55,7 @@ Figure~\ref{init-notations}.
 \hline
 Notation & Precedence & Associativity \\
 \hline
+\verb!_ -> _! & 99 & right \\
 \verb!_ <-> _! & 95 & no \\
 \verb!_ \/ _!  & 85 & right \\
 \verb!_ /\ _!  & 80 & right \\
diff --git a/doc/refman/RefMan-ltac.tex b/doc/refman/RefMan-ltac.tex
index 3ce1d4ecd..c4c0435c5 100644
--- a/doc/refman/RefMan-ltac.tex
+++ b/doc/refman/RefMan-ltac.tex
@@ -1,4 +1,5 @@
 \chapter[The tactic language]{The tactic language\label{TacticLanguage}}
+%HEVEA\cutname{ltac.html}
 
 %\geometry{a4paper,body={5in,8in}}
 
@@ -197,8 +198,6 @@ is understood as
            {\cpattern} {\tt =>} {\tacexpr}\\
 & $|$ & {\tt context} {\zeroone{\ident}} {\tt [} {\cpattern} {\tt ]}
            {\tt =>} {\tacexpr}\\
-& $|$ & {\tt appcontext} {\zeroone{\ident}} {\tt [} {\cpattern} {\tt ]}
-           {\tt =>} {\tacexpr}\\
 & $|$ & {\tt \_ =>} {\tacexpr}\\
 \\
 {\it test} & ::= &
@@ -310,10 +309,11 @@ A sequence is an expression of the following form:
 \begin{quote}
 {\tacexpr}$_1$ {\tt ;} {\tacexpr}$_2$
 \end{quote}
-The expressions {\tacexpr}$_1$ and {\tacexpr}$_2$ are evaluated
-to $v_1$ and $v_2$ which have to be tactic values. The tactic $v_1$ is
-then applied and $v_2$ is applied to the goals generated by the
-application of $v_1$. Sequence is left-associative.
+The expression {\tacexpr}$_1$ is evaluated to $v_1$, which must be
+a tactic value. The tactic $v_1$ is applied to the current goal,
+possibly producing more goals. Then {\tacexpr}$_2$ is evaluated to
+produce $v_2$, which must be a tactic value. The tactic $v_2$ is applied to
+all the goals produced by the prior application. Sequence is associative.
 
 \subsubsection[Local application of tactics]{Local application of tactics\tacindex{[>\ldots$\mid$\ldots$\mid$\ldots]}\tacindex{;[\ldots$\mid$\ldots$\mid$\ldots]}\index{Tacticals![> \mid ]@{\tt {\tac$_0$};[{\tac$_1$}$\mid$\ldots$\mid$\tac$_n$]}}\index{Tacticals!; [ \mid ]@{\tt {\tac$_0$};[{\tac$_1$}$\mid$\ldots$\mid$\tac$_n$]}}}
 %\tacindex{; [ | ]}
@@ -546,7 +546,7 @@ Yet another way of branching without backtracking is the following structure:
 $v_2$ which must be tactic values. The tactic value $v_1$ is applied in each
 subgoal independently and if it fails \emph{to progress} then $v_2$ is
 applied. {\tacexpr}$_1$ {\tt ||} {\tacexpr}$_2$ is equivalent to {\tt
-  first [} {\tt progress} {\tacexpr}$_1$ {\tt |} {\tt progress}
+  first [} {\tt progress} {\tacexpr}$_1$ {\tt |}
   {\tacexpr}$_2$ {\tt ]} (except that if it fails, it fails like
 $v_2$). Branching is left-associative.
 
@@ -560,7 +560,7 @@ The tactic
 is a generalization of the biased-branching tactics above. The
 expression {\tacexpr}$_1$ is evaluated to $v_1$, which is then applied
 to each subgoal independently. For each goal where $v_1$ succeeds at
-least once, {tacexpr}$_2$ is evaluated to $v_2$ which is then applied
+least once, {\tacexpr}$_2$ is evaluated to $v_2$ which is then applied
 collectively to the generated subgoals. The $v_2$ tactic can trigger
 backtracking points in $v_1$: where $v_1$ succeeds at least once, {\tt
   tryif {\tacexpr}$_1$ then {\tacexpr}$_2$ else {\tacexpr}$_3$} is
@@ -709,6 +709,55 @@ runs is displayed. Time is in seconds and is machine-dependent. The
 {\qstring} argument is optional. When provided, it is used to identify
 this particular occurrence of {\tt time}.
 
+\subsubsection{Timing a tactic that evaluates to a term\tacindex{time\_constr}\tacindex{restart\_timer}\tacindex{finish\_timing}
+\index{Tacticals!time\_constr@{\tt time\_constr}}}
+\index{Tacticals!restart\_timer@{\tt restart\_timer}}
+\index{Tacticals!finish\_timing@{\tt finish\_timing}}
+
+Tactic expressions that produce terms can be timed with the experimental tactic
+\begin{quote}
+ {\tt time\_constr} {\tacexpr}
+\end{quote}
+which evaluates {\tacexpr\tt{ ()}}
+and displays the time the tactic expression evaluated, assuming successful evaluation.
+Time is in seconds and is machine-dependent.
+
+This tactic currently does not support nesting, and will report times based on the innermost execution.
+This is due to the fact that it is implemented using the tactics
+\begin{quote}
+ {\tt restart\_timer} {\qstring}
+\end{quote}
+and
+\begin{quote}
+ {\tt finish\_timing} ({\qstring}) {\qstring}
+\end{quote}
+which (re)set and display an optionally named timer, respectively.
+The parenthesized {\qstring} argument to {\tt finish\_timing} is also
+optional, and determines the label associated with the timer for
+printing.
+
+By copying the definition of {\tt time\_constr} from the standard
+library, users can achive support for a fixed pattern of nesting by
+passing different {\qstring} parameters to {\tt restart\_timer} and
+{\tt finish\_timing} at each level of nesting.  For example:
+
+\begin{coq_example}
+Ltac time_constr1 tac :=
+  let eval_early := match goal with _ => restart_timer "(depth 1)" end in
+  let ret := tac () in
+  let eval_early := match goal with _ => finish_timing ( "Tactic evaluation" ) "(depth 1)" end in
+  ret.
+
+Goal True.
+  let v := time_constr
+             ltac:(fun _ =>
+                     let x := time_constr1 ltac:(fun _ => constr:(10 * 10)) in
+                     let y := time_constr1 ltac:(fun _ => eval compute in x) in
+                     y) in
+  pose v.
+Abort.
+\end{coq_example}
+
 \subsubsection[Local definitions]{Local definitions\index{Ltac!let@\texttt{let}}
 \index{Ltac!let rec@\texttt{let rec}}
 \index{let@\texttt{let}!in Ltac}
@@ -874,21 +923,6 @@ Goal True.
 f (3+4).
 \end{coq_example}
 
-\item \index{appcontext@\texttt{appcontext}!in pattern}
-  \optindex{Tactic Compat Context}
-For historical reasons, {\tt context} used to consider $n$-ary applications
-such as {\tt (f 1 2)} as a whole, and not as a sequence of unary
-applications {\tt ((f 1) 2)}. Hence {\tt context [f ?x]} would fail
-to find a matching subterm in {\tt (f 1 2)}: if the pattern was a partial
-application, the matched subterms would have necessarily been
-applications with exactly the same number of arguments.
-As a workaround, one could use the following variant of {\tt context}:
-\begin{quote}
-{\tt appcontext} {\ident} {\tt [} {\cpattern} {\tt ]}
-\end{quote}
-This syntax is now deprecated, as {\tt context} behaves as intended. The former
-behavior can be retrieved with the {\tt Tactic Compat Context} flag.
-
 \end{Variants}
 
 \subsubsection[Pattern matching on goals]{Pattern matching on goals\index{Ltac!match goal@\texttt{match goal}}\label{ltac-match-goal}
@@ -1105,19 +1139,14 @@ Fail all:let n:= numgoals in guard n=2.
 Reset Initial.
 \end{coq_eval}
 
-\subsubsection[Proving a subgoal as a separate lemma]{Proving a subgoal as a separate lemma\tacindex{abstract}\tacindex{transparent\_abstract}\comindex{Qed exporting}
+\subsubsection[Proving a subgoal as a separate lemma]{Proving a subgoal as a separate lemma\tacindex{abstract}\tacindex{transparent\_abstract}
 \index{Tacticals!abstract@{\tt abstract}}\index{Tacticals!transparent\_abstract@{\tt transparent\_abstract}}}
 
 From the outside ``\texttt{abstract \tacexpr}'' is the same as
 {\tt solve \tacexpr}. Internally it saves an auxiliary lemma called
 {\ident}\texttt{\_subproof}\textit{n} where {\ident} is the name of the
 current goal and \textit{n} is chosen so that this is a fresh name.
-Such auxiliary lemma is inlined in the final proof term
-unless the proof is ended with ``\texttt{Qed exporting}''.  In such
-case the lemma is preserved.  The syntax
-``\texttt{Qed exporting }\ident$_1$\texttt{, ..., }\ident$_n$''
-is also supported.  In such case the system checks that the names given by the
-user actually exist when the proof is ended.
+Such an auxiliary lemma is inlined in the final proof term.
 
 This tactical is useful with tactics such as \texttt{omega} or
 \texttt{discriminate} that generate huge proof terms. With that tool
@@ -1378,10 +1407,35 @@ The following two tactics behave like {\tt idtac} but enable and disable the pro
 {\tt stop ltac profiling}.
 \end{quote}
 
+\tacindex{reset ltac profile}\tacindex{show ltac profile}
+The following tactics behave like the corresponding vernacular commands and allow displaying and resetting the profile from tactic scripts for benchmarking purposes.
+
+\begin{quote}
+{\tt reset ltac profile}.
+\end{quote}
+
+\begin{quote}
+{\tt show ltac profile}.
+\end{quote}
+
+\begin{quote}
+{\tt show ltac profile} {\qstring}.
+\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.
 
+\subsection[Run-time optimization tactic]{Run-time optimization tactic\label{tactic-optimizeheap}}.
+
+The following tactic behaves like {\tt idtac}, and running it compacts the heap in the
+OCaml run-time system. It is analogous to the Vernacular command {\tt Optimize Heap} (see~\ref{vernac-optimizeheap}).
+
+\tacindex{optimize\_heap}
+\begin{quote}
+{\tt optimize\_heap}.
+\end{quote}
+
 \endinput
 
 \subsection{Permutation on closed lists}
diff --git a/doc/refman/RefMan-mod.tex b/doc/refman/RefMan-mod.tex
index e56c8fa7f..b4e270e6c 100644
--- a/doc/refman/RefMan-mod.tex
+++ b/doc/refman/RefMan-mod.tex
@@ -403,10 +403,14 @@ Fail Check B.T.
 \end{Warnings}
 
 \subsection{\tt Print Module {\ident}
-\comindex{Print Module}}
+\comindex{Print Module} \optindex{Short Module Printing}}
 
 Prints the module type and (optionally) the body of the module {\ident}.
 
+For this command and {\tt Print Module Type}, the option {\tt Short
+  Module Printing} (off by default) disables the printing of the types of fields,
+leaving only their names.
+
 \subsection{\tt Print Module Type {\ident}
 \comindex{Print Module Type}}
 
diff --git a/doc/refman/RefMan-modr.tex b/doc/refman/RefMan-modr.tex
index 2019a529f..7c672cf42 100644
--- a/doc/refman/RefMan-modr.tex
+++ b/doc/refman/RefMan-modr.tex
@@ -1,4 +1,5 @@
 \chapter[The Module System]{The Module System\label{chapter:Modules}}
+%HEVEA\cutname{modules.html}
 
 The module system extends the Calculus of Inductive Constructions
 providing a convenient way to structure large developments as well as
diff --git a/doc/refman/RefMan-oth.tex b/doc/refman/RefMan-oth.tex
index 8f43ebcfb..1cd23c929 100644
--- a/doc/refman/RefMan-oth.tex
+++ b/doc/refman/RefMan-oth.tex
@@ -1,5 +1,6 @@
 \chapter[Vernacular commands]{Vernacular commands\label{Vernacular-commands}
 \label{Other-commands}}
+%HEVEA\cutname{vernacular.html}
 
 \section{Displaying}
 
@@ -9,6 +10,8 @@ defined object referred by {\qualid}.
 
 \begin{ErrMsgs}
 \item {\qualid} \errindex{not a defined object}
+\item \errindex{Universe instance should have length} $n$.
+\item \errindex{This object does not support universe names.}
 \end{ErrMsgs}
 
 \begin{Variants}
@@ -26,6 +29,11 @@ constructor, abbreviation, \ldots), long name, type, implicit
 arguments and argument scopes. It does not print the body of
 definitions or proofs.
 
+\item {\tt Print {\qualid}@\{names\}.}\\
+This locally renames the polymorphic universes of {\qualid}.
+An underscore means the raw universe is printed.
+This form can be used with {\tt Print Term} and {\tt About}.
+
 %\item {\tt Print Proof {\qualid}.}\comindex{Print Proof}\\
 %In case \qualid\ denotes an opaque theorem defined in a section,
 %it is stored on a special unprintable form and displayed as 
@@ -904,6 +912,15 @@ This command turns off the use of a default timeout.
 
 This command displays whether some default timeout has be set or not.
 
+\subsection[\tt Fail \textrm{\textsl{command-or-tactic}}.]{\tt Fail \textrm{\textsl{command-or-tactic}}.\comindex{Fail}\label{Fail}}
+
+For debugging {\Coq} scripts, sometimes it is desirable to know
+whether a command or a tactic fails. If the given command or tactic
+fails, the {\tt Fail} statement succeeds, without changing the proof
+state, and in interactive mode, {\Coq} prints a message confirming the failure.
+If the command or tactic succeeds, the statement is an error, and
+{\Coq} prints a message indicating that the failure did not occur.
+
 \section{Controlling display}
 
 \subsection[\tt Set Silent.]{\tt Set Silent.\optindex{Silent}
diff --git a/doc/refman/RefMan-pre.tex b/doc/refman/RefMan-pre.tex
index 0c2a18eb2..05775bfbe 100644
--- a/doc/refman/RefMan-pre.tex
+++ b/doc/refman/RefMan-pre.tex
@@ -2,6 +2,7 @@
 \setheaders{Credits}
 %END LATEX
 \chapter*{Credits}
+%HEVEA\cutname{credits.html}
 %\addcontentsline{toc}{section}{Credits}
 
 \Coq{}~ is a proof assistant for higher-order logic, allowing the
@@ -498,7 +499,7 @@ Claude Marché coordinated the edition of the Reference Manual for
 Pierre Letouzey and Jacek Chrz\k{a}szcz respectively maintained the
 extraction tool and module system of {\Coq}.
 
-Jean-Christophe Filliâtre, Pierre Letouzey, Hugo Herbelin ando
+Jean-Christophe Filliâtre, Pierre Letouzey, Hugo Herbelin and other
 contributors from Sophia-Antipolis and Nijmegen participated to the
 extension of the library.
 
@@ -658,7 +659,7 @@ Matthieu Sozeau extended the \textsc{Russell} language, ending in an
 convenient way to write programs of given specifications, Pierre
 Corbineau extended the Mathematical Proof Language and the
 automatization tools that accompany it, Pierre Letouzey supervised and
-extended various parts the standard library, Stéphane Glondu
+extended various parts of the standard library, Stéphane Glondu
 contributed a few tactics and improvements, Jean-Marc Notin provided
 help in debugging, general maintenance and {\tt coqdoc} support,
 Vincent Siles contributed extensions of the {\tt Scheme} command and
@@ -679,7 +680,7 @@ Nicolas Tabareau made the adaptation of the interface of the old
 the interaction between Coq and its external interfaces. With Samuel
 Mimram, he also helped making Coq compatible with recent software
 tools.  Russell O'Connor, Cezary Kaliscyk, Milad Niqui contributed to
-improved the libraries of integers, rational, and real numbers. We
+improve the libraries of integers, rational, and real numbers. We
 also thank many users and partners for suggestions and feedback, in
 particular Pierre Castéran and Arthur Charguéraud, the INRIA Marelle
 team, Georges Gonthier and the INRIA-Microsoft Mathematical Components team, 
@@ -713,7 +714,7 @@ implementation of $\mathbb{N}$, $\mathbb{Z}$ or
 $\mathbb{Z}/n\mathbb{Z}$. 
 
 The main other evolutions of the library are due to Hugo Herbelin who
-made a revision of the sorting library (includingh a certified
+made a revision of the sorting library (including a certified
 merge-sort) and to Guillaume Melquiond who slightly revised and
 cleaned up the library of reals.
 
@@ -722,7 +723,7 @@ some efficiency issues and a more flexible construction of module
 types, Élie Soubiran brought a new model of name equivalence, the
 $\Delta$-equivalence, which respects as much as possible the names
 given by the users. He also designed with Pierre Letouzey a new
-convenient operator \verb!<+! for nesting functor application, what
+convenient operator \verb!<+! for nesting functor application, that
 provides a light notation for inheriting the properties of cascading
 modules.
 
diff --git a/doc/refman/RefMan-pro.tex b/doc/refman/RefMan-pro.tex
index eb59ca584..6b24fdde7 100644
--- a/doc/refman/RefMan-pro.tex
+++ b/doc/refman/RefMan-pro.tex
@@ -1,5 +1,6 @@
 \chapter[Proof handling]{Proof handling\index{Proof editing}
 \label{Proof-handling}}
+%HEVEA\cutname{proof-handling.html}
 
 In \Coq's proof editing mode all top-level commands documented in 
 Chapter~\ref{Vernacular-commands} remain available
@@ -319,10 +320,19 @@ Note that when a focused goal is proved a message is displayed
 together with a suggestion about the right bullet or {\tt \}} to
 unfocus it or focus the next one.
 
+\begin{Variants}
+
+\item {\tt {\num}: \{}\\
+This focuses on the $\num^{th}$ subgoal to prove.
+
+\end{Variants}
+
 \begin{ErrMsgs}
 \item \errindex{This proof is focused, but cannot be unfocused
     this way} You are trying to use {\tt \}} but the current subproof
   has not been fully solved.
+\item \errindex{No such goal}
+\item \errindex{Brackets only support the single numbered goal selector}
 \item see also error message about bullets below.
 \end{ErrMsgs}
 
@@ -394,6 +404,8 @@ Proof.
 
 \end{ErrMsgs}
 
+\subsection[\tt Set Bullet Behavior.]{\tt Set Bullet Behavior.\optindex{Bullet Behavior}}
+
 The bullet behavior can be controlled by the following commands.
 
 \begin{quote}
@@ -552,12 +564,12 @@ used to force Coq to optimize some of its internal data structures.
 This command forces Coq to shrink the data structure used to represent
 the ongoing proof.
 
-\subsection[\tt Optimize Heap.]{\tt Optimize Heap.}
+\subsection[\tt Optimize Heap.]{\tt Optimize Heap.\label{vernac-optimizeheap}}
 
 This command forces the OCaml runtime to perform a heap compaction.
-This is in general an expensive operation.  See:
-  \url{http://caml.inria.fr/pub/docs/manual-ocaml/libref/Gc.html#VALcompact}
-
+This is in general an expensive operation.  See: \\
+\ \url{http://caml.inria.fr/pub/docs/manual-ocaml/libref/Gc.html#VALcompact} \\
+There is also an analogous tactic {\tt optimize\_heap} (see~\ref{tactic-optimizeheap}).
 
 %%% Local Variables: 
 %%% mode: latex
diff --git a/doc/refman/RefMan-sch.tex b/doc/refman/RefMan-sch.tex
index 23a1c9b02..30724759d 100644
--- a/doc/refman/RefMan-sch.tex
+++ b/doc/refman/RefMan-sch.tex
@@ -1,4 +1,5 @@
 \chapter{Proof schemes}
+%HEVEA\cutname{schemes.html}
 
 \section{Generation of induction principles with {\tt Scheme}}
 \label{Scheme}
@@ -126,8 +127,10 @@ conclusion is {\tt (n:nat)(even n)->(Q n)}.
 \optindex{Boolean Equality Schemes}
 \optindex{Elimination Schemes}
 \optindex{Nonrecursive Elimination Schemes}
+\optindex{Record Elimination Schemes}
 \optindex{Case Analysis Schemes}
 \optindex{Decidable Equality Schemes}
+\optindex{Rewriting Schemes}
 \label{set-nonrecursive-elimination-schemes}
 }
 
@@ -141,6 +144,7 @@ and {\tt Record} (see~\ref{Record}) do not have an automatic
 declaration of the induction principles. It can be activated with the
 command {\tt Set Nonrecursive Elimination Schemes}. It can be
 deactivated again with {\tt Unset Nonrecursive Elimination Schemes}.
+{\tt Record Elimination Schemes} is a deprecated alias of {\tt Nonrecursive Elimination Schemes}.
 
 In addition, the {\tt Case Analysis Schemes} flag governs the generation of
 case analysis lemmas for inductive types, i.e. corresponding to the
@@ -155,6 +159,9 @@ However you have to be careful with this option since
 \Coq~ may now reject well-defined inductive types because it cannot compute
 a Boolean equality for them.
 
+The {\tt Rewriting Schemes} flag governs generation of equality
+related schemes such as congruence.
+
 \subsection{\tt Combined Scheme}
 \label{CombinedScheme}
 \comindex{Combined Scheme}
diff --git a/doc/refman/RefMan-ssr.tex b/doc/refman/RefMan-ssr.tex
index 61f7421c4..31dabcdd4 100644
--- a/doc/refman/RefMan-ssr.tex
+++ b/doc/refman/RefMan-ssr.tex
@@ -1,4 +1,5 @@
 \achapter{The SSReflect proof language}
+%HEVEA\cutname{ssreflect.html}
 \aauthor{Georges Gonthier, Assia Mahboubi, Enrico Tassi}
 
 \newcommand{\ssr}{{\sc SSReflect}}
@@ -42,7 +43,7 @@ Proofs written in \ssr{} typically look quite different from the
 ones written using only tactics as per Chapter~\ref{Tactics}.
 We try to summarise here the most ``visible'' ones in order to
 help the reader already accustomed to the tactics described in
-Chapter~\ref{Tactics}to read this chapter.
+Chapter~\ref{Tactics} to read this chapter.
 
 The first difference between the tactics described in this
 chapter and the tactics described in Chapter~\ref{Tactics} is the way
@@ -79,19 +80,19 @@ expansion and partial evaluation participate all to a same concept of
 rewriting a goal in a larger sense. As such, all these functionalities are
 provided by the \ssrC{rewrite} tactic.
 
-\ssrC{} includes a little language of patterns to select subterms in tactics
+\ssr{} includes a little language of patterns to select subterms in tactics
 or tacticals where it matters.  Its most notable application
 is in the \ssrC{rewrite} tactic, where patterns are used to specify
 where the rewriting step has to take place.
 
-Finally, \ssr{} supports the so-called reflection steps, typically
+Finally, \ssr{} supports so-called reflection steps, typically
 allowing to switch back and forth between the computational view and
 logical view of a concept.
 
 To conclude it is worth mentioning that \ssr{} tactics
 can be mixed with non \ssr{} tactics in the same proof,
-or in the same LTac expression.  The few exceptions
-to this statement are described in section~\label{sec:compat}.
+or in the same Ltac expression.  The few exceptions
+to this statement are described in section~\ref{sec:compat}.
 
 \iffalse
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -130,7 +131,7 @@ ProofGeneral provided in the distribution:
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 \subsection*{Acknowledgments}
-The authors would like to thank Fr\'ed\'eric Blanqui, Fran\,cois Pottier
+The authors would like to thank Frédéric Blanqui, François Pottier
 and Laurence Rideau for their comments and suggestions.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
@@ -3095,10 +3096,10 @@ the tactic \ssrC{rewrite (=~ multi1)} is equivalent to
 \end{lstlisting}
 except that the constants \ssrC{eqba, eqab, mult1_rev} have not been created.
 
-Rewriting with multirules
-is useful to implement simplification or transformation
-procedures, to be applied on terms of small to medium size. For
-instance the library \ssrL{ssrnat} provides two implementations for
+Rewriting with multirules is useful to implement simplification or
+transformation procedures, to be applied on terms of small to medium
+size. For instance, the library \ssrL{ssrnat} --- available in the
+external math-comp library --- provides two implementations for
 arithmetic operations on natural numbers: an elementary one and a tail
 recursive version, less inefficient but also less convenient for
 reasoning purposes. The library also provides one lemma per such
diff --git a/doc/refman/RefMan-syn.tex b/doc/refman/RefMan-syn.tex
index d8a353300..836753db1 100644
--- a/doc/refman/RefMan-syn.tex
+++ b/doc/refman/RefMan-syn.tex
@@ -1,26 +1,34 @@
 \chapter[Syntax extensions and interpretation scopes]{Syntax extensions and interpretation scopes\label{Addoc-syntax}}
+%HEVEA\cutname{syntax-extensions.html}
 
 In this chapter, we introduce advanced commands to modify the way
 {\Coq} parses and prints objects, i.e. the translations between the
-concrete and internal representations of terms and commands. The main
-commands are {\tt Notation} and {\tt Infix} which are described in
-section \ref{Notation}.  It also happens that the same symbolic
-notation is expected in different contexts. To achieve this form of
-overloading, {\Coq} offers a notion of interpretation scope. This is
-described in Section~\ref{scopes}.
-
-\Rem The commands {\tt Grammar}, {\tt Syntax} and {\tt Distfix} which
-were present for a while in {\Coq} are no longer available from {\Coq}
-version 8.0. The underlying AST structure is also no longer available.
-The functionalities of the command {\tt Syntactic Definition} are
-still available; see Section~\ref{Abbreviations}.
+concrete and internal representations of terms and commands.
+
+The main commands to provide custom symbolic notations for terms are
+{\tt Notation} and {\tt Infix}. They are described in Section
+\ref{Notation}. There is also a variant of {\tt Notation} which does
+not modify the parser. This provides with a form of abbreviation and
+it is described in Section~\ref{Abbreviations}. It is sometimes
+expected that the same symbolic notation has different meanings in
+different contexts. To achieve this form of overloading, {\Coq} offers
+a notion of interpretation scope. This is described in
+Section~\ref{scopes}.
+
+The main command to provide custom notations for tactics is {\tt
+  Tactic Notation}. It is described in Section~\ref{Tactic-Notation}.
+
+% No need any more to remind this
+%% \Rem The commands {\tt Grammar}, {\tt Syntax} and {\tt Distfix} which
+%% were present for a while in {\Coq} are no longer available from {\Coq}
+%% version 8.0. The underlying AST structure is also no longer available.
 
 \section[Notations]{Notations\label{Notation}
 \comindex{Notation}}
 
 \subsection{Basic notations}
 
-A {\em notation} is a symbolic abbreviation denoting some term
+A {\em notation} is a symbolic expression denoting some term
 or term pattern.
 
 A typical notation is the use of the infix symbol \verb=/\= to denote
@@ -36,7 +44,7 @@ string \verb="A /\ B"= (called a {\em notation}) tells how it is
 symbolically written.
 
 A notation is always surrounded by double quotes (except when the
-abbreviation is a single identifier; see \ref{Abbreviations}). The
+abbreviation has the form of an ordinary applicative expression; see \ref{Abbreviations}). The
 notation is composed of {\em tokens} separated by spaces.  Identifiers
 in the string (such as \texttt{A} and \texttt{B}) are the {\em
 parameters} of the notation. They must occur at least once each in the
@@ -60,7 +68,7 @@ syntactic expression (see \ref{ReservedNotation}), explicit precedences and
 associativity rules have to be given.
 
 \Rem The right-hand side of a notation is interpreted at the time the
-notation is given. In particular, implicit arguments (see
+notation is given. In particular, disambiguation of constants, implicit arguments (see
 Section~\ref{Implicit Arguments}), coercions (see
 Section~\ref{Coercions}), etc. are resolved at the time of the
 declaration of the notation.
@@ -104,8 +112,8 @@ parentheses are mandatory (this is a ``no associativity'')\footnote{
 which {\Coq} is built, namely {\camlpppp}, currently does not implement the
 no-associativity and replaces it by a left associativity; hence it is
 the same for {\Coq}: no-associativity is in fact left associativity}.
-We don't know of a special convention of the associativity of
-disjunction and conjunction, so let's apply for instance a right
+We do not know of a special convention of the associativity of
+disjunction and conjunction, so let us apply for instance a right
 associativity (which is the choice of {\Coq}).
 
 Precedence levels and associativity rules of notations have to be
@@ -141,7 +149,8 @@ Notation "x = y" := (@eq _ x y) (at level 70, no associativity).
 \end{coq_example*}
 
 One can define {\em closed} notations whose both sides are symbols. In
-this case, the default precedence level for inner subexpression is 200.
+this case, the default precedence level for inner subexpression is
+200, and the default level for the notation itself is 0.
 
 \begin{coq_eval}
 Set Printing Depth 50.
@@ -149,7 +158,7 @@ Set Printing Depth 50.
 (**** an incompatibility with the reserved notation ********)
 \end{coq_eval}
 \begin{coq_example*}
-Notation "( x , y )" := (@pair _ _ x y) (at level 0).
+Notation "( x , y )" := (@pair _ _ x y).
 \end{coq_example*}
 
 One can also define notations for binders.
@@ -160,17 +169,17 @@ Set Printing Depth 50.
 (**** an incompatibility with the reserved notation ********)
 \end{coq_eval}
 \begin{coq_example*}
-Notation "{ x : A  |  P }" := (sig A (fun x => P)) (at level 0).
+Notation "{ x : A  |  P }" := (sig A (fun x => P)).
 \end{coq_example*}
 
 In the last case though, there is a conflict with the notation for
-type casts. This last notation, as shown by the command {\tt Print Grammar
+type casts. The notation for type casts, as shown by the command {\tt Print Grammar
 constr} is at level 100. To avoid \verb=x : A= being parsed as a type cast,
 it is necessary to put {\tt x} at a level below 100, typically 99. Hence, a
-correct definition is 
+correct definition is the following.
 
 \begin{coq_example*}
-Notation "{ x : A  |  P }" := (sig A (fun x => P)) (at level 0, x at level 99).
+Notation "{ x : A  |  P }" := (sig A (fun x => P)) (x at level 99).
 \end{coq_example*}
 
 %This change has retrospectively an effect on the notation for notation
@@ -181,14 +190,17 @@ Notation "{ x : A  |  P }" := (sig A (fun x => P)) (at level 0, x at level 99).
 %Notation "{ A } + { B }" := (sumbool A B) (at level 0, A at level 99).
 %\end{coq_example*}
 
-See the next section for more about factorization.
+More generally, it is required that notations are explicitly
+factorized on the left. See the next section for more about
+factorization.
 
 \subsection{Simple factorization rules}
 
-{\Coq} extensible parsing is performed by Camlp5 which is essentially a
-LL1 parser. Hence, some care has to be taken not to hide already
-existing rules by new rules. Some simple left factorization work has
-to be done. Here is an example.
+{\Coq} extensible parsing is performed by {\camlpppp} which is
+essentially a LL1 parser: it decides which notation to parse by
+looking tokens from left to right. Hence, some care has to be taken
+not to hide already existing rules by new rules. Some simple left
+factorization work has to be done. Here is an example.
 
 \begin{coq_eval}
 (********** The next rule for notation _ < _ < _  produces **********)
@@ -241,17 +253,19 @@ on the {\Coq} printer. For example:
 Check (and True True).
 \end{coq_example}
 
-However, printing, especially pretty-printing, requires
-more care than parsing. We may want specific indentations,
-line breaks, alignment if on several lines, etc. 
+However, printing, especially pretty-printing, also requires some
+care. We may want specific indentations, line breaks, alignment if on
+several lines, etc. For pretty-printing, {\Coq} relies on {\ocaml}
+formatting library, which provides indentation and automatic line
+breaks depending on page width by means of {\em formatting boxes}.
 
-The default printing of notations is very rudimentary. For printing a
-notation, a {\em formatting box} is opened in such a way that if the
+The default printing of notations is rudimentary. For printing a
+notation, a formatting box is opened in such a way that if the
 notation and its arguments cannot fit on a single line, a line break
 is inserted before the symbols of the notation and the arguments on
 the next lines are aligned with the argument on the first line.
 
-A first, simple control that a user can have on the printing of a
+A first simple control that a user can have on the printing of a
 notation is the insertion of spaces at some places of the
 notation. This is performed by adding extra spaces between the symbols
 and parameters: each extra space (other than the single space needed
@@ -276,6 +290,13 @@ Notation "'If' c1 'then' c2 'else' c3" := (IF_then_else c1 c2 c3)
 \end{coq_example}
 \end{small}
 
+\begin{coq_example}
+Check
+ (IF_then_else (IF_then_else True False True)
+   (IF_then_else True False True)
+   (IF_then_else True False True)).
+\end{coq_example}
+
 A {\em format} is an extension of the string denoting the notation with
 the possible following elements delimited by single quotes:
 
@@ -312,22 +333,15 @@ Notations do not survive the end of sections. No typing of the denoted
 expression is performed at definition time. Type-checking is done only
 at the time of use of the notation.
 
-\begin{coq_example}
-Check 
- (IF_then_else (IF_then_else True False True) 
-   (IF_then_else True False True)
-   (IF_then_else True False True)).   
-\end{coq_example}
-
 \Rem
 Sometimes, a notation is expected only for the parser.
 %(e.g. because
 %the underlying parser of {\Coq}, namely {\camlpppp}, is LL1 and some extra
 %rules are needed to circumvent the absence of factorization).
-To do so, the option {\em only parsing} is allowed in the list of modifiers of
+To do so, the option {\tt only parsing} is allowed in the list of modifiers of
 \texttt{Notation}.
 
-Conversely, the {\em only printing} can be used to declare
+Conversely, the {\tt 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.
 
@@ -338,16 +352,16 @@ The \texttt{Infix} command is a shortening for declaring notations of
 infix symbols. Its syntax is 
 
 \begin{quote}
-\noindent\texttt{Infix "{\symbolentry}" :=} {\qualid} {\tt (} \nelist{\em modifier}{,} {\tt )}.
+\noindent\texttt{Infix "{\symbolentry}" :=} {\term} {\tt (} \nelist{\em modifier}{,} {\tt )}.
 \end{quote}
 
 and it is equivalent to
 
 \begin{quote}
-\noindent\texttt{Notation "x {\symbolentry} y" := ({\qualid} x y)  (} \nelist{\em modifier}{,} {\tt )}.
+\noindent\texttt{Notation "x {\symbolentry} y" := ({\term} x y)  (} \nelist{\em modifier}{,} {\tt )}.
 \end{quote}
 
-where {\tt x} and {\tt y} are fresh names distinct from {\qualid}. Here is an example.
+where {\tt x} and {\tt y} are fresh names. Here is an example.
 
 \begin{coq_example*}
 Infix "/\" := and (at level 80, right associativity).
@@ -379,12 +393,14 @@ reserved. Hence their precedence and associativity cannot be changed.
 \comindex{CoFixpoint {\ldots} where {\ldots}}
 \comindex{Inductive {\ldots} where {\ldots}}}
 
-Thanks to reserved notations, the inductive, co-inductive, recursive
-and corecursive definitions can benefit of customized notations. To do
-this, insert a {\tt where} notation clause after the definition of the
-(co)inductive type or (co)recursive term (or after the definition of
-each of them in case of mutual definitions). The exact syntax is given
-on Figure~\ref{notation-syntax}. Here are examples:
+Thanks to reserved notations, the inductive, co-inductive, record,
+recursive and corecursive definitions can benefit of customized
+notations. To do this, insert a {\tt where} notation clause after the
+definition of the (co)inductive type or (co)recursive term (or after
+the definition of each of them in case of mutual definitions). The
+exact syntax is given on Figure~\ref{notation-syntax} for inductive,
+co-inductive, recursive and corecursive definitions and on
+Figure~\ref{record-syntax} for records. Here are examples:
 
 \begin{coq_eval}
 Set Printing Depth 50.
@@ -478,20 +494,28 @@ Locate "exists _ .. _ , _".
 \\
 \\
 {\modifiers}
-  & ::= & \nelist{\ident}{,} {\tt at level} {\naturalnumber} \\
-  & $|$ & \nelist{\ident}{,} {\tt at next level} \\
-  & $|$ & {\tt at level} {\naturalnumber} \\
-  & $|$ & {\tt left associativity} \\
-  & $|$ & {\tt right associativity} \\
-  & $|$ & {\tt no associativity} \\
+  & ::= & {\tt at level} {\naturalnumber} \\
+  & $|$ & \nelist{\ident}{,} {\tt at level} {\naturalnumber} \zeroone{\binderinterp}\\
+  & $|$ & \nelist{\ident}{,} {\tt at next level} \zeroone{\binderinterp}\\
+  & $|$ & {\ident} {\binderinterp} \\
   & $|$ & {\ident} {\tt ident} \\
-  & $|$ & {\ident} {\tt binder} \\
-  & $|$ & {\ident} {\tt closed binder} \\
   & $|$ & {\ident} {\tt global} \\
   & $|$ & {\ident} {\tt bigint} \\
+  & $|$ & {\ident} \zeroone{{\tt strict}} {\tt pattern} \zeroone{{\tt at level} {\naturalnumber}}\\
+  & $|$ & {\ident} {\tt binder} \\
+  & $|$ & {\ident} {\tt closed binder} \\
+  & $|$ & {\tt left associativity} \\
+  & $|$ & {\tt right associativity} \\
+  & $|$ & {\tt no associativity} \\
   & $|$ & {\tt only parsing} \\
   & $|$ & {\tt only printing} \\
-  & $|$ & {\tt format} {\str} 
+  & $|$ & {\tt format} {\str} \\
+\\
+\\
+{\binderinterp}
+  & ::= & {\tt as ident} \\
+  & $|$ & {\tt as pattern} \\
+  & $|$ & {\tt as strict pattern} \\
 \end{tabular}
 \end{centerframe}
 \end{small}
@@ -499,9 +523,93 @@ Locate "exists _ .. _ , _".
 \label{notation-syntax}
 \end{figure}
 
-\subsection{Notations and simple binders}
+\subsection{Notations and binders}
+
+Notations can include binders. This section lists
+different ways to deal with binders. For further examples, see also
+Section~\ref{RecursiveNotationsWithBinders}.
+
+\subsubsection{Binders bound in the notation and parsed as identifiers}
 
-Notations can be defined for binders as in the example:
+Here is the basic example of a notation using a binder:
+
+\begin{coq_example*}
+Notation "'sigma' x : A , B" := (sigT (fun x : A => B))
+  (at level 200, x ident, A at level 200, right associativity).
+\end{coq_example*}
+
+The binding variables in the right-hand side that occur as a parameter
+of the notation (here {\tt x}) dynamically bind all the occurrences
+in their respective binding scope after instantiation of the
+parameters of the notation. This means that the term bound to {\tt B} can
+refer to the variable name bound to {\tt x} as shown in the following
+application of the notation:
+
+\begin{coq_example}
+Check sigma z : nat, z = 0.
+\end{coq_example}
+
+Notice the modifier {\tt x ident} in the declaration of the
+notation. It tells to parse {\tt x} as a single identifier.
+
+\subsubsection{Binders bound in the notation and parsed as patterns}
+
+In the same way as patterns can be used as binders, as in {\tt fun
+  '(x,y) => x+y} or {\tt fun '(existT \_ x \_) => x}, notations can be
+defined so that any pattern (in the sense of the entry {\pattern} of
+Figure~\ref{term-syntax-aux}) can be used in place of the
+binder. Here is an example:
+
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
+
+\begin{coq_example*}
+Notation "'subset' ' p , P " := (sig (fun p => P))
+  (at level 200, p pattern, format "'subset'  ' p ,  P").
+\end{coq_example*}
+
+\begin{coq_example}
+Check subset '(x,y), x+y=0.
+\end{coq_example}
+
+The modifier {\tt p pattern} in the declaration of the notation
+tells to parse $p$ as a pattern. Note that a single
+variable is both an identifier and a pattern, so, e.g., the following
+also works:
+
+% Note: we rely on the notation of the standard library which does not
+% print the expected output, so we hide the output.
+\begin{coq_example}
+Check subset 'x, x=0.
+\end{coq_example}
+
+If one wants to prevent such a notation to be used for printing when the
+pattern is reduced to a single identifier, one has to use instead
+the modifier {\tt p strict pattern}. For parsing, however, a {\tt
+  strict pattern} will continue to include the case of a
+variable. Here is an example showing the difference:
+
+\begin{coq_example*}
+Notation "'subset_bis' ' p , P" := (sig (fun p => P))
+  (at level 200, p strict pattern).
+Notation "'subset_bis' p , P " := (sig (fun p => P))
+  (at level 200, p ident).
+\end{coq_example*}
+
+\begin{coq_example}
+Check subset_bis 'x, x=0.
+\end{coq_example}
+
+The default level for a {\tt pattern} is 0. One can use a different level by
+using {\tt pattern at level} $n$ where the scale is the same as the one for
+terms (Figure~\ref{init-notations}).
+
+\subsubsection{Binders bound in the notation and parsed as terms}
+
+Sometimes, for the sake of factorization of rules, a binder has to be
+parsed as a term. This is typically the case for a notation such as
+the following:
 
 \begin{coq_eval}
 Set Printing Depth 50.
@@ -509,18 +617,53 @@ Set Printing Depth 50.
 (**** an incompatibility with the reserved notation ********)
 \end{coq_eval}
 \begin{coq_example*}
-Notation "{ x : A  |  P  }" := (sig (fun x : A => P)) (at level 0).
+Notation "{ x : A  |  P  }" := (sig (fun x : A => P))
+  (at level 0, x at level 99 as ident).
+\end{coq_example*}
+
+This is so because the grammar also contains rules starting with
+{\tt \{} and followed by a term, such as the rule for the notation
+  {\tt \{ A \} + \{ B \}} for the constant {\tt
+    sumbool}~(see Section~\ref{sumbool}).
+
+Then, in the rule, {\tt x ident} is replaced by {\tt x at level 99 as
+  ident} meaning that {\tt x} is parsed as a term at level 99 (as done
+in the notation for {\tt sumbool}), but that this term has actually to
+be an identifier.
+
+The notation {\tt \{ x | P \}} is already defined in the standard
+library with the {\tt as ident} modifier. We cannot redefine it but
+one can define an alternative notation, say {\tt \{ p such that P }\},
+using instead {\tt as pattern}.
+
+% Note, this conflicts with the default rule in the standard library, so
+% we don't show the
+\begin{coq_example*}
+Notation "{ p 'such' 'that' P }" := (sig (fun p => P))
+  (at level 0, p at level 99 as pattern).
 \end{coq_example*}
 
-The binding variables in the left-hand-side that occur as a parameter
-of the notation naturally bind all their occurrences appearing in
-their respective scope after instantiation of the parameters of the
-notation.
+Then, the following works:
+\begin{coq_example}
+Check {(x,y) such that x+y=0}.
+\end{coq_example}
+
+To enforce that the pattern should not be used for printing when it
+is just an identifier, one could have said {\tt p at level
+  99 as strict pattern}.
+
+Note also that in the absence of a {\tt as ident}, {\tt as strict
+  pattern} or {\tt as pattern} modifiers, the default is to consider
+subexpressions occurring in binding position and parsed as terms to be
+{\tt as ident}.
+
+\subsubsection{Binders not bound in the notation}
+\label{NotationsWithBinders}
 
-Contrastingly, the binding variables that are not a parameter of the
-notation do not capture the variables of same name that
-could appear in their scope after instantiation of the
-notation. E.g., for the notation
+We can also have binders in the right-hand side of a notation which
+are not themselves bound in the notation. In this case, the binders
+are considered up to renaming of the internal binder. E.g., for the
+notation
 
 \begin{coq_example*}
 Notation "'exists_different' n" := (exists p:nat, p<>n) (at level 200).
@@ -536,14 +679,6 @@ Set Printing Depth 50.
 Fail Check (exists_different p).
 \end{coq_example}
 
-\Rem Binding variables must not necessarily be parsed using the
-{\tt ident} entry. For factorization purposes, they can be said to be
-parsed at another level (e.g. {\tt x} in \verb="{ x : A | P }"= must be
-parsed at level 99 to be factorized with the notation
-\verb="{ A } + { B }"= for which {\tt A} can be any term).  
-However, even if parsed as a term, this term must at the end be effectively 
-a single identifier.
-
 \subsection{Notations with recursive patterns}
 \label{RecursiveNotations}
 
@@ -564,24 +699,22 @@ notation parses any number of time (but at least one time) a sequence
 of expressions separated by the sequence of tokens $s$ (in the
 example, $s$ is just ``{\tt ;}'').
 
-In the right-hand side, the term enclosed within {\tt ..} must be a
-pattern with two holes of the form $\phi([~]_E,[~]_I)$ where the first
-hole is occupied either by $x$ or by $y$ and the second hole is
-occupied by an arbitrary term $t$ called the {\it terminating}
-expression of the recursive notation. The subterm {\tt ..} $\phi(x,t)$
-{\tt ..} (or {\tt ..} $\phi(y,t)$ {\tt ..})  must itself occur at
-second position of the same pattern where the first hole is occupied
-by the other variable, $y$ or $x$. Otherwise said, the right-hand side
-must contain a subterm of the form either $\phi(x,${\tt ..}
-$\phi(y,t)$ {\tt ..}$)$ or $\phi(y,${\tt ..}  $\phi(x,t)$ {\tt ..}$)$.
-The pattern $\phi$ is the {\em iterator} of the recursive notation
-and, of course, the name $x$ and $y$ can be chosen arbitrarily.
-
-The parsing phase produces a list of expressions which are used to
-fill in order the first hole of the iterating pattern which is
+The right-hand side must contain a subterm of the form either
+$\phi(x,${\tt ..}  $\phi(y,t)$ {\tt ..}$)$ or $\phi(y,${\tt ..}
+$\phi(x,t)$ {\tt ..}$)$ where $\phi([~]_E,[~]_I)$, called the {\em
+  iterator} of the recursive notation is an arbitrary expression with
+distinguished placeholders and
+where $t$ is called the {\tt terminating expression} of the recursive
+notation. In the example, we choose the name s$x$ and $y$ but in
+practice they can of course be chosen arbitrarily. Note that the
+placeholder $[~]_I$ has to occur only once but the $[~]_E$ can occur
+several times.
+
+Parsing the notation produces a list of expressions which are used to
+fill the first placeholder of the iterating pattern which itself is
 repeatedly nested as many times as the length of the list, the second
-hole being the nesting point. In the innermost occurrence of the
-nested iterating pattern, the second hole is finally filled with the
+placeholder being the nesting point. In the innermost occurrence of the
+nested iterating pattern, the second placeholder is finally filled with the
 terminating expression.
 
 In the example above, the iterator $\phi([~]_E,[~]_I)$ is {\tt cons
@@ -608,24 +741,26 @@ notations, they can also be declared within interpretation scopes (see
 section \ref{scopes}).
 
 \subsection{Notations with recursive patterns involving binders}
+\label{RecursiveNotationsWithBinders}
 
 Recursive notations can also be used with binders. The basic example is:
 
 \begin{coq_example*}
-Notation "'exists' x .. y , p" := (ex (fun x => .. (ex (fun y => p)) ..))
+Notation "'exists' x .. y , p" :=
+  (ex (fun x => .. (ex (fun y => p)) ..))
   (at level 200, x binder, y binder, right associativity).
 \end{coq_example*}
 
 The principle is the same as in Section~\ref{RecursiveNotations}
-except that in the iterator $\phi([~]_E,[~]_I)$, the first hole is a
-placeholder occurring at the position of the binding variable of a {\tt
+except that in the iterator $\phi([~]_E,[~]_I)$, the placeholder $[~]_E$ can
+also occur in position of the binding variable of a {\tt
   fun} or a {\tt forall}.
 
 To specify that the part ``$x$ {\tt ..} $y$'' of the notation
 parses a sequence of binders, $x$ and $y$ must be marked as {\tt
-  binder} in the list of modifiers of the notation.  Then, the list of
-binders produced at the parsing phase are used to fill in the first
-hole of the iterating pattern which is repeatedly nested as many times
+  binder} in the list of modifiers of the notation. The
+binders of the parsed sequence are used to fill the occurrences of the first
+placeholder of the iterating pattern which is repeatedly nested as many times
 as the number of binders generated. If ever the generalization
 operator {\tt `} (see Section~\ref{implicit-generalization}) is used
 in the binding list, the added binders are taken into account too.
@@ -634,14 +769,14 @@ Binders parsing exist in two flavors. If $x$ and $y$ are marked as
 {\tt binder}, then a sequence such as {\tt a b c : T} will be accepted
 and interpreted as the sequence of binders {\tt (a:T) (b:T)
   (c:T)}. For instance, in the notation above, the syntax {\tt exists
-  a b : nat, a = b} is provided.
+  a b : nat, a = b} is valid.
 
 The variables $x$ and $y$ can also be marked as {\tt closed binder} in
 which case only well-bracketed binders of the form {\tt (a b c:T)} or
 {\tt \{a b c:T\}} etc. are accepted.
 
 With closed binders, the recursive sequence in the left-hand side can
-be of the general form $x$ $s$ {\tt ..} $s$ $y$ where $s$ is an
+be of the more general form $x$ $s$ {\tt ..} $s$ $y$ where $s$ is an
 arbitrary sequence of tokens. With open binders though, $s$ has to be
 empty. Here is an example of recursive notation with closed binders:
 
@@ -660,6 +795,40 @@ Notation "'FUNAPP' x .. y , f" :=
   (at level 200, x binder, y binder, right associativity).
 \end{coq_example*}
 
+If an occurrence of the $[~]_E$ is not in position of a binding
+variable but of a term, it is the name used in the binding which is
+used. Here is an example:
+
+\begin{coq_example*}
+Notation "'exists_non_null' x .. y  , P" :=
+  (ex (fun x => x <> 0 /\ .. (ex (fun y => y <> 0 /\ P)) ..))
+  (at level 200, x binder).
+\end{coq_example*}
+
+\subsection{Predefined entries}
+
+By default, sub-expressions are parsed as terms and the corresponding
+grammar entry is called {\tt constr}. However, one may sometimes want
+to restrict the syntax of terms in a notation. For instance, the
+following notation will accept to parse only global reference in
+position of {\tt x}:
+
+\begin{coq_example*}
+Notation "'apply' f a1 .. an" := (.. (f a1) .. an)
+  (at level 10, f global, a1, an at level 9).
+\end{coq_example*}
+
+In addition to {\tt global}, one can restrict the syntax of a
+sub-expression by using the entry names {\tt ident} or {\tt pattern}
+already seen in Section~\ref{NotationsWithBinders}, even when the
+corresponding expression is not used as a binder in the right-hand
+side. E.g.:
+
+\begin{coq_example*}
+Notation "'apply_id' f a1 .. an" := (.. (f a1) .. an)
+  (at level 10, f ident, a1, an at level 9).
+\end{coq_example*}
+
 \subsection{Summary}
 
 \paragraph{Syntax of notations}
@@ -753,7 +922,7 @@ stack by using the command
 {\tt Close Scope} {\scope}.
 \end{quote}
 Notice that this command does not only cancel the last {\tt Open Scope
-{\scope}} but all the invocation of it.
+{\scope}} but all the invocations of it.
 
 \Rem {\tt Open Scope} and {\tt Close Scope} do not survive the end of
 sections where they occur. When defined outside of a section, they are
@@ -852,6 +1021,14 @@ Arguments scopes can be cleared with the following command:
 {\tt Arguments {\qualid} : clear scopes}
 \end{quote}
 
+Extra argument scopes, to be used in case of coercion to Funclass
+(see Chapter~\ref{Coercions-full}) or with a computed type,
+can be given with
+
+\begin{quote}
+{\tt Arguments} {\qualid} \nelist{\textunderscore {\tt \%} \scope}{} {\tt : extra scopes.}
+\end{quote}
+
 \begin{Variants}
 \item {\tt Global Arguments} {\qualid} \nelist{\name {\tt \%}\scope}{}
 
@@ -1107,7 +1284,7 @@ Check reflexive iff.
 \end{coq_example}
 
 An abbreviation expects no precedence nor associativity, since it
-follows the usual syntax of application. Abbreviations are used as
+is parsed as usual application. Abbreviations are used as
 much as possible by the {\Coq} printers unless the modifier
 \verb=(only parsing)= is given.
 
@@ -1120,7 +1297,7 @@ abbreviation but at the time it is used. Especially, abbreviations can
 be bound to terms with holes (i.e. with ``\_''). The general syntax
 for abbreviations is
 \begin{quote}
-\zeroone{{\tt Local}} \texttt{Notation} {\ident} \sequence{\ident} {\ident} \texttt{:=} {\term} 
+\zeroone{{\tt Local}} \texttt{Notation} {\ident} \sequence{\ident}{} \texttt{:=} {\term}
  \zeroone{{\tt (only parsing)}}~\verb=.=
 \end{quote}
 
@@ -1146,13 +1323,15 @@ at the time of use of the abbreviation.
 %\verb=(only parsing)= is given) while syntactic definitions were not.
 
 \section{Tactic Notations
+\label{Tactic-Notation}
 \comindex{Tactic Notation}}
 
 Tactic notations allow to customize the syntax of the tactics of the
-tactic language\footnote{Tactic notations are just a simplification of
-the {\tt Grammar tactic simple\_tactic} command that existed in
-versions prior to version 8.0.}. Tactic notations obey the following
-syntax
+tactic language.
+%% \footnote{Tactic notations are just a simplification of
+%% the {\tt Grammar tactic simple\_tactic} command that existed in
+%% versions prior to version 8.0.}
+Tactic notations obey the following syntax:
 \medskip
 
 \noindent
@@ -1195,7 +1374,9 @@ level indicates the parsing precedence of the tactic notation. This
 information is particularly relevant for notations of tacticals.
 Levels 0 to 5 are available (default is 0). 
 To know the parsing precedences of the
-existing tacticals, use the command {\tt Print Grammar tactic.}
+existing tacticals, use the command
+\comindex{Print Grammar tactic}
+ {\tt Print Grammar tactic.}
 
 Each type of tactic argument has a specific semantic regarding how it
 is parsed and how it is interpreted. The semantic is described in the
diff --git a/doc/refman/RefMan-tac.tex b/doc/refman/RefMan-tac.tex
index 6e2735700..66a5f107a 100644
--- a/doc/refman/RefMan-tac.tex
+++ b/doc/refman/RefMan-tac.tex
@@ -3,6 +3,7 @@
 \chapter{Tactics
 \index{Tactics}
 \label{Tactics}}
+%HEVEA\cutname{tactics.html}
 
 A deduction rule is a link between some (unique) formula, that we call
 the {\em conclusion} and (several) formulas that we call the {\em
@@ -3309,7 +3310,7 @@ evaluating purely computational expressions (i.e. with little dead code).
   fine-tuned. It is specially interesting for full evaluation of algebraic
   objects. This includes the case of reflection-based tactics.
 
-\item {\tt native\_compute} \tacindex{native\_compute}
+\item {\tt native\_compute} \tacindex{native\_compute} \optindex{NativeCompute Profiling}
 
   This tactic evaluates the goal by compilation to \ocaml{} as described in
   \cite{FullReduction}. If \Coq{} is running in native code, it can be typically
@@ -3333,6 +3334,14 @@ evaluating purely computational expressions (i.e. with little dead code).
 
 \end{Variants}
 
+\Rem The following option makes {\tt cbv} (and its derivative {\tt
+  compute}) print information about the constants it encounters and
+the unfolding decisions it makes.
+\begin{quote}
+  \optindex{Debug Cbv}
+  {\tt Set Debug Cbv}
+\end{quote}
+
 % Obsolete? Anyway not very important message
 %\begin{ErrMsgs}
 %\item \errindex{Delta must be specified before}
@@ -3506,6 +3515,13 @@ 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.
 
+\begin{quote}
+  \optindex{Debug RAKAM}
+  {\tt Set Debug RAKAM}
+\end{quote}
+This option makes {\tt cbn} print various debugging information.
+{\tt RAKAM} is the Refolding Algebraic Krivine Abstract Machine.
+
 \subsection{\tt unfold \qualid}
 \tacindex{unfold}
 \label{unfold}
@@ -3522,8 +3538,13 @@ with its $\beta\iota$-normal form.
 \end{ErrMsgs}
 
 \begin{Variants}
+\item {\tt unfold {\qualid} in {\ident}}
+  \tacindex{unfold \dots in}
+
+  Replaces {\qualid} in hypothesis {\ident} with its definition
+  and replaces the hypothesis with its $\beta\iota$ normal form.
+
 \item {\tt unfold {\qualid}$_1$, \dots, \qualid$_n$}
-  \tacindex{unfold \dots\ in}
 
   Replaces {\em simultaneously} {\qualid}$_1$, \dots, {\qualid}$_n$
   with their definitions and replaces the current goal with its
@@ -3697,6 +3718,9 @@ hints of the database named {\tt core}.
   This variant is very useful for getting a better understanding of automation,
   or to know what lemmas/assumptions were used.
 
+\item {\tt debug auto} Behaves like {\tt auto} but shows the tactics
+  it tries to solve the goal, including failing paths.
+
 \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$}
@@ -3717,6 +3741,8 @@ hints of the database named {\tt core}.
 
 \item {\tt info\_trivial}
 
+\item {\tt debug 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$}
@@ -3726,6 +3752,19 @@ hints of the database named {\tt core}.
 \Rem {\tt auto} either solves completely the goal or else leaves it
 intact. \texttt{auto} and \texttt{trivial} never fail.
 
+\Rem The following options enable printing of informative or debug
+information for the {\tt auto} and {\tt trivial} tactics:
+\begin{quote}
+  \optindex{Info Auto}
+  {\tt Set Info Auto}
+  \optindex{Debug Auto}
+  {\tt Set Debug Auto}
+  \optindex{Info Trivial}
+  {\tt Set Info Trivial}
+  \optindex{Debug Trivial}
+  {\tt Set Debug Trivial}
+\end{quote}
+
 \SeeAlso Section~\ref{Hints-databases}
 
 \subsection{\tt eauto}
@@ -3762,6 +3801,14 @@ Note that {\tt ex\_intro} should be declared as a hint.
 
 \end{Variants}
 
+\Rem {\tt eauto} obeys the following options:
+\begin{quote}
+  \optindex{Info Eauto}
+  {\tt Set Info Eauto}
+  \optindex{Debug Eauto}
+  {\tt Set Debug Eauto}
+\end{quote}
+
 \SeeAlso Section~\ref{Hints-databases}
 
 \subsection{\tt autounfold with \ident$_1$ \mbox{\dots} \ident$_n$}
@@ -3835,6 +3882,26 @@ this tactic.
 % En attente d'un moyen de valoriser les fichiers de demos
 %\SeeAlso file \texttt{contrib/Rocq/DEMOS/Demo\_AutoRewrite.v}
 
+\subsection{\tt easy}
+\tacindex{easy}
+\label{easy}
+
+This tactic tries to solve the current goal by a number of standard closing steps.
+In particular, it tries to close the current goal using the closing tactics
+{\tt trivial}, reflexivity, symmetry, contradiction and inversion of hypothesis.
+If this fails, it tries introducing variables and splitting and-hypotheses,
+using the closing tactics afterwards, and splitting the goal using {\tt split} and recursing.
+
+This tactic solves goals that belong to many common classes; in particular, many cases of
+unsatisfiable hypotheses, and simple equality goals are usually solved by this tactic.
+
+\begin{Variant}
+\item {\tt now \tac}
+  \tacindex{now}
+
+  Run \tac\/ followed by easy. This is a notation for {\tt \tac; easy}.
+\end{Variant}
+
 \section{Controlling automation}
 
 \subsection{The hints databases for {\tt auto} and {\tt eauto}}
@@ -4684,6 +4751,13 @@ congruence.
     described above.
 \end{ErrMsgs}
 
+\noindent {\bf Remark: } {\tt congruence} can be made to print debug
+information by setting the following option:
+
+\begin{quote}
+\optindex{Congruence Verbose}
+{\tt Set Congruence Verbose}
+\end{quote}
 
 \section{Checking properties of terms}
 
diff --git a/doc/refman/RefMan-tacex.tex b/doc/refman/RefMan-tacex.tex
index cb8f916f1..7cdb1a527 100644
--- a/doc/refman/RefMan-tacex.tex
+++ b/doc/refman/RefMan-tacex.tex
@@ -1,4 +1,5 @@
 \chapter[Detailed examples of tactics]{Detailed examples of tactics\label{Tactics-examples}}
+%HEVEA\cutname{tactic-examples.html}
 
 This chapter presents detailed examples of certain tactics, to
 illustrate their behavior.
diff --git a/doc/refman/RefMan-tus.tex b/doc/refman/RefMan-tus.tex
deleted file mode 100644
index 7e5bb81a9..000000000
--- a/doc/refman/RefMan-tus.tex
+++ /dev/null
@@ -1,2001 +0,0 @@
-%\documentclass[11pt]{article}
-%\usepackage{fullpage,euler}
-%\usepackage[latin1]{inputenc}
-%\begin{document}
-%\title{Writing ad-hoc Tactics in Coq}
-%\author{} 
-%\date{}
-%\maketitle
-%\tableofcontents
-%\clearpage
-
-\chapter[Writing ad-hoc Tactics in Coq]{Writing ad-hoc Tactics in Coq\label{WritingTactics}}
-
-\section{Introduction}
-
-\Coq\ is an open proof environment, in the sense that the collection of
-proof strategies offered by the system can be extended by the user.
-This feature has two important advantages. First, the user can develop
-his/her own ad-hoc proof procedures, customizing the system for a
-particular domain of application. Second, the repetitive and tedious
-aspects of the proofs can be abstracted away implementing new tactics
-for dealing with them. For example, this may be useful when a theorem
-needs several lemmas which are all proven in a similar but not exactly
-the same way. Let us illustrate this with an example.
-
-Consider the problem of deciding the equality of two booleans. The
-theorem establishing that this is always possible is state by 
-the following theorem:
-
-\begin{coq_example*}
-Theorem decideBool : (x,y:bool){x=y}+{~x=y}.
-\end{coq_example*}
-
-The proof proceeds by case analysis on both $x$ and $y$. This yields
-four cases to solve. The cases $x=y=\textsl{true}$ and
-$x=y=\textsl{false}$ are immediate by the reflexivity of equality.
-
-The other two cases follow by discrimination. The following script
-describes the proof:
-
-\begin{coq_example*}
-Destruct x.
-  Destruct y.
-    Left ; Reflexivity.
-    Right; Discriminate.
-  Destruct y.
-    Right; Discriminate.
-    Left ; Reflexivity.
-\end{coq_example*}
-\begin{coq_eval}
-Abort.
-\end{coq_eval}
-
-Now, consider the theorem stating the same property but for the
-following enumerated type:
-
-\begin{coq_example*}
-Inductive Set Color := Blue:Color | White:Color | Red:Color.
-Theorem decideColor : (c1,c2:Color){c1=c2}+{~c1=c2}.
-\end{coq_example*}
-
-This theorem can be proven in a very similar way, reasoning by case
-analysis on $c_1$ and $c_2$. Once more, each of the (now six) cases is
-solved either by reflexivity or by discrimination:
-
-\begin{coq_example*}
-Destruct c1. 
-  Destruct c2.
-    Left  ; Reflexivity.
-    Right ; Discriminate.
-    Right ; Discriminate.
-  Destruct c2.  
-    Right ; Discriminate.
-    Left  ; Reflexivity.
-    Right ; Discriminate.
-  Destruct c2.  
-    Right ; Discriminate.
-    Right ; Discriminate.
-    Left  ; Reflexivity.
-\end{coq_example*}
-\begin{coq_eval}
-Abort.
-\end{coq_eval}
-
-If we face the same theorem for an enumerated datatype corresponding
-to the days of the week, it would still follow a similar pattern. In
-general, the general pattern for proving the property
-$(x,y:R)\{x=y\}+\{\neg x =y\}$ for an enumerated type $R$ proceeds as
-follow:
-\begin{enumerate}
-\item Analyze the cases for $x$. 
-\item For each of the sub-goals generated by the first step, analyze
-the cases for $y$.
-\item The remaining subgoals follow either by reflexivity or
-by discrimination.
-\end{enumerate}
-
-Let us describe how this general proof procedure can be introduced in
-\Coq.
-
-\section{Tactic Macros}
-
-The simplest way to introduce it is to define it as new a
-\textsl{tactic macro}, as follows:
-
-\begin{coq_example*}
-Tactic Definition DecideEq [$a $b] := 
-   [<:tactic:<Destruct $a;
-              Destruct $b;
-              (Left;Reflexivity) Orelse (Right;Discriminate)>>].
-\end{coq_example*}
-
-The general pattern of the proof is abstracted away using the
-tacticals ``\texttt{;}'' and \texttt{Orelse}, and introducing two
-parameters for the names of the arguments to be analyzed.
-
-Once defined, this tactic can be called like any other tactic, just
-supplying the list of terms corresponding to its real arguments. Let us
-revisit the proof of the former theorems using the new tactic
-\texttt{DecideEq}:
-
-\begin{coq_example*}
-Theorem decideBool : (x,y:bool){x=y}+{~x=y}.
-DecideEq x y.
-Defined.
-\end{coq_example*}
-\begin{coq_example*}
-Theorem decideColor : (c1,c2:Color){c1=c2}+{~c1=c2}.
-DecideEq c1 c2.
-Defined.
-\end{coq_example*}
-
-In general, the command \texttt{Tactic Definition} associates a name
-to a parameterized tactic expression, built up from the tactics and
-tacticals that are already available. The general syntax rule for this
-command is the following:
-
-\begin{tabbing}
-\texttt{Tactic Definition} \textit{tactic-name} \= 
-\texttt{[}\$$id_1\ldots \$id_n$\texttt{]}\\
-\> := \texttt{[<:tactic:<} \textit{tactic-expression} \verb+>>]+
-\end{tabbing}
-
-This command provides a quick but also very primitive mechanism for
-introducing new tactics. It does not support recursive definitions,
-and the arguments of a tactic macro are restricted to term
-expressions.  Moreover, there is no static checking of the definition
-other than the syntactical one. Any error in the definition of the
-tactic ---for instance, a call to an undefined tactic--- will not be
-noticed until the tactic is called.
-
-%This command provides a very primitive mechanism for introducing new
-%tactics. The arguments of a tactic macro are restricted to term
-%expressions.  Hence, it is not possible to define higher order tactics
-%with this command. Also, there is no static checking of the definition
-%other than syntactical. If the tactic contain errors in its definition
-%--for instance, a call to an undefined tactic-- this will be noticed
-%during the tactic call.
-
-Let us illustrate the weakness of this way of introducing new tactics
-trying to extend our proof procedure to work on a larger class of
-inductive types.  Consider for example the decidability of equality
-for pairs of booleans and colors:
-
-\begin{coq_example*}
-Theorem decideBoolXColor : (p1,p2:bool*Color){p1=p2}+{~p1=p2}.
-\end{coq_example*}
-
-The proof still proceeds by a double case analysis, but now the
-constructors of the type take two arguments. Therefore, the sub-goals
-that can not be solved by discrimination need further considerations
-about the equality of such arguments:
-
-\begin{coq_example}
-  Destruct p1;
-    Destruct p2; Try (Right;Discriminate);Intros.
-\end{coq_example}
-
-The half of the disjunction to be chosen depends on whether or not
-$b=b_0$ and $c=c_0$. These equalities can be decided automatically
-using the previous lemmas about booleans and colors. If both
-equalities are satisfied, then it is sufficient to rewrite $b$ into
-$b_0$ and $c$ into $c_0$, so that the left half of the goal follows by
-reflexivity.  Otherwise, the right half follows by first contraposing
-the disequality, and then applying the invectiveness of the pairing
-constructor.
-
-As the cases associated to each argument of the pair are very similar,
-a tactic macro can be introduced to abstract this part of the proof:
-
-\begin{coq_example*}
-Hints Resolve decideBool decideColor.
-Tactic Definition SolveArg [$t1 $t2] := 
- [<:tactic:<
-   ElimType {$t1=$t2}+{~$t1=$t2};
-   [(Intro equality;Rewrite equality;Clear equality) |
-    (Intro diseq; Right; Red; Intro absurd;
-     Apply diseq;Injection absurd;Trivial) |
-    Auto]>>].
-\end{coq_example*}
-
-This tactic is applied to each corresponding pair of arguments of the
-arguments, until the goal can be solved by reflexivity:
-
-\begin{coq_example*}
-SolveArg b b0;
-  SolveArg c c0;
-    Left; Reflexivity.
-Defined.
-\end{coq_example*}
-
-Therefore, a more general strategy for deciding the property 
-$(x,y:R)\{x=y\}+\{\neg x =y\}$ on $R$ can be sketched as follows:
-\begin{enumerate}
-\item Eliminate $x$ and then $y$.
-\item Try discrimination to solve those goals where $x$ and $y$ has
-been introduced by different constructors.
-\item If $x$ and $y$ have been introduced by the same constructor,
-then iterate the tactic \textsl{SolveArg} for each pair of
-arguments. 
-\item Finally, solve the left half of the goal by reflexivity.
-\end{enumerate}
-
-The implementation of this stronger proof strategy needs to perform a
-term decomposition, in order to extract the list of arguments of each
-constructor. It also requires the introduction of recursively defined
-tactics, so that the \textsl{SolveArg} can be iterated on the lists of
-arguments. These features are not supported by the \texttt{Tactic
-Definition} command. One possibility could be extended this command in
-order to introduce recursion, general parameter passing,
-pattern-matching, etc, but this would quickly lead us to introduce the
-whole \ocaml{} into \Coq\footnote{This is historically true. In fact,
-\ocaml{} is a direct descendent of ML, a functional programming language
-conceived language for programming the tactics of the theorem prover
-LCF.}.  Instead of doing this, we prefer to give to the user the
-possibility of writing his/her own tactics directly in \ocaml{}, and then
-to link them dynamically with \Coq's code. This requires a minimal
-knowledge about \Coq's implementation. The next section provides an
-overview of \Coq's architecture.
-
-%It is important to point out that the introduction of a new tactic
-%never endangers the correction of the theorems proven in the extended
-%system. In order to understand why, let us introduce briefly the system
-%architecture.
-
-\section{An Overview of \Coq's Architecture}
-
-The implementation of \Coq\ is based on eight \textsl{logical
-modules}. By ``module'' we mean here a logical piece of code having a
-conceptual unity, that may concern several \ocaml{} files. By the sake of
-organization, all the \ocaml{} files concerning a logical module are
-grouped altogether into the same sub-directory. The eight modules
-are:
-
-\begin{tabular}{lll}
-1. & The logical framework           & (directory \texttt{src/generic})\\
-2. &  The language of constructions  & (directory \texttt{src/constr})\\
-3. &  The type-checker               & (directory \texttt{src/typing})\\
-4. &  The proof engine               & (directory \texttt{src/proofs})\\
-5. &  The language of basic tactics  & (directory \texttt{src/tactics})\\
-6. &  The vernacular interpreter     & (directory \texttt{src/env})\\
-7. &  The parser and the pretty-printer  & (directory \texttt{src/parsing})\\
-8. &  The standard library           & (directory \texttt{src/lib})
-\end{tabular}
-
-\vspace{1em}
-
-The following sections briefly present each of the modules above.
-This presentation is not intended to be a complete description of \Coq's
-implementation, but rather a guideline to be read before taking a look
-at the sources. For each of the modules, we also present some of its
-most important functions, which are sufficient to implement a large
-class of tactics.
-
-
-\subsection[The Logical Framework]{The Logical Framework\label{LogicalFramework}}
-
-At the very heart of \Coq there is a generic untyped language for
-expressing abstractions, applications and global constants. This
-language is used as a meta-language for expressing the terms of the
-Calculus of Inductive Constructions. General operations on terms like
-collecting the free variables of an expression, substituting a term for
-a free variable, etc, are expressed in this language.
-
-The meta-language \texttt{'op term} of terms has seven main
-constructors:
-\begin{itemize}
-\item $(\texttt{VAR}\;id)$, a reference to a global identifier called  $id$;
-\item $(\texttt{Rel}\;n)$, a bound variable, whose binder is the $nth$
-      binder up in the term;
-\item $\texttt{DLAM}\;(x,t)$, a de Bruijn's binder on the term $t$;
-\item $\texttt{DLAMV}\;(x,vt)$, a de Bruijn's binder on all the terms of
-      the vector $vt$;
-\item $(\texttt{DOP0}\;op)$, a unary operator $op$;
-\item $\texttt{DOP2}\;(op,t_1,t_2)$, the application of a binary
-operator $op$ to the terms $t_1$ and $t_2$;
-\item $\texttt{DOPN} (op,vt)$, the application of an n-ary operator $op$ to the
-vector of terms $vt$.
-\end{itemize}
-
-In this meta-language, bound variables are represented using the
-so-called de Bruijn's indexes. In this representation, an occurrence of
-a bound variable is denoted by an integer, meaning the number of
-binders that must be traversed to reach its own
-binder\footnote{Actually, $(\texttt{Rel}\;n)$ means that $(n-1)$ binders
-have to be traversed, since indexes are represented by strictly
-positive integers.}. On the other hand, constants are referred by its
-name, as usual. For example, if $A$ is a variable of the current
-section, then the lambda abstraction $[x:A]x$ of the Calculus of
-Constructions is represented in the meta-language by the term:
-
-\begin{displaymath}
-(DOP2 (Lambda,(Var\;A),DLAM (x,(Rel\;1)))
-\end{displaymath}
-
-In this term, $Lambda$ is a binary operator.  Its first argument
-correspond to the type $A$ of the bound variable, while the second is
-a body of the abstraction, where $x$ is bound.  The name $x$ is just kept
-to pretty-print the occurrences of the bound variable.
-
-%Similarly, the product
-%$(A:Prop)A$ of the Calculus of Constructions is represented by the
-%term:
-%\begin{displaumath}
-%DOP2 (Prod, DOP0 (Sort (Prop Null)), DLAM (Name \#A, Rel 1))
-%\end{displaymath}
-
-The following functions perform some of the most frequent operations
-on the terms of the meta-language:
-\begin{description}
-\fun{val Generic.subst1 : 'op term -> 'op term -> 'op term}
-    {$(\texttt{subst1}\;t_1\;t_2)$ substitutes $t_1$ for 
-      $\texttt{(Rel}\;1)$ in $t_2$.}
-\fun{val Generic.occur\_var : identifier -> 'op term -> bool}
-    {Returns true when the given identifier appears in the term,
-    and false otherwise.}
-\fun{val Generic.eq\_term : 'op term -> 'op term -> bool}
-    {Implements $\alpha$-equality for terms.}  
-\fun{val Generic.dependent : 'op term -> 'op term -> bool}
-    {Returns true if the first term is a sub-term of the second.}
-%\fun{val Generic.subst\_var : identifier -> 'op term -> 'op term}
-%    { $(\texttt{subst\_var}\;id\;t)$ substitutes the de Bruijn's index
-%     associated to $id$ to every occurrence of the term
-%    $(\texttt{VAR}\;id)$ in $t$.}
-\end{description}
-
-\subsubsection{Identifiers, names and sections paths.} 
-
-Three different kinds of names are used in the meta-language. They are
-all defined in the \ocaml{} file \texttt{Names}.
-
-\paragraph{Identifiers.}  The simplest kind of names are
-\textsl{identifiers}. An identifier is a string possibly indexed by an
-integer. They are used to represent names that are not unique, like
-for example the name of a variable in the scope of a section.  The
-following operations can be used for handling identifiers:
-
-\begin{description}
-\fun{val Names.make\_ident : string -> int -> identifier}
-    {The value $(\texttt{make\_ident}\;x\;i)$ creates the
-    identifier $x_i$. If $i=-1$, then the identifier has
-    is created with no index at all.}
-\fun{val Names.repr\_ident : identifier -> string * int}
-    {The inverse operation of \texttt{make\_ident}: 
-     it yields the string and the index of the identifier.}
-\fun{val Names.lift\_ident : identifier -> identifier}
-    {Increases the index of the identifier by one.}
-\fun{val Names.next\_ident\_away : \\
-\qquad identifier -> identifier list -> identifier}
-    {\\ Generates a new identifier with the same root string than the
-    given one, but with a new index, different from all the indexes of
-    a given list of identifiers.} 
-\fun{val Names.id\_of\_string : string ->
-    identifier} 
-    {Creates an identifier from a string.}  
-\fun{val  Names.string\_of\_id : identifier -> string} 
-    {The inverse operation: transforms an identifier into a string}
-\end{description}
-
-\paragraph{Names.} A \textsl{name} is either an identifier or the 
-special name \texttt{Anonymous}. Names are used as arguments of
-binders, in order to pretty print bound variables.
-The following operations can be used for handling names:
-
-\begin{description}
-\fun{val Names.Name: identifier -> Name}
-    {Constructs a name from  an identifier.}
-\fun{val Names.Anonymous : Name}
-    {Constructs a special, anonymous identifier, like the variable abstracted 
-     in the term $[\_:A]0$.}
-\fun{val
-     Names.next\_name\_away\_with\_default : \\ \qquad
-          string->name->identifier list->identifier}
-{\\ If the name is not anonymous, then this function generates a new
-    identifier different from all the ones in a given list. Otherwise, it
-    generates an identifier from the given string.}
-\end{description}
-
-\paragraph[Section paths.]{Section paths.\label{SectionPaths}}
-A \textsl{section-path} is a global name to refer to an object without
-ambiguity.  It can be seen as a sort of filename, where open sections
-play the role of directories. Each section path is formed by three
-components: a \textsl{directory} (the list of open sections); a
-\textsl{basename} (the identifier for the object); and a \textsl{kind}
-(either CCI for the terms of the Calculus of Constructions, FW for the
-the terms of $F_\omega$, or OBJ for other objects). For example, the
-name of the following constant:
-\begin{verbatim}
-     Section A.
-     Section B.
-     Section C.
-     Definition zero := O.
-\end{verbatim}
-
-is internally represented by the section path:
-
-$$\underbrace{\mathtt{\#A\#B\#C}}_{\mbox{dirpath}}
-\underbrace{\mathtt{\tt \#zero}}_{\mbox{basename}}
-\underbrace{\mathtt{\tt .cci}_{\;}}_{\mbox{kind}}$$
-
-When one of the sections is closed, a new constant is created with an
-updated section-path,a nd the old one is no longer reachable.  In our
-example, after closing the section \texttt{C}, the new section-path
-for the constant {\tt zero} becomes:
-\begin{center}
-\texttt{ \#A\#B\#zero.cci}
-\end{center}
-
-The following operations can be used to handle section paths:
-
-\begin{description}
-\fun{val Names.string\_of\_path : section\_path -> string}
-    {Transforms the section path into a string.}
-\fun{val Names.path\_of\_string : string -> section\_path}
-    {Parses a string an returns the corresponding section path.}
-\fun{val Names.basename : section\_path -> identifier}
-    {Provides the basename of a section path}
-\fun{val Names.dirpath : section\_path -> string list}
-    {Provides the directory of a section path}
-\fun{val Names.kind\_of\_path : section\_path -> path\_kind}
-    {Provides the kind of a section path}
-\end{description}
-
-\subsubsection{Signatures} 
-
-A \textsl{signature} is a mapping associating different informations
-to identifiers (for example, its type, its definition, etc). The
-following operations could be useful for working with signatures:
-
-\begin{description}
-\fun{val Names.ids\_of\_sign  : 'a signature -> identifier list}
-    {Gets the list of identifiers of the signature.}
-\fun{val Names.vals\_of\_sign : 'a signature -> 'a list}
-    {Gets the list of values associated to the identifiers of the signature.}
-\fun{val Names.lookup\_glob1 : \\ \qquad
-identifier -> 'a signature -> (identifier *
-    'a)}
-    {\\ Gets the value associated to a given identifier of the signature.}
-\end{description}
-
-
-\subsection{The Terms of the Calculus of Constructions}
-
-The language of the Calculus of Inductive Constructions described in
-Chapter \ref{Cic} is implemented on the top of the logical framework,
-instantiating the parameter $op$ of the meta-language with a
-particular set of operators.  In the implementation this language is
-called \texttt{constr}, the language of constructions.
-
-% The only difference
-%with respect to the one described in Section \ref{} is that the terms
-%of \texttt{constr} may contain \textsl{existential variables}. An
-%existential variable is a place holder representing a part of the term
-%that is still to be constructed. Such ``open terms'' are necessary
-%when building proofs interactively.
-
-\subsubsection{Building Constructions}
-
-The user does not need to know the choices made to represent
-\texttt{constr} in the meta-language. They are abstracted away by the
-following constructor functions:
-
-\begin{description}
-\fun{val Term.mkRel          : int -> constr}
-    {$(\texttt{mkRel}\;n)$ represents de Bruijn's index $n$.}
-
-\fun{val Term.mkVar : identifier -> constr} 
-    {$(\texttt{mkVar}\;id)$
-    represents a global identifier named $id$, like a variable
-    inside the scope of a section, or a hypothesis in a proof}.
-
-\fun{val Term.mkExistential : constr} 
-   {\texttt{mkExistential} represents an implicit sub-term, like the question
-    marks in the term \texttt{(pair ? ? O true)}.}
-
-%\fun{val Term.mkMeta         : int -> constr}
-%    {$(\texttt{mkMeta}\;n)$ represents an existential variable, whose
-%     name is the integer $n$.}
-
-\fun{val Term.mkProp         : constr}
-    {$\texttt{mkProp}$ represents the sort \textsl{Prop}.}
-
-\fun{val Term.mkSet          : constr}
-    {$\texttt{mkSet}$ represents the sort \textsl{Set}.}
-
-\fun{val Term.mkType         : Impuniv.universe -> constr}
-    {$(\texttt{mkType}\;u)$ represents the term
-    $\textsl{Type}(u)$. The universe $u$ is represented as a 
-    section path indexed by an integer. }
-
-\fun{val Term.mkConst : section\_path -> constr array -> constr}
-    {$(\texttt{mkConst}\;c\;v)$ represents a constant whose name is
-    $c$. The body of the constant is stored in a global table,
-    accessible through the name of the constant. The array of terms
-    $v$ corresponds to the variables of the environment appearing in
-    the body of the constant when it was defined. For instance, a
-    constant defined in the section \textsl{Foo} containing the
-    variable $A$, and whose body is $[x:Prop\ra Prop](x\;A)$ is
-    represented inside the scope of the section by
-    $(\texttt{mkConst}\;\texttt{\#foo\#f.cci}\;[| \texttt{mkVAR}\;A
-    |])$.  Once the section is closed, the constant is represented by
-    the term $(\texttt{mkConst}\;\#f.cci\;[| |])$, and its body
-    becomes $[A:Prop][x:Prop\ra Prop](x\;A)$}.
-
-\fun{val Term.mkMutInd : section\_path -> int -> constr array ->constr}
-    {$(\texttt{mkMutInd}\;c\;i)$ represents the $ith$ type
-    (starting from zero) of the block of mutually dependent
-    (co)inductive types, whose first type is $c$.  Similarly to the
-    case of constants, the array of terms represents the current
-    environment of the (co)inductive type. The definition of the type
-    (its arity, its constructors, whether it is inductive or co-inductive, etc.)
-    is stored in a global hash table, accessible through the name of 
-    the type.}
-
-\fun{val Term.mkMutConstruct : \\ \qquad section\_path -> int -> int -> constr array
-    ->constr} {\\ $(\texttt{mkMutConstruct}\;c\;i\;j)$ represents the
-    $jth$ constructor of the $ith$ type of the block of mutually
-    dependent (co)inductive types whose first type is $c$. The array
-    of terms represents the current environment of the (co)inductive
-    type.}
-
-\fun{val Term.mkCast : constr -> constr -> constr}
-    {$(\texttt{mkCast}\;t\;T)$ represents the annotated term $t::T$ in
-    \Coq's syntax.}  
-
-\fun{val Term.mkProd : name ->constr ->constr -> constr}
-    {$(\texttt{mkProd}\;x\;A\;B)$ represents the product $(x:A)B$.
-     The free ocurrences of $x$ in $B$ are represented by de Bruijn's
-     indexes.}
-
-\fun{val Term.mkNamedProd : identifier -> constr -> constr -> constr}
-    {$(\texttt{produit}\;x\;A\;B)$ represents the product $(x:A)B$,
-     but the bound occurrences of $x$ in $B$ are denoted by 
-     the identifier $(\texttt{mkVar}\;x)$. The function automatically 
-     changes each occurrences of this identifier into the corresponding 
-     de Bruijn's index.}
-
-\fun{val Term.mkArrow : constr -> constr -> constr}
-    {$(\texttt{arrow}\;A\;B)$ represents the type $(A\rightarrow B)$.}
-
-\fun{val Term.mkLambda       : name -> constr -> constr -> constr}
-    {$(\texttt{mkLambda}\;x\;A\;b)$ represents the lambda abstraction 
-     $[x:A]b$. The free ocurrences of $x$ in $B$ are represented by de Bruijn's
-     indexes.}
-
-\fun{val Term.mkNamedLambda : identifier -> constr -> constr -> constr}
-    {$(\texttt{lambda}\;x\;A\;b)$ represents the lambda abstraction 
-     $[x:A]b$, but the bound occurrences of $x$ in $B$ are denoted by 
-     the identifier $(\texttt{mkVar}\;x)$. }
-
-\fun{val Term.mkAppLA        : constr array -> constr}
-    {$(\texttt{mkAppLA}\;t\;[|t_1\ldots t_n|])$ represents the application
-    $(t\;t_1\;\ldots t_n)$.}
-
-\fun{val Term.mkMutCaseA : \\ \qquad
-    case\_info -> constr ->constr
-    ->constr array -> constr} 
-    {\\ $(\texttt{mkMutCaseA}\;r\;P\;m\;[|f_1\ldots f_n|])$
-    represents the term \Case{P}{m}{f_1\ldots f_n}. The first argument
-    $r$ is either \texttt{None} or $\texttt{Some}\;(c,i)$, where the
-    pair $(c,i)$ refers to the inductive type that $m$ belongs to.}
-
-\fun{val Term.mkFix :  \\ \qquad
-int array->int->constr array->name
-    list->constr array->constr}
-    {\\ $(\texttt{mkFix}\;[|k_1\ldots k_n |]\;i\;[|A_1\ldots
-    A_n|]\;[|f_1\ldots f_n|]\;[|t_1\ldots t_n|])$ represents the term
-    $\Fix{f_i}{f_1/k_1:A_1:=t_1 \ldots f_n/k_n:A_n:=t_n}$}
-
-\fun{val Term.mkCoFix  : \\ \qquad
-    int -> constr array -> name list ->
-    constr array -> constr}
-    {\\ $(\texttt{mkCoFix}\;i\;[|A_1\ldots
-    A_n|]\;[|f_1\ldots f_n|]\;[|t_1\ldots t_n|])$ represents the term
-    $\CoFix{f_i}{f_1:A_1:=t_1 \ldots f_n:A_n:=t_n}$. There are no
-    decreasing indexes in this case.}
-\end{description}
-
-\subsubsection{Decomposing Constructions}
-
-Each of the construction functions above has its corresponding
-(partial) destruction function, whose name is obtained changing the
-prefix \texttt{mk} by \texttt{dest}. In addition to these functions, a
-concrete datatype \texttt{kindOfTerm} can be used to do pattern
-matching on terms without dealing with their internal representation
-in the meta-language. This concrete datatype is described in the \ocaml{}
-file \texttt{term.mli}. The following function transforms a construction
-into an element of type \texttt{kindOfTerm}:
-
-\begin{description}
-\fun{val Term.kind\_of\_term : constr -> kindOfTerm}
-    {Destructs a term of the language \texttt{constr},
-yielding the direct components of the term. Hence, in order to do 
-pattern matching on an object $c$ of \texttt{constr}, it is sufficient
-to do pattern matching on the value $(\texttt{kind\_of\_term}\;c)$.}
-\end{description}
-
-Part of the information associated to the constants is stored in 
-global tables. The following functions give access to such 
-information:
-
-\begin{description}
-\fun{val Termenv.constant\_value    : constr -> constr}
-    {If the term denotes a constant, projects the body of a constant}
-\fun{Termenv.constant\_type     : constr -> constr}
-    {If the term denotes a constant, projects the type of the constant}
-\fun{val mind\_arity        : constr -> constr}
-    {If the term denotes an inductive type, projects its arity (i.e.,
-     the type of the inductive type).}
-\fun{val Termenv.mis\_is\_finite    : mind\_specif -> bool}
-    {Determines whether a recursive type is inductive or co-inductive.}
-\fun{val Termenv.mind\_nparams : constr -> int}
-    {If the term denotes an inductive type, projects the number of 
-     its general parameters.}
-\fun{val Termenv.mind\_is\_recursive : constr -> bool}
-    {If the term denotes an inductive type, 
-     determines if the type has at least one recursive constructor. }
-\fun{val Termenv.mind\_recargs : constr -> recarg list array array}
-    {If the term denotes an inductive type, returns an array $v$ such 
-     that the nth element of $v.(i).(j)$ is
-    \texttt{Mrec} if the $nth$ argument of the $jth$ constructor of
-    the $ith$ type is recursive, and \texttt{Norec} if it is not.}.
-\end{description}
-
-\subsection[The Type Checker]{The Type Checker\label{TypeChecker}}
-
-The third logical module is the type checker. It concentrates two main
-tasks concerning the language of constructions.
-
-On one hand, it contains the type inference and type-checking
-functions.  The type inference function takes a term
-$a$ and a signature $\Gamma$, and yields a term $A$ such that
-$\Gamma \vdash a:A$.  The type-checking function takes two terms $a$
-and $A$ and a signature $\Gamma$, and determines whether or not
-$\Gamma \vdash a:A$.
-
-On the other hand, this module is in charge of the compilation of
-\Coq's abstract syntax trees into the language \texttt{constr} of
-constructions. This compilation seeks to eliminate all the ambiguities
-contained in \Coq's abstract syntax, restoring the information
-necessary to type-check it.  It concerns at least the following steps:
-\begin{enumerate}
-\item Compiling the pattern-matching expressions containing 
-constructor patterns, wild-cards, etc, into terms that only
-use the primitive \textsl{Case} described in Chapter \ref{Cic}
-\item Restoring type coercions and synthesizing the implicit arguments
-(the one denoted by question marks in
-{\Coq} syntax: see Section~\ref{Coercions}).
-\item Transforming the named bound variables into de Bruijn's indexes.
-\item Classifying the global names into the different classes of
-constants (defined constants, constructors, inductive types, etc).
-\end{enumerate}
-
-\subsection{The Proof Engine}
-
-The fourth stage of \Coq's implementation is the \textsl{proof engine}:
-the interactive machine for constructing proofs. The aim of the proof
-engine is to construct a top-down derivation or \textsl{proof tree},
-by the application of \textsl{tactics}. A proof tree has the following
-general structure:\\
-
-\begin{displaymath}
-\frac{\Gamma \vdash ? = t(?_1,\ldots?_n) : G}
-     {\hspace{3ex}\frac{\displaystyle \Gamma_1 \vdash ?_1 = t_1(\ldots) : G_1}
-         {\stackrel{\vdots}{\displaystyle {\Gamma_{i_1} \vdash ?_{i_1} 
-           : G_{i_1}}}}(tac_1)
-      \;\;\;\;\;\;\;\;\;
-      \frac{\displaystyle \Gamma_n \vdash ?_n = t_n(\ldots) : G_n}
-         {\displaystyle \stackrel{\vdots}{\displaystyle {\Gamma_{i_m} \vdash ?_{i_m} :
-     G_{i_m}}}}(tac_n)} (tac)    
-\end{displaymath}
-
-
-\noindent Each node of the tree is called a \textsl{goal}. A goal
-is a record type containing the following three fields:
-\begin{enumerate}
-\item the conclusion $G$ to be proven;
-\item a typing signature $\Gamma$ for the free variables in $G$;
-\item if the goal is an internal node of the proof tree, the
-definition $t(?_1,\ldots?_n)$ of an \textsl{existential variable}
-(i.e. a possible undefined constant) $?$ of type $G$ in terms of the
-existential variables of the children sub-goals. If the node is a
-leaf, the existential variable maybe still undefined.
-\end{enumerate}
-
-Once all the existential variables have been defined the derivation is
-completed, and a construction can be generated from the proof tree,
-replacing each of the existential variables by its definition.  This
-is exactly what happens when one of the commands
-\texttt{Qed} or \texttt{Defined} is invoked
-(see Section~\ref{Qed}). The saved theorem becomes a defined constant,
-whose body is the proof object generated.
-
-\paragraph{Important:} Before being added to the
-context, the proof object is type-checked, in order to verify that it is
-actually an object of the expected type $G$.  Hence, the correctness
-of the proof actually does not depend on the tactics applied to
-generate it or the machinery of the proof engine, but only on the
-type-checker. In other words, extending the system with a potentially
-bugged new tactic never endangers the consistency of the system.
-
-\subsubsection[What is a Tactic?]{What is a Tactic?\label{WhatIsATactic}}
-%Let us now explain what is a tactic, and how the user can introduce
-%new ones. 
-
-From an operational point of view, the current state of the proof
-engine is given by the mapping $emap$ from existential variables into
-goals, plus a pointer to one of the leaf goals $g$.  Such a pointer
-indicates where the proof tree will be refined by the application of a
-\textsl{tactic}. A tactic is a function from the current state
-$(g,emap)$ of the proof engine into a pair $(l,val)$. The first
-component of this pair is the list of children sub-goals $g_1,\ldots
-g_n$ of $g$ to be yielded by the tactic. The second one is a
-\textsl{validation function}. Once the proof trees $\pi_1,\ldots
-\pi_n$ for $g_1,\ldots g_n$ have been completed, this validation
-function must yield a proof tree $(val\;\pi_1,\ldots \pi_n)$ deriving
-$g$.
-
-Tactics can be classified into \textsl{primitive} ones and
-\textsl{defined} ones. Primitive tactics correspond to the five basic
-operations of the proof engine:
-
-\begin{enumerate}
-\item Introducing a universally quantified variable into the local
-context of the goal.
-\item Defining an undefined existential variable 
-\item Changing the conclusion of the goal for another
---definitionally equal-- term.
-\item Changing the type of a variable in the local context for another
-definitionally equal term.
-\item Erasing a variable from the local context.
-\end{enumerate}
-
-\textsl{Defined} tactics are tactics constructed by combining these
-primitive operations.  Defined tactics are registered in a hash table,
-so that they can be introduced dynamically. In order to define such a
-tactic table, it is necessary to fix what a \textsl{possible argument}
-of a tactic may be. The type \texttt{tactic\_arg} of the possible
-arguments for tactics is a union type including:
-\begin{itemize}
-\item quoted strings;
-\item integers;
-\item identifiers;
-\item lists of identifiers;
-\item plain terms, represented by its abstract syntax tree;
-\item well-typed terms, represented by a construction;
-\item a substitution for bound variables, like the
-substitution in the tactic \\$\texttt{Apply}\;t\;\texttt{with}\;x:=t_1\ldots
-x_n:=t_n$, (see Section~\ref{apply});
-\item a reduction expression, denoting the reduction strategy to be
-followed.
-\end{itemize}
-Therefore, for each function $tac:a \rightarrow tactic$ implementing a
-defined tactic, an associated dynamic tactic $tacargs\_tac:
-\texttt{tactic\_arg}\;list \rightarrow tactic$ calling $tac$ must be
-written. The aim of the auxiliary function $tacargs\_tac$ is to inject
-the arguments of the tactic $tac$ into the type of possible arguments
-for a tactic.
-
-The following function can be used for registering and calling a
-defined tactic:
-
-\begin{description}
-\fun{val Tacmach.add\_tactic : \\ \qquad
-string -> (tactic\_arg list ->tactic) -> unit}
-    {\\ Registers a dynamic tactic with the given string as access index.}
-\fun{val Tacinterp.vernac\_tactic : string*tactic\_arg list -> tactic}
-    {Interprets a defined tactic given by its entry in the
-     tactics table with a particular list of possible arguments.}
-\fun{val Tacinterp.vernac\_interp        : CoqAst.t -> tactic}
-    {Interprets a tactic expression formed combining \Coq's tactics and
-          tacticals, and described by its abstract syntax tree.}
-\end{description}
-
-When programming a new tactic that calls an already defined tactic
-$tac$, we have the choice between using the \ocaml{} function
-implementing $tac$, or calling the tactic interpreter with the name
-and arguments for interpreting $tac$. In the first case, a tactic call
-will left the trace of the whole implementation of $tac$ in the proof
-tree. In the second, the implementation of $tac$ will be hidden, and
-only an invocation of $tac$ will be recalled (cf. the example of
-Section \ref{ACompleteExample}.  The following combinators can be used
-to hide the implementation of a tactic:
-
-\begin{verbatim}
-type 'a hiding_combinator = string -> ('a -> tactic) -> ('a -> tactic)
-val Tacmach.hide_atomic_tactic  : string -> tactic -> tactic
-val Tacmach.hide_constr_tactic  : constr          hiding_combinator
-val Tacmach.hide_constrl_tactic : (constr list)   hiding_combinator
-val Tacmach.hide_numarg_tactic  : int             hiding_combinator
-val Tacmach.hide_ident_tactic   : identifier      hiding_combinator
-val Tacmach.hide_identl_tactic  : identifier      hiding_combinator
-val Tacmach.hide_string_tactic  : string          hiding_combinator
-val Tacmach.hide_bindl_tactic   : substitution    hiding_combinator
-val Tacmach.hide_cbindl_tactic  : 
-          (constr * substitution) hiding_combinator
-\end{verbatim}
-
-These functions first register the tactic by a side effect, and then
-yield a function calling the interpreter with the registered name and
-the right injection into the type of possible arguments.
-
-\subsection{Tactics and Tacticals Provided by \Coq}
-
-The fifth logical module is the library of tacticals and basic tactics
-provided by \Coq. This library is distributed into the directories
-\texttt{tactics} and \texttt{src/tactics}. The former contains those
-basic tactics that make use of the types contained in the basic state
-of \Coq. For example, inversion or rewriting tactics are in the
-directory \texttt{tactics}, since they make use of the propositional
-equality type.  Those tactics which are independent from the context
---like for example \texttt{Cut}, \texttt{Intros}, etc-- are defined in
-the directory \texttt{src/tactics}. This latter directory also
-contains some useful tools for programming new tactics, referred in 
-Section \ref{SomeUsefulToolsforWrittingTactics}.
-
-In practice, it is very unusual that the list of sub-goals and the
-validation function of the tactic must be explicitly constructed by
-the user. In most of the cases, the implementation of a new tactic
-consists in supplying the appropriate arguments to the basic tactics
-and tacticals.
-
-\subsubsection{Basic Tactics}
-
-The file \texttt{Tactics} contain the implementation of the basic
-tactics provided by \Coq. The following tactics are some of the most
-used ones:
-
-\begin{verbatim}
-val Tactics.intro           : tactic
-val Tactics.assumption      : tactic
-val Tactics.clear           : identifier list -> tactic
-val Tactics.apply           : constr -> constr substitution -> tactic
-val Tactics.one_constructor : int -> constr substitution -> tactic
-val Tactics.simplest_elim   : constr -> tactic
-val Tactics.elimType        : constr -> tactic
-val Tactics.simplest_case   : constr -> tactic
-val Tactics.caseType        : constr -> tactic
-val Tactics.cut             : constr -> tactic
-val Tactics.reduce          : redexpr -> tactic
-val Tactics.exact           : constr -> tactic
-val Auto.auto               : int option -> tactic
-val Auto.trivial            : tactic
-\end{verbatim}
-
-The functions hiding the implementation of these tactics are defined
-in the module \texttt{Hiddentac}. Their names are prefixed by ``h\_''.
-
-\subsubsection[Tacticals]{Tacticals\label{OcamlTacticals}}
-
-The following tacticals can be used to combine already existing
-tactics:
-
-\begin{description}
-\fun{val Tacticals.tclIDTAC : tactic}
-    {The identity tactic: it leaves the goal as it is.}
-
-\fun{val Tacticals.tclORELSE : tactic -> tactic -> tactic}
-    {Tries the first tactic and in case of failure applies the second one.}
-
-\fun{val Tacticals.tclTHEN : tactic -> tactic -> tactic}
-  {Applies the first tactic and then the second one to each generated subgoal.}
-
-\fun{val Tacticals.tclTHENS : tactic -> tactic list -> tactic}
-    {Applies a tactic, and then applies each tactic of the tactic list to the
-     corresponding generated subgoal.}
-
-\fun{val Tacticals.tclTHENL : tactic -> tactic -> tactic}
-    {Applies the first tactic, and then applies the second one to the last
-     generated subgoal.}
-
-\fun{val Tacticals.tclREPEAT : tactic -> tactic}
-    {If the given tactic succeeds in producing a subgoal, then it
-     is recursively applied to each generated subgoal, 
-     and so on until it fails. }
-
-\fun{val Tacticals.tclFIRST : tactic list -> tactic}
-    {Tries the tactics of the given list one by one, until one of them
-     succeeds.}
-
-\fun{val Tacticals.tclTRY : tactic -> tactic}
-    {Tries the given tactic and in case of failure applies the {\tt
-    tclIDTAC} tactical to the original goal.}
-
-\fun{val Tacticals.tclDO : int -> tactic -> tactic}
-    {Applies the tactic a given number of times.}
-
-\fun{val Tacticals.tclFAIL : tactic}
-    {The always failing tactic: it raises a {\tt UserError} exception.}
-
-\fun{val Tacticals.tclPROGRESS  : tactic -> tactic}
-    {Applies the given tactic to the current goal and fails if the 
-     tactic leaves the goal unchanged}
-
-\fun{val Tacticals.tclNTH\_HYP :  int -> (constr -> tactic) -> tactic}
-    {Applies a tactic to the nth hypothesis of the local context.
-     The last hypothesis introduced correspond to the integer 1.}
-
-\fun{val Tacticals.tclLAST\_HYP :  (constr -> tactic) -> tactic}
-    {Applies a tactic to the last hypothesis introduced.}
-
-\fun{val Tacticals.tclCOMPLETE : tactic -> tactic}
-    {Applies a tactic and fails if the tactic did not solve completely the
-      goal}
-
-\fun{val Tacticals.tclMAP : ('a -> tactic) -> 'a list -> tactic}
-    {Applied to the function \texttt{f} and the list \texttt{[x\_1;
-        ... ; x\_n]}, this tactical applies the tactic
-      \texttt{tclTHEN (f x1) (tclTHEN (f x2) ... ))))}}
-    
-\fun{val Tacicals.tclIF : (goal sigma -> bool) -> tactic -> tactic -> tactic}
-    {If the condition holds, apply the first tactic; otherwise,
-      apply the second one}
-
-\end{description}
-
-
-\subsection{The Vernacular Interpreter}
-
-The sixth logical module of the implementation corresponds to the
-interpreter of the vernacular phrases of \Coq. These phrases may be
-expressions from the \gallina{} language (definitions), general
-directives (setting commands) or tactics to be applied by the proof
-engine. 
-
-\subsection[The Parser and the Pretty-Printer]{The Parser and the Pretty-Printer\label{PrettyPrinter}}
-
-The last logical module is the parser and pretty printer of \Coq,
-which is the interface between the vernacular interpreter and the
-user. They translate the chains of characters entered at the input
-into abstract syntax trees, and vice versa. Abstract syntax trees are
-represented by labeled n-ary trees, and its type is called
-\texttt{CoqAst.t}.  For instance, the abstract syntax tree associated
-to the term $[x:A]x$ is:
-
-\begin{displaymath}
-\texttt{Node}
- ((0,6), "LAMBDA",
-  [\texttt{Nvar}~((3, 4),"A");~\texttt{Slam}~((0,6),~Some~"x",~\texttt{Nvar}~((5,6),"x"))])
-\end{displaymath}
-
-The numbers correspond to \textsl{locations}, used to point to some
-input line and character positions in the error messages. As it was
-already explained in Section \ref{TypeChecker}, this term is then
-translated into a construction term in order to be typed.
-
-The parser of \Coq\ is implemented using \camlpppp. The lexer and the data
-used by \camlpppp\ to generate the parser lay in the directory
-\texttt{src/parsing}.  This directory also contains \Coq's
-pretty-printer. The printing rules lay in the directory
-\texttt{src/syntax}.  The different entries of the grammar are
-described in the module \texttt{Pcoq.Entry}.  Let us present here two
-important functions of this logical module:
-
-\begin{description}
-\fun{val Pcoq.parse\_string : 'a Grammar.Entry.e -> string -> 'a}
-    {Parses a given string, trying to recognize a phrase
-     corresponding to some entry in the grammar. If it succeeds,
-     it yields a value associated to the grammar entry. For example,
-     applied to the entry \texttt{Pcoq.Command.command}, this function
-    parses a term of \Coq's language, and yields a value of type 
-    \texttt{CoqAst.t}. When applied to the entry
-    \texttt{Pcoq.Vernac.vernac}, it parses a vernacular command and
-    returns the corresponding Ast.}
-\fun{val gentermpr       : \\ \qquad 
-path\_kind -> constr assumptions -> constr -> std\_ppcmds}
-    {\\ Pretty-prints a well-typed term of certain kind (cf. Section
-    \ref{SectionPaths}) under its context of typing assumption.}
-\fun{val gentacpr        : CoqAst.t -> std\_ppcmds}
-    {Pretty-prints a given abstract syntax tree representing a tactic
-     expression.}
-\end{description}
-
-\subsection{The General Library}
-
-In addition to the ones laying in the standard library of \ocaml{},
-several useful modules about lists, arrays, sets, mappings, balanced
-trees, and other frequently used data structures can be found in the
-directory \texttt{lib}. Before writing a new one, check if it is not
-already there!
-
-\subsubsection{The module \texttt{Std}}
-This module in the directory \texttt{src/lib/util} is opened by almost 
-all modules of \Coq{}. Among other things, it contains a definition of 
-the different kinds of errors used in \Coq{} :
-
-\begin{description}
-\fun{exception UserError of string * std\_ppcmds}
-    {This is the class of ``users exceptions''. Such errors arise when 
-      the user attempts to do something illegal, for example \texttt{Intro}
-      when the current goal conclusion is not a product.}
-
-\fun{val Std.error : string -> 'a}
-    {For simple error messages}
-\fun{val Std.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}
-
-\fun{exception Anomaly of string * std\_ppcmds}
-    {This for reporting bugs or things that should not
-      happen. The tacticals \texttt{tclTRY} and
-      \texttt{tclTRY} described in Section~\ref{OcamlTacticals} catch the
-      exceptions of type \texttt{UserError}, but they don't catch the
-      anomalies. So, in your code, don't raise any anomaly, unless you
-      know what you are doing. We also recommend to avoid constructs
-      such as \texttt{try ... with \_ -> ...} : such constructs can trap 
-      an anomaly and make the debugging process harder.}
-
-\fun{val Std.anomaly : string -> 'a}{}
-\fun{val Std.anomalylabstrm : string -> std\_ppcmds -> 'a}{}
-\end{description}
-
-\section{The tactic writer mini-HOWTO}
-
-\subsection{How to add a vernacular command}
-
-The command to register a vernacular command can be found
-in module \texttt{Vernacinterp}:
-
-\begin{verbatim}
-val vinterp_add : string * (vernac_arg list -> unit -> unit) -> unit;;
-\end{verbatim}
-
-The first argument is the name, the second argument is a function that
-parses the arguments and returns a function of type
-\texttt{unit}$\rightarrow$\texttt{unit} that do the job.
-
-In this section we will show how to add a vernacular command
-\texttt{CheckCheck} that print a type of a term and the type of its
-type.
-
-File \texttt{dcheck.ml}:
-
-\begin{verbatim}
-open Vernacinterp;;
-open Trad;;
-let _ = 
-  vinterp_add 
-   ("DblCheck",
-    function [VARG_COMMAND com] ->
-       (fun () -> 
-          let evmap = Evd.mt_evd () 
-          and sign = Termenv.initial_sign () in
-           let {vAL=c;tYP=t;kIND=k} = 
-                 fconstruct_with_univ evmap sign com in
-             Pp.mSGNL [< Printer.prterm c; 'sTR ":"; 
-                       Printer.prterm t; 'sTR ":"; 
-                       Printer.prterm k >] )
-      | _ -> bad_vernac_args "DblCheck")
-;;
-\end{verbatim}
-
-Like for a new tactic, a new syntax entry must be created.
-
-File \texttt{DCheck.v}:
-
-\begin{verbatim}
-Declare ML Module "dcheck.ml".
-
-Grammar vernac vernac := 
-  dblcheck [ "CheckCheck" comarg($c) ] -> [(DblCheck $c)].
-\end{verbatim}
-
-We are now able to test our new command:
-
-\begin{verbatim}
-Coq < Require DCheck.
-Coq < CheckCheck O.
-O:nat:Set
-\end{verbatim}
-
-Most Coq vernacular commands are registered in the module 
-  \verb+src/env/vernacentries.ml+. One can see more examples here.
-
-\subsection{How to keep a hashtable synchronous with the reset mechanism}
-
-This is far more tricky. Some vernacular commands modify some
-sort of state (for example by adding something in a hashtable). One
-wants that \texttt{Reset} has the expected behavior with this
-commands.
-
-\Coq{} provides a general mechanism to do that. \Coq{} environments
-contains objects of three kinds: CCI, FW and OBJ. CCI and FW are for
-constants of the calculus. OBJ is a dynamically extensible datatype
-that contains sections, tactic definitions, hints for auto, and so
-on. 
-
-The simplest example of use of such a mechanism is in file
-\verb+src/proofs/macros.ml+ (which implements the \texttt{Tactic
-  Definition} command). Tactic macros are stored in the imperative
-hashtable \texttt{mactab}. There are two functions freeze and unfreeze
-to make a copy of the table and to restore the state of table from the
-copy. Then this table is declared using \texttt{Library.declare\_summary}.
-
-What does \Coq{} with that ? \Coq{} defines synchronization points.
-At each synchronisation point, the declared tables are frozen (that
-is, a copy of this tables is stored).
-
-When \texttt{Reset }$i$ is called, \Coq{} goes back to the first
-synchronisation point that is above $i$ and ``replays'' all objects
-between that point 
-and $i$. It will re-declare constants, re-open section, etc.
-
-So we need to declare a new type of objects, TACTIC-MACRO-DATA. To
-``replay'' on object of that type is to add the corresponding tactic
-macro to \texttt{mactab}
-
-So, now, we can say that \texttt{mactab} is synchronous with the Reset
-mechanism$^{\mathrm{TM}}$.
-
-Notice that this works for hash tables but also for a single integer
-(the Undo stack size, modified by the \texttt{Set Undo} command, for
-example).
-
-\subsection{The right way to access to Coq constants from your ML code}
-
-With their long names, Coq constants are stored using:
-
-\begin{itemize}
-\item a section path
-\item an identifier
-\end{itemize}
-
-The identifier is exactly the identifier that is used in \Coq{} to
-denote the constant; the section path can be known using the
-\texttt{Locate} command:
-
-\begin{coq_example}
-  Locate S.
-  Locate nat.
-  Locate eq.
-\end{coq_example}
-
-Now it is easy to get a constant by its name and section path:
-
-
-\begin{verbatim}
-let constant sp id = 
-  Machops.global_reference (Names.gLOB (Termenv.initial_sign ())) 
-    (Names.path_of_string sp) (Names.id_of_string id);;
-\end{verbatim}
-
-
-The only issue is that if one cannot put:
-
-
-\begin{verbatim}
-let coq_S = constant "#Datatypes#nat.cci" "S";;
-\end{verbatim}
-
-
-in his tactic's code. That is because this sentence is evaluated
-\emph{before} the module \texttt{Datatypes} is loaded. The solution is
-to use the lazy evaluation of \ocaml{}:
-
-
-\begin{verbatim}
-let coq_S = lazy (constant "#Datatypes#nat.cci" "S");;
-
-... (Lazy.force coq_S) ...
-\end{verbatim}
-
-
-Be sure to call always Lazy.force behind a closure -- i.e. inside a
-function body or behind the \texttt{lazy} keyword.
-
-One can see examples of that technique in the source code of \Coq{},
-for example 
-\verb+plugins/omega/coq_omega.ml+.
-
-\section[Some Useful Tools for Writing Tactics]{Some Useful Tools for Writing Tactics\label{SomeUsefulToolsforWrittingTactics}}
-When the implementation of a tactic is not a straightforward
-combination of tactics and tacticals, the module \texttt{Tacmach}
-provides several useful functions for handling goals, calling the
-type-checker, parsing terms, etc. This module is intended to be 
-the interface of the proof engine for the user.
-
-\begin{description}
-\fun{val Tacmach.pf\_hyps               : goal sigma -> constr signature}
-    {Projects the local typing context $\Gamma$ from a given goal $\Gamma\vdash ?:G$.} 
-\fun{val pf\_concl              : goal sigma -> constr}
-    {Projects the conclusion $G$ from a given goal $\Gamma\vdash ?:G$.}
-\fun{val Tacmach.pf\_nth\_hyp            : goal sigma -> int -> identifier *
-    constr}
-    {Projects the $ith$ typing constraint $x_i:A_i$ from the local
-     context of the given goal.}
-\fun{val Tacmach.pf\_fexecute           : goal sigma -> constr -> judgement}
-    {Given a goal whose local context is $\Gamma$ and a term $a$, this
-     function infers a type $A$ and a kind $K$ such that the judgement
-     $a:A:K$ is valid under $\Gamma$, or raises an exception if there
-     is no such judgement. A judgement is just a record type containing
-     the three terms $a$, $A$ and $K$.}
-\fun{val Tacmach.pf\_infexecute : \\
-     \qquad
-goal sigma -> constr -> judgement * information}
-    {\\ In addition to the typing judgement, this function also extracts 
-     the $F_{\omega}$ program underlying the term.}
-\fun{val Tacmach.pf\_type\_of            : goal sigma -> constr -> constr}
-    {Infers a term $A$ such that $\Gamma\vdash a:A$ for a given term
-    $a$, where $\Gamma$ is the local typing context of the goal.}
-\fun{val Tacmach.pf\_check\_type         : goal sigma -> constr -> constr -> bool}
-    {This function yields a type $A$ if the two given terms $a$ and $A$  verify $\Gamma\vdash
-     a:A$ in the local typing context $\Gamma$ of the goal. Otherwise,
-    it raises an exception.}
-\fun{val Tacmach.pf\_constr\_of\_com      : goal sigma -> CoqAst.t -> constr}
-    {Transforms an abstract syntax tree into a well-typed term of the
-    language of constructions. Raises an exception if the term cannot
-    be typed.}
-\fun{val Tacmach.pf\_constr\_of\_com\_sort : goal sigma -> CoqAst.t -> constr}
-    {Transforms an abstract syntax tree representing a type into
-    a well-typed term of the language of constructions. Raises an
-    exception if the term cannot be typed.}
-\fun{val Tacmach.pf\_parse\_const        : goal sigma -> string -> constr}
-    {Constructs the constant whose name is the given string.}
-\fun{val
-Tacmach.pf\_reduction\_of\_redexp  : \\
-         \qquad goal sigma -> red\_expr -> constr -> constr}
-    {\\ Applies a certain kind of reduction function, specified by an
-     element of the type red\_expr.}
-\fun{val Tacmach.pf\_conv\_x      : goal sigma -> constr -> constr -> bool}
-    {Test whether  two given terms are definitionally equal.}
-\end{description}
-
-\subsection[Patterns]{Patterns\label{Patterns}}
-
-The \ocaml{} file \texttt{Pattern} provides a quick way for describing a
-term pattern and performing second-order, binding-preserving, matching
-on it. Patterns are described using an extension of \Coq's concrete
-syntax, where the second-order meta-variables of the pattern are
-denoted by indexed question marks. 
-
-Patterns may depend on constants, and therefore only to make have
-sense when certain theories have been loaded. For this reason, they
-are stored with a \textsl{module-marker}, telling us which modules
-have to be open in order to use the pattern. The following functions
-can be used to store and retrieve patterns form the pattern table:
-
-\begin{description}
-\fun{val Pattern.make\_module\_marker : string list -> module\_mark}
-    {Constructs a module marker from a list of module names.}
-\fun{val Pattern.put\_pat : module\_mark -> string -> marked\_term}
-    {Constructs a pattern from a parseable string containing holes
-     and a module marker.}
-\fun{val Pattern.somatches    : constr ->   marked\_term-> bool}
-    {Tests if a term matches a pattern.} 
-\fun{val dest\_somatch : constr -> marked\_term -> constr list}
-    {If the term matches the pattern, yields the list of sub-terms
-     matching the occurrences of the pattern variables (ordered from
-     left to right). Raises a \texttt{UserError} exception if the term
-     does not match the pattern.} 
-\fun{val Pattern.soinstance : marked\_term -> constr list -> constr} 
-    {Substitutes each hole in the pattern 
-     by the corresponding term of the given the list.}
-\end{description}
-
-\paragraph{Warning:} Sometimes, a \Coq\ term may have invisible
-sub-terms that the matching functions are nevertheless sensible to.
-For example, the \Coq\ term $(?_1,?_2)$ is actually a shorthand for
-the expression $(\texttt{pair}\;?\;?\;?_1\;?_2)$.
-Hence, matching this term pattern 
-with the term $(\texttt{true},\texttt{O})$ actually yields the list
-$[?;?;\texttt{true};\texttt{O}]$ as result (and \textbf{not}
-$[\texttt{true};\texttt{O}]$, as could be expected).
-
-\subsection{Patterns on Inductive Definitions}
-
-The module \texttt{Pattern} also includes some functions for testing
-if the definition of an inductive type satisfies certain
-properties. Such functions may be used to perform pattern matching
-independently from the name given to the inductive type and the
-universe it inhabits.  They yield the value $(\texttt{Some}\;r::l)$ if
-the input term reduces into an application of an inductive type $r$ to
-a list of terms $l$, and the definition of $r$ satisfies certain
-conditions. Otherwise, they yield the value \texttt{None}.
-
-\begin{description}
-\fun{val Pattern.match\_with\_non\_recursive\_type : constr list option}
-    {Tests if the inductive type $r$ has no recursive constructors}
-\fun{val Pattern.match\_with\_disjunction : constr list option}
-    {Tests if the inductive type $r$ is a non-recursive type
-     such that all its constructors have a single argument.}
-\fun{val Pattern.match\_with\_conjunction : constr list option}
-    {Tests if the inductive type $r$ is a non-recursive type
-     with a unique constructor.}
-\fun{val Pattern.match\_with\_empty\_type  : constr list option}
-    {Tests if the inductive type $r$ has no constructors at all}
-\fun{val Pattern.match\_with\_equation    : constr list option}
-    {Tests if the inductive type $r$ has a single constructor
-     expressing the property of reflexivity for some type. For
-     example, the types $a=b$, $A\mbox{==}B$ and $A\mbox{===}B$ satisfy
-     this predicate.}
-\end{description}
-
-\subsection{Elimination Tacticals}
-
-It is frequently the case that the subgoals generated by an
-elimination can all be solved in a similar way, possibly parametrized
-on some information about each case, like for example:
-\begin{itemize}
-\item the inductive type of the object being eliminated;
-\item its arguments (if it is an inductive predicate);
-\item the branch number;
-\item the predicate to be proven;
-\item the number of assumptions to be introduced by the case
-\item the signature of the branch, i.e., for each argument of
-the branch whether it is recursive or not.
-\end{itemize}
-
-The following tacticals can be useful to deal with such situations.
-They  
-
-\begin{description}
-\fun{val Elim.simple\_elimination\_then : \\ \qquad
-(branch\_args -> tactic) -> constr -> tactic}
-    {\\ Performs the default elimination on the last argument, and then
-     tries to solve the generated subgoals using a given parametrized
-     tactic. The type branch\_args is a record type containing all 
-     information mentioned above.}
-\fun{val Elim.simple\_case\_then : \\ \qquad
-(branch\_args -> tactic) -> constr -> tactic}
-    {\\ Similarly, but it performs case analysis instead of induction.}
-\end{description}
-
-\section[A Complete Example]{A Complete Example\label{ACompleteExample}}
-
-In order to illustrate the implementation of a new tactic, let us come
-back to the problem of deciding the equality of two elements of an
-inductive type.
-
-\subsection{Preliminaries}
-
-Let us call \texttt{newtactic} the directory that will contain the
-implementation of the new tactic. In this directory will lay two
-files: a file \texttt{eqdecide.ml}, containing the \ocaml{} sources that
-implements the tactic, and a \Coq\ file \texttt{Eqdecide.v}, containing
-its associated grammar rules and the commands to generate a module
-that can be loaded dynamically from \Coq's toplevel. 
-
-To compile our project, we will create a \texttt{Makefile} with the
-command \texttt{do\_Makefile} (see Section~\ref{Makefile}) :
-
-\begin{quotation}
-  \texttt{do\_Makefile eqdecide.ml EqDecide.v > Makefile}\\
-  \texttt{touch .depend}\\
-  \texttt{make depend}
-\end{quotation}
-
-We must have kept the sources of \Coq{} somewhere and to set an
-environment variable \texttt{COQTOP} that points to that directory.
-
-\subsection{Implementing the Tactic}
-
-The file \texttt{eqdecide.ml} contains the implementation of the
-tactic in \ocaml{}. Let us recall the main steps of the proof strategy
-for deciding the proposition $(x,y:R)\{x=y\}+\{\neg x=y\}$ on the
-inductive type $R$:
-\begin{enumerate}
-\item Eliminate $x$ and then $y$.
-\item Try discrimination to solve those goals where $x$ and $y$ has
-been introduced by different constructors.
-\item If $x$ and $y$ have been introduced by the same constructor,
-      then analyze one by one the corresponding pairs of arguments.
-      If they are equal, rewrite one into the other. If they are
-      not, derive a contradiction from the invectiveness of the
-      constructor.
-\item Once all the arguments have been rewritten, solve the left half
-of the goal by reflexivity.
-\end{enumerate}
-
-In the sequel we implement these steps one by one. We start opening
-the modules necessary for the implementation of the tactic:
-
-\begin{verbatim}
-open Names
-open Term
-open Tactics
-open Tacticals
-open Hiddentac
-open Equality
-open Auto
-open Pattern
-open Names
-open Termenv
-open Std
-open Proof_trees
-open Tacmach
-\end{verbatim}
-
-The first step of the procedure can be straightforwardly implemented as
-follows:
-
-\begin{verbatim}
-let clear_last = (tclLAST_HYP (fun c -> (clear_one (destVar c))));;
-\end{verbatim}
-
-\begin{verbatim}
-let mkBranches = 
-        (tclTHEN  intro 
-        (tclTHEN (tclLAST_HYP h_simplest_elim)
-        (tclTHEN  clear_last
-        (tclTHEN  intros 
-        (tclTHEN (tclLAST_HYP h_simplest_case)
-        (tclTHEN  clear_last
-                  intros))))));;
-\end{verbatim}
-
-Notice the use of the tactical \texttt{tclLAST\_HYP}, which avoids to
-give a (potentially clashing) name to the quantified variables of the
-goal when they are introduced.
-
-The second step of the procedure is implemented by the following
-tactic:
-
-\begin{verbatim}
-let solveRightBranch  = (tclTHEN simplest_right discrConcl);;
-\end{verbatim}
-
-In order to illustrate how the implementation of a tactic can be 
-hidden, let us do it with the tactic above:
-
-\begin{verbatim}
-let h_solveRightBranch =
-    hide_atomic_tactic "solveRightBranch" solveRightBranch
-;;
-\end{verbatim}
-
-As it was already mentioned in Section \ref{WhatIsATactic}, the
-combinator \texttt{hide\_atomic\_tactic} first registers the tactic
-\texttt{solveRightBranch} in the table, and returns a tactic which
-calls the interpreter with the used to register it. Hence, when the
-tactical \texttt{Info} is used, our tactic will just inform that
-\texttt{solveRightBranch} was applied, omitting all the details
-corresponding to \texttt{simplest\_right} and \texttt{discrConcl}.
-
-
-
-The third step requires some auxiliary functions for constructing the
-type $\{c_1=c_2\}+\{\neg c_1=c_2\}$ for a given inductive type $R$ and
-two constructions $c_1$ and $c_2$, and for generalizing this type over
-$c_1$ and $c_2$:
-
-\begin{verbatim}
-let mmk         = make_module_marker ["#Logic.obj";"#Specif.obj"];;
-let eqpat       = put_pat mmk "eq";;                 
-let sumboolpat  = put_pat mmk "sumbool";;             
-let notpat      = put_pat mmk "not";;   
-let eq          = get_pat eqpat;;
-let sumbool     = get_pat sumboolpat;;
-let not         = get_pat notpat;;
-
-let mkDecideEqGoal rectype c1 c2 g = 
-     let equality    = mkAppL [eq;rectype;c1;c2] in
-     let disequality = mkAppL [not;equality]
-     in  mkAppL [sumbool;equality;disequality]
-;;
-let mkGenDecideEqGoal rectype g = 
-      let hypnames = ids_of_sign (pf_hyps g) in 
-      let xname    = next_ident_away (id_of_string "x") hypnames
-      and yname    = next_ident_away (id_of_string "y") hypnames
-      in  (mkNamedProd xname rectype 
-           (mkNamedProd yname rectype 
-            (mkDecideEqGoal rectype (mkVar xname) (mkVar yname) g)))
-;;
-\end{verbatim}
-
-The tactic will depend on the \Coq modules \texttt{Logic} and
-\texttt{Specif}, since we use the constants corresponding to
-propositional equality (\texttt{eq}), computational disjunction
-(\texttt{sumbool}), and logical negation (\texttt{not}), defined in
-that modules. This is specified creating the module maker
-\texttt{mmk} (see Section~\ref{Patterns}).
-
-The third step of the procedure can be divided into three sub-steps.
-Assume that both $x$ and $y$ have been introduced by the same
-constructor.  For each corresponding pair of arguments of that
-constructor, we have to consider whether they are equal or not.  If
-they are equal, the following tactic is applied to rewrite one into
-the other:
-
-\begin{verbatim}
-let eqCase  tac = 
-         (tclTHEN intro  
-         (tclTHEN (tclLAST_HYP h_rewriteLR)
-         (tclTHEN clear_last 
-                  tac)))
-;;
-\end{verbatim}
-
-
-If they are not equal, then the goal is contraposed and a
-contradiction is reached form the invectiveness of the constructor:
-
-\begin{verbatim}
-let diseqCase = 
-    let diseq  = (id_of_string "diseq") in
-    let absurd = (id_of_string "absurd")
-    in (tclTHEN (intro_using diseq)
-       (tclTHEN  h_simplest_right
-       (tclTHEN  red_in_concl
-       (tclTHEN  (intro_using absurd)
-       (tclTHEN  (h_simplest_apply (mkVar diseq))
-       (tclTHEN  (h_injHyp absurd)
-                  trivial ))))))
-;;
-\end{verbatim}
-
-In the tactic above we have chosen to name the hypotheses because
-they have to be applied later on. This introduces a potential risk
-of name clashing if the context already contains other hypotheses 
-also named ``diseq'' or ``absurd''.
-
-We are now ready to implement the tactic \textsl{SolveArg}.  Given the
-two arguments $a_1$ and $a_2$ of the constructor, this tactic cuts the
-goal with the proposition $\{a_1=a_2\}+\{\neg a_1=a_2\}$, and then
-applies the tactics above to each of the generated cases. If the
-disjunction cannot be solved automatically, it remains as a sub-goal
-to be proven.
-
-\begin{verbatim}
-let solveArg a1 a2 tac  g = 
-     let rectype = pf_type_of g a1 in
-     let decide  = mkDecideEqGoal rectype a1 a2 g
-     in  (tclTHENS  (h_elimType decide) 
-                      [(eqCase tac);diseqCase;default_auto]) g
-;;
-\end{verbatim}
-
-The following tactic implements the third and fourth steps of the
-proof procedure:
-
-\begin{verbatim}
-let conclpatt = put_pat mmk "{<?1>?2=?3}+{?4}"
-;;
-let solveLeftBranch rectype g = 
-      let (_::(lhs::(rhs::_))) = 
-               try (dest_somatch (pf_concl g) conclpatt) 
-               with UserError ("somatch",_)-> error "Unexpected conclusion!" in
-      let nparams   = mind_nparams rectype   in
-      let getargs l = snd (chop_list nparams (snd (decomp_app l))) in
-      let rargs   = getargs rhs
-      and largs   = getargs lhs
-      in  List.fold_right2 
-             solveArg largs rargs (tclTHEN h_simplest_left h_reflexivity) g
-;;
-\end{verbatim}
-
-Notice the use of a pattern to decompose the goal and obtain the
-inductive type and the left and right hand sides of the equality. A
-certain number of arguments correspond to the general parameters of
-the type, and must be skipped over. Once the corresponding list of
-arguments \texttt{rargs} and \texttt{largs} have been obtained, the
-tactic \texttt{solveArg} is iterated on them, leaving a disjunction
-whose left half can be solved by reflexivity.
-
-The following tactic joints together the three steps of the 
-proof procedure:
-
-\begin{verbatim}
-let initialpatt = put_pat mmk "(x,y:?1){<?1>x=y}+{~(<?1>x=y)}"
-;;
-let decideGralEquality g = 
-  let (typ::_) = try (dest_somatch (pf_concl g) initialpatt)
-                 with UserError ("somatch",_) -> 
-                        error "The goal does not have the expected form" in
-  let headtyp = hd_app (pf_compute g typ) in
-  let rectype = match (kind_of_term  headtyp) with
-                 IsMutInd _ -> headtyp 
-               | _          -> error ("This decision procedure only"
-                                      " works for inductive objects") 
-  in (tclTHEN   mkBranches 
-     (tclORELSE h_solveRightBranch (solveLeftBranch rectype))) g
-;;
-;;
-\end{verbatim}
-
-The tactic above can be specialized in two different ways: either to
-decide a particular instance $\{c_1=c_2\}+\{\neg c_1=c_2\}$ of the
-universal quantification; or to eliminate this property and obtain two
-subgoals containing the hypotheses $c_1=c_2$ and $\neg c_1=c_2$
-respectively.
-
-\begin{verbatim}
-let decideGralEquality = 
-  (tclTHEN mkBranches (tclORELSE h_solveRightBranch solveLeftBranch))
-;;
-let decideEquality c1 c2 g = 
-     let rectype = pf_type_of g c1 in
-     let decide  = mkGenDecideEqGoal rectype g
-     in  (tclTHENS (cut decide) [default_auto;decideGralEquality]) g
-;;
-let compare c1 c2 g = 
-     let rectype = pf_type_of g c1 in
-     let decide  = mkDecideEqGoal rectype c1 c2 g
-     in  (tclTHENS (cut decide) 
-                [(tclTHEN  intro 
-                 (tclTHEN (tclLAST_HYP simplest_case)
-                          clear_last));
-                  decideEquality c1 c2]) g
-;;
-\end{verbatim}
-
-Next, for each of the tactics that will have an entry in the grammar
-we construct the associated dynamic one to be registered in the table
-of tactics. This function can be used to overload a tactic name with
-several similar tactics.  For example, the tactic proving the general
-decidability property and the one proving a particular instance for
-two terms can be grouped together with the following convention: if
-the user provides two terms as arguments, then the specialized tactic
-is used; if no argument is provided then the general tactic is invoked.
-
-\begin{verbatim}
-let dyn_decideEquality  args g =
-      match args with 
-       [(COMMAND com1);(COMMAND com2)]  -> 
-          let c1 = pf_constr_of_com g com1
-          and c2 = pf_constr_of_com g com2
-          in  decideEquality c1 c2 g 
-     | [] ->  decideGralEquality g
-     | _  ->  error "Invalid arguments for dynamic tactic"
-;;
-add_tactic "DecideEquality" dyn_decideEquality
-;;
-
-let dyn_compare args g =
-      match args with 
-       [(COMMAND com1);(COMMAND com2)]  -> 
-          let c1 = pf_constr_of_com g com1
-          and c2 = pf_constr_of_com g com2
-          in  compare c1 c2 g
-     | _  ->  error "Invalid arguments for dynamic tactic"
-;; 
-add_tactic "Compare" tacargs_compare
-;;
-\end{verbatim}
-
-This completes the implementation of the tactic. We turn now to the
-\Coq file \texttt{Eqdecide.v}.
-
-
-\subsection{The Grammar Rules}
-
-Associated to the implementation of the tactic there is a \Coq\ file
-containing the grammar and pretty-printing rules for the new tactic,
-and the commands to generate an object module that can be then loaded
-dynamically during a \Coq\ session. In order to generate an ML module,
-the \Coq\ file must contain a
-\texttt{Declare ML module} command for all the \ocaml{} files concerning
-the implementation of the tactic --in our case there is only one file,
-the file \texttt{eqdecide.ml}: 
-
-\begin{verbatim}
-Declare ML Module "eqdecide".
-\end{verbatim}
-
-The following grammar and pretty-printing rules are
-self-explanatory. We refer the reader to the Section \ref{Grammar} for
-the details:
-
-\begin{verbatim}
-Grammar tactic simple_tactic :=
-  EqDecideRuleG1 
-       [ "Decide"  "Equality" comarg($com1)  comarg($com2)] -> 
-       [(DecideEquality $com1 $com2)]
-| EqDecideRuleG2 
-       [ "Decide" "Equality"  ] -> 
-       [(DecideEquality)]
-| CompareRule 
-       [ "Compare" comarg($com1) comarg($com2)] -> 
-       [(Compare $com1 $com2)].
-
-Syntax tactic level 0:
-  EqDecideRulePP1 
-       [(DecideEquality)]   -> 
-       ["Decide" "Equality"]
-| EqDecideRulePP2 
-       [(DecideEquality $com1 $com2)]   -> 
-       ["Decide" "Equality" $com1 $com2]
-| ComparePP 
-       [(Compare $com1 $com2)] -> 
-       ["Compare" $com1 $com2].
-\end{verbatim}
-
-
-\paragraph{Important:} The names used to label the abstract syntax tree 
-in the grammar rules ---in this case ``DecideEquality'' and
-``Compare''--- must be the same as the name used to register the
-tactic in the tactics table. This is what makes the links between the
-input entered by the user and the tactic executed by the interpreter.
-
-\subsection{Loading the Tactic}
-
-Once the module \texttt{EqDecide.v} has been compiled, the tactic can
-be dynamically loaded using the \texttt{Require} command. 
-
-\begin{coq_example}
-Require EqDecide.
-Goal (x,y:nat){x=y}+{~x=y}.
-Decide Equality.
-\end{coq_example}
-
-The implementation of the tactic can be accessed through the
-tactical \texttt{Info}:
-\begin{coq_example}
-Undo.
-Info Decide Equality.
-\end{coq_example}
-\begin{coq_eval}
-Abort.
-\end{coq_eval}
-
-Remark that the task performed by the tactic \texttt{solveRightBranch}
-is not displayed, since we have chosen to hide its implementation.
-
-\section[Testing and Debugging your Tactic]{Testing and Debugging your Tactic\label{test-and-debug}}
-
-When your tactic does not behave as expected, it is possible to trace
-it dynamically from \Coq. In order to do this, you have first to leave
-the toplevel of \Coq, and come back to the \ocaml{} interpreter. This can
-be done using the command \texttt{Drop} (see Section~\ref{Drop}). Once
-in the \ocaml{} toplevel, load the file \texttt{tactics/include.ml}.
-This file installs several pretty printers for proof trees, goals,
-terms, abstract syntax trees, names, etc.  It also contains the
-function \texttt{go:unit -> unit} that enables to go back to \Coq's
-toplevel. 
-
-The modules \texttt{Tacmach} and \texttt{Pfedit} contain some basic
-functions for extracting information from the state of the proof
-engine. Such functions can be used to debug your tactic if
-necessary. Let us mention here some of them:
-
-\begin{description}
-\fun{val get\_pftreestate         : unit -> pftreestate}
-    {Projects the current state of the proof engine.}
-\fun{val proof\_of\_pftreestate    : pftreestate -> proof}
-    {Projects the current state of the proof tree. A pretty-printer 
-      displays it in a readable form.  }
-\fun{val top\_goal\_of\_pftreestate : pftreestate -> goal sigma}
-    {Projects the goal and the existential variables mapping from
-     the current state of the proof engine.} 
-\fun{val nth\_goal\_of\_pftreestate : int -> pftreestate -> goal sigma}
-    {Projects the goal and mapping corresponding to the $nth$ subgoal
-     that remains to be proven}
-\fun{val traverse                : int -> pftreestate -> pftreestate}
-    {Yields the children of the node that the current state of the 
-     proof engine points to.}
-\fun{val solve\_nth\_pftreestate   : \\ \qquad
-int -> tactic -> pftreestate ->  pftreestate}
-     {\\ Provides the new state of the proof engine obtained applying 
-      a given tactic to some unproven sub-goal.}
-\end{description}
-
-Finally, the traditional \ocaml{} debugging tools like the directives
-\texttt{trace} and \texttt{untrace} can be used to follow the
-execution of your functions. Frequently, a better solution is to use
-the \ocaml{} debugger, see Chapter \ref{Utilities}.
-
-\section[Concrete syntax for ML tactic and vernacular command]{Concrete syntax for ML tactic and vernacular command\label{Notations-for-ML-command}}
-
-\subsection{The general case}
-
-The standard way to bind an ML-written tactic or vernacular command to
-a concrete {\Coq} syntax is to use the
-\verb=TACTIC EXTEND= and \verb=VERNAC COMMAND EXTEND= macros.
-
-These macros can be used in any {\ocaml} file defining a (new) ML tactic
-or vernacular command. They are expanded into pure {\ocaml} code by
-the {\camlpppp} preprocessor of {\ocaml}. Concretely, files that use
-these macros need to be compiled by giving to {\tt ocamlc} the option 
-
-\verb=-pp "camlp4o -I $(COQTOP)/parsing grammar.cma pa_extend.cmo"=
-
-\noindent which is the default for every file compiled by means of a Makefile
-generated by {\tt coq\_makefile} (see Chapter~\ref{Addoc-coqc}). So,
-just do \verb=make= in this latter case.
-
-The syntax of the macros is given on figure
-\ref{EXTEND-syntax}. They can be used at any place of an {\ocaml}
-files where an ML sentence (called \verb=str_item= in the {\tt ocamlc}
-parser) is expected. For each rule, the left-hand-side describes the
-grammar production and the right-hand-side its interpretation which
-must be an {\ocaml} expression. Each grammar production starts with
-the concrete name of the tactic or command in {\Coq} and is followed
-by arguments, possibly separated by terminal symbols or words.
-Here is an example:
-
-\begin{verbatim}
-TACTIC EXTEND Replace
-  [ "replace" constr(c1) "with" constr(c2) ] -> [ replace c1 c2 ]
-END
-\end{verbatim}
-
-\newcommand{\grule}{\textrm{\textsl{rule}}}
-\newcommand{\stritem}{\textrm{\textsl{ocaml\_str\_item}}}
-\newcommand{\camlexpr}{\textrm{\textsl{ocaml\_expr}}}
-\newcommand{\arginfo}{\textrm{\textsl{argument\_infos}}}
-\newcommand{\lident}{\textrm{\textsl{lower\_ident}}}
-\newcommand{\argument}{\textrm{\textsl{argument}}}
-\newcommand{\entry}{\textrm{\textsl{entry}}}
-\newcommand{\argtype}{\textrm{\textsl{argtype}}}
-
-\begin{figure}
-\begin{tabular}{|lcll|}
-\hline
-{\stritem}
- & ::= & 
-\multicolumn{2}{l|}{{\tt TACTIC EXTEND} {\ident} \nelist{\grule}{$|$} {\tt END}}\\
- & $|$ & \multicolumn{2}{l|}{{\tt VERNAC COMMAND EXTEND} {\ident} \nelist{\grule}{$|$} {\tt END}}\\
-&&\multicolumn{2}{l|}{}\\
-{\grule} & ::= & 
-\multicolumn{2}{l|}{{\tt [} {\str} \sequence{\argument}{} {\tt ] -> [} {\camlexpr} {\tt ]}}\\
-&&\multicolumn{2}{l|}{}\\
-{\argument} & ::= & {\str} &\mbox{(terminal)}\\
- & $|$ & {\entry} {\tt (} {\lident} {\tt )} &\mbox{(non-terminal)}\\
-&&\multicolumn{2}{l|}{}\\
-{\entry} 
- & ::= & {\tt string} & (a string)\\
- & $|$ & {\tt preident} & (an identifier typed as a {\tt string})\\
- & $|$ & {\tt ident} & (an identifier of type {\tt identifier})\\
- & $|$ & {\tt global} & (a qualified identifier)\\
- & $|$ & {\tt constr} & (a {\Coq} term)\\
- & $|$ & {\tt openconstr} & (a {\Coq} term with holes)\\
- & $|$ & {\tt sort} & (a {\Coq} sort)\\
- & $|$ & {\tt tactic} & (an ${\cal L}_{tac}$ expression)\\
- & $|$ & {\tt constr\_with\_bindings} & (a {\Coq} term with a list of bindings\footnote{as for the tactics {\tt apply} and {\tt elim}})\\
- & $|$ & {\tt int\_or\_var} & (an integer or an identifier denoting an integer)\\
- & $|$ & {\tt quantified\_hypothesis} & (a quantified hypothesis\footnote{as for the tactics {\tt intros until}})\\
- & $|$ & {\tt {\entry}\_opt} & (an optional {\entry} )\\
- & $|$ & {\tt ne\_{\entry}\_list} & (a non empty list of {\entry})\\
- & $|$ & {\tt {\entry}\_list} & (a list of {\entry})\\
- & $|$ & {\tt bool} & (a boolean: no grammar rule, just for typing)\\
- & $|$ & {\lident} & (a user-defined entry)\\
-\hline
-\end{tabular}
-\caption{Syntax of the macros binding {\ocaml} tactics or commands to a {\Coq} syntax}
-\label{EXTEND-syntax}
-\end{figure}
-
-There is a set of predefined non-terminal entries which are
-automatically translated into an {\ocaml} object of a given type. The
-type is not the same for tactics and for vernacular commands. It is
-given in the following table:
-
-\begin{small}
-\noindent \begin{tabular}{|l|l|l|}
-\hline
-{\entry} & {\it type for tactics} & {\it type for commands} \\
-{\tt string} & {\tt string} & {\tt string}\\
-{\tt preident} & {\tt string} & {\tt string}\\
-{\tt ident} & {\tt identifier} & {\tt identifier}\\
-{\tt global} & {\tt global\_reference} & {\tt qualid}\\
-{\tt constr} & {\tt constr} & {\tt constr\_expr}\\
-{\tt openconstr} & {\tt open\_constr} & {\tt constr\_expr}\\
-{\tt sort} & {\tt sorts} & {\tt rawsort}\\
-{\tt tactic} & {\tt glob\_tactic\_expr * tactic} & {\tt raw\_tactic\_expr}\\
-{\tt constr\_with\_bindings} & {\tt constr with\_bindings} & {\tt constr\_expr with\_bindings}\\\\
-{\tt int\_or\_var} & {\tt int or\_var} & {\tt int or\_var}\\
-{\tt quantified\_hypothesis} & {\tt quantified\_hypothesis} & {\tt quantified\_hypothesis}\\
-{\tt {\entry}\_opt} & {\it the type of entry} {\tt option} & {\it the type of entry} {\tt option}\\
-{\tt ne\_{\entry}\_list} & {\it the type of entry} {\tt list} & {\it the type of entry} {\tt list}\\
-{\tt {\entry}\_list} & {\it the type of entry} {\tt list} & {\it the type of entry} {\tt list}\\
-{\tt bool} & {\tt bool} & {\tt bool}\\
-{\lident} & {user-provided, cf next section} & {user-provided, cf next section}\\
-\hline
-\end{tabular}
-\end{small}
-
-\bigskip
-
-Notice that {\entry} consists in a single identifier and that the {\tt
-\_opt}, {\tt \_list}, ... modifiers are part of the identifier.
-Here is now another example of a tactic which takes either a non empty
-list of identifiers and executes the {\ocaml} function {\tt subst} or
-takes no arguments and executes the{\ocaml} function {\tt subst\_all}.
-
-\begin{verbatim}
-TACTIC EXTEND Subst
-| [ "subst" ne_ident_list(l) ] -> [ subst l ]
-| [ "subst" ] -> [ subst_all ]
-END
-\end{verbatim}
-
-\subsection{Adding grammar entries for tactic or command arguments}
-
-In case parsing the arguments of the tactic or the vernacular command
-involves grammar entries other than the predefined entries listed
-above, you have to declare a new entry using the macros
-\verb=ARGUMENT EXTEND= or \verb=VERNAC ARGUMENT EXTEND=. The syntax is
-given on Figure~\ref{ARGUMENT-EXTEND-syntax}. Notice that arguments
-declared by \verb=ARGUMENT EXTEND= can be used for arguments of both
-tactics and vernacular commands while arguments declared by
-\verb=VERNAC ARGUMENT EXTEND= can only be used by vernacular commands.
-
-For \verb=VERNAC ARGUMENT EXTEND=, the identifier is the name of the
-entry and it must be a valid {\ocaml} identifier (especially it must
-be lowercase).  The grammar rules works as before except that they do
-not have to start by a terminal symbol or word.  As an example, here
-is how the {\Coq} {\tt Extraction Language {\it language}} parses its
-argument:
-
-\begin{verbatim}
-VERNAC ARGUMENT EXTEND language
-| [ "Ocaml" ] -> [ Ocaml ]
-| [ "Haskell" ] -> [ Haskell ]
-| [ "Scheme" ] -> [ Scheme ]
-END
-\end{verbatim}
-
-For tactic arguments, and especially for \verb=ARGUMENT EXTEND=, the
-procedure is more subtle because tactics are objects of the {\Coq}
-environment which can be printed and interpreted. Then the syntax
-requires extra information providing a printer and a type telling how
-the argument behaves. Here is an example of entry parsing a pair of
-optional {\Coq} terms.
-
-\begin{verbatim}
-let pp_minus_div_arg pr_constr pr_tactic (omin,odiv) = 
-  if omin=None && odiv=None then mt() else
-    spc() ++ str "with" ++
-    pr_opt (fun c -> str "minus := " ++ pr_constr c) omin ++
-    pr_opt (fun c -> str "div := " ++ pr_constr c) odiv
-
-ARGUMENT EXTEND minus_div_arg 
-  TYPED AS constr_opt * constr_opt
-  PRINTED BY pp_minus_div_arg
-| [ "with" minusarg(m) divarg_opt(d) ] -> [ Some m, d ]
-| [ "with" divarg(d) minusarg_opt(m) ] -> [ m, Some d ]
-| [ ] -> [ None, None ]
-END
-\end{verbatim}
-
-Notice that the type {\tt constr\_opt * constr\_opt} tells that the
-object behaves as a pair of optional {\Coq} terms, i.e. as an object
-of {\ocaml} type {\tt constr option * constr option} if in a
-\verb=TACTIC EXTEND= macro and of type {\tt constr\_expr option *
-constr\_expr option} if in a \verb=VERNAC COMMAND EXTEND= macro.
-
-As for the printer, it must be a function expecting a printer for
-terms, a printer for tactics and returning a printer for the created
-argument. Especially, each sub-{\term} and each sub-{\tac} in the
-argument must be typed by the corresponding printers. Otherwise, the
-{\ocaml} code will not be well-typed.
-
-\Rem The entry {\tt bool} is bound to no syntax but it can be used to
-give the type of an argument as in the following example:
-
-\begin{verbatim}
-let pr_orient _prc _prt = function
-  | true -> mt ()
-  | false -> str " <-"
-
-ARGUMENT EXTEND orient TYPED AS bool PRINTED BY pr_orient
-| [ "->" ] -> [ true ]
-| [ "<-" ] -> [ false ]
-| [ ] -> [ true ]
-END
-\end{verbatim}
-
-\begin{figure}
-\begin{tabular}{|lcl|}
-\hline
-{\stritem} & ::= & 
- {\tt ARGUMENT EXTEND} {\ident} {\arginfo} {\nelist{\grule}{$|$}} {\tt END}\\
-& $|$ & {\tt VERNAC ARGUMENT EXTEND} {\ident} {\nelist{\grule}{$|$}} {\tt END}\\
-\\
-{\arginfo} & ::= & {\tt TYPED AS} {\argtype} \\
-&& {\tt PRINTED BY} {\lident} \\
-%&& \zeroone{{\tt INTERPRETED BY} {\lident}}\\
-%&& \zeroone{{\tt GLOBALIZED BY} {\lident}}\\
-%&& \zeroone{{\tt SUBSTITUTED BY} {\lident}}\\
-%&& \zeroone{{\tt RAW\_TYPED AS} {\lident} {\tt RAW\_PRINTED BY} {\lident}}\\
-%&& \zeroone{{\tt GLOB\_TYPED AS} {\lident} {\tt GLOB\_PRINTED BY} {\lident}}\\
-\\
-{\argtype} & ::= & {\argtype} {\tt *} {\argtype} \\ 
-& $|$ & {\entry} \\
-\hline
-\end{tabular}
-\caption{Syntax of the macros binding {\ocaml} tactics or commands to a {\Coq} syntax}
-\label{ARGUMENT-EXTEND-syntax}
-\end{figure}
-
-%\end{document}
diff --git a/doc/refman/RefMan-uti.tex b/doc/refman/RefMan-uti.tex
index f6371f8e5..962aa98b6 100644
--- a/doc/refman/RefMan-uti.tex
+++ b/doc/refman/RefMan-uti.tex
@@ -1,55 +1,27 @@
 \chapter[Utilities]{Utilities\label{Utilities}}
+%HEVEA\cutname{tools.html}
 
 The distribution provides utilities to simplify some tedious works
 beside proof development, tactics writing or documentation.
 
-\section[Building a toplevel extended with user tactics]{Building a toplevel extended with user tactics\label{Coqmktop}\ttindex{coqmktop}}
+\section[Using Coq as a library]{Using Coq as a library}
 
-The native-code version of \Coq\ cannot dynamically load user tactics
-using {\ocaml} code. It is possible to build a toplevel of \Coq,
-with {\ocaml} code statically linked, with the tool {\tt
-  coqmktop}.
-
-For example, one can build a native-code \Coq\ toplevel extended with a tactic
-which source is in {\tt tactic.ml} with the command
-\begin{verbatim}
-     % coqmktop -opt -o mytop.out tactic.cmx
-\end{verbatim}
-where {\tt tactic.ml} has been compiled with the native-code
-compiler {\tt ocamlopt}. This command generates an executable
-called {\tt mytop.out}. To use this executable to compile your \Coq\
-files, use {\tt coqc -image mytop.out}.
-
-A basic example is the native-code version of \Coq\ ({\tt coqtop.opt}),
-which can be generated by {\tt coqmktop -opt -o coqopt.opt}.
-
-
-\paragraph[Application: how to use the {\ocaml} debugger with Coq.]{Application: how to use the {\ocaml} debugger with Coq.\index{Debugger}}
-
-One useful application of \texttt{coqmktop} is to build a \Coq\ toplevel in
-order to debug your tactics with the {\ocaml} debugger.
-You need to have configured and compiled \Coq\ for debugging
-(see the file \texttt{INSTALL} included in the distribution).
-Then, you must compile the Caml modules of your tactic with the
-option \texttt{-g} (with the bytecode compiler) and build a stand-alone
-bytecode toplevel with the following command:
+In previous versions, \texttt{coqmktop} was used to build custom
+toplevels --- for example for better debugging or custom static
+linking. Nowadays, the preferred method is to use \texttt{ocamlfind}.
 
+The most basic custom toplevel is built using:
 \begin{quotation}
-\texttt{\% coqmktop -g -o coq-debug}~\emph{<your \texttt{.cmo} files>}
+\texttt{\% ocamlfind ocamlopt -thread -rectypes -linkall -linkpkg
+  -package coq.toplevel toplevel/coqtop\_bin.ml -o my\_toplevel.native}
 \end{quotation}
 
-
-To launch the \ocaml\ debugger with the image you need to execute it in
-an environment which correctly sets the \texttt{COQLIB} variable.
-Moreover, you have to indicate the directories in which
-\texttt{ocamldebug} should search for Caml modules.
-
-A possible solution is to use a wrapper around \texttt{ocamldebug}
-which detects the executables containing the word \texttt{coq}. In
-this case, the debugger is called with the required additional
-arguments. In other cases, the debugger is simply called without additional
-arguments. Such a wrapper can be found in the \texttt{dev/}
-subdirectory of the sources.
+For example, to statically link LTAC, you can just do:
+\begin{quotation}
+\texttt{\% ocamlfind ocamlopt -thread -rectypes -linkall -linkpkg
+  -package coq.toplevel -package coq.ltac toplevel/coqtop\_bin.ml -o my\_toplevel.native}
+\end{quotation}
+and similarly for other plugins.
 
 %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
@@ -133,6 +105,7 @@ The optional file {\tt CoqMakefile.local} is included by the generated file
 	  compiler, like {\tt -bin-annot} or {\tt -w...}.
   \item[COQC, COQDEP, COQDOC] can be set in order to use alternative 
 	  binaries (e.g. wrappers)
+  \item[COQ\_SRC\_SUBDIRS] can be extended by including other paths in which {\tt *.cm*} files are searched. For example {\tt COQ\_SRC\_SUBDIRS+=user-contrib/Unicoq} lets you build a plugin containing OCaml code that depends on the OCaml code of {\tt Unicoq}.
   \end{description}
 \item[Rule extension]
   The following makefile rules can be extended. For example
@@ -465,7 +438,7 @@ the \Coq\ language, and also a rudimentary indentation facility:
 \end{itemize}
 
 An inferior mode to run \Coq\ under Emacs, by Marco Maggesi, is also
-included in the distribution, in file \texttt{coq-inferior.el}.
+included in the distribution, in file \texttt{inferior-coq.el}.
 Instructions to use it are contained in this file.
 
 \subsection[{\ProofGeneral}]{{\ProofGeneral}\index{Proof General@{\ProofGeneral}}}
diff --git a/doc/refman/Setoid.tex b/doc/refman/Setoid.tex
index 6c7928438..b7b343112 100644
--- a/doc/refman/Setoid.tex
+++ b/doc/refman/Setoid.tex
@@ -1,6 +1,7 @@
 \newtheorem{cscexample}{Example}
 
 \achapter{\protect{Generalized rewriting}}
+%HEVEA\cutname{setoid.html}
 \aauthor{Matthieu Sozeau}
 \label{setoids}
 
@@ -223,7 +224,7 @@ the following command.
 
 \comindex{Add Parametric Morphism}
 \begin{quote}
-  \texttt{Add Parametric Morphism} ($x_1 : \T_!$) \ldots ($x_k : \T_k$)\\
+  \texttt{Add Parametric Morphism} ($x_1 : \T_1$) \ldots ($x_k : \T_k$) :
   (\textit{f $t_1$ \ldots $t_n$})\\
   \texttt{~with signature} \textit{sig}\\
   \texttt{~as id}.\\
diff --git a/doc/refman/Universes.tex b/doc/refman/Universes.tex
index 6ea253739..6c84a1818 100644
--- a/doc/refman/Universes.tex
+++ b/doc/refman/Universes.tex
@@ -1,4 +1,5 @@
 \achapter{Polymorphic Universes}
+%HEVEA\cutname{universes.html}
 \aauthor{Matthieu Sozeau}
 
 \label{Universes-full}
@@ -67,6 +68,13 @@ is only valid as long as \texttt{Top.4} is strictly smaller than
 monomorphic (not universe polymorphic), so the two universes
 (in this case \texttt{Top.3} and \texttt{Top.4}) are actually global levels.
 
+When printing \texttt{pidentity}, we can see the universes it binds in
+the annotation \texttt{@\{Top.2\}}. Additionally, when \texttt{Set
+  Printing Universes} is on we print the ``universe context'' of
+\texttt{pidentity} consisting of the bound universes and the
+constraints they must verify (for \texttt{pidentity} there are no
+constraints).
+
 Inductive types can also be declared universes polymorphic on universes
 appearing in their parameters or fields. A typical example is given by
 monoids:
@@ -137,7 +145,7 @@ producing global universe constraints, one can use the
 \optindex{Polymorphic Inductive Cumulativity}
 
 Polymorphic inductive types, coinductive types, variants and records can be
-declared cumulative using the \texttt{Cumulative}. Alternatively,
+declared cumulative using the \texttt{Cumulative} prefix. Alternatively,
 there is an option \texttt{Set Polymorphic Inductive Cumulativity} which when set,
 makes all subsequent \emph{polymorphic} inductive definitions cumulative.  When set,
 inductive types and the like can be enforced to be
@@ -150,15 +158,22 @@ Polymorphic Cumulative Inductive list {A : Type} :=
 \begin{coq_example}
 Print list.
 \end{coq_example}
-When printing \texttt{list}, the part of the output of the form
-\texttt{$\mathtt{\sim}$@\{i\} <= $\mathtt{\sim}$@\{j\} iff }
-indicates the universe constraints in order to have the subtyping
-$\WTEGLECONV{\mathtt{list@\{i\}} A}{\mathtt{list@\{j\}} B}$
-(for fully applied instances of \texttt{list}) whenever $\WTEGCONV{A}{B}$.
-In the case of \texttt{list} there is no constraint!
-This also means that any two instances of \texttt{list} are convertible:
-$\WTEGCONV{\mathtt{list@\{i\}} A}{\mathtt{list@\{j\}} B}$ whenever $\WTEGCONV{A}{B}$ and
-furthermore their corresponding (when fully applied to convertible arguments) constructors.
+When printing \texttt{list}, the universe context indicates the
+subtyping constraints by prefixing the level names with symbols.
+
+Because inductive subtypings are only produced by comparing inductives
+to themselves with universes changed, they amount to variance
+information: each universe is either invariant, covariant or
+irrelevant (there are no contravariant subtypings in Coq),
+respectively represented by the symbols \texttt{=}, \texttt{+} and
+\texttt{*}.
+
+Here we see that \texttt{list} binds an irrelevant universe, so any
+two instances of \texttt{list} are convertible:
+$\WTEGCONV{\mathtt{list@\{i\}} A}{\mathtt{list@\{j\}} B}$ whenever
+$\WTEGCONV{A}{B}$ and furthermore their corresponding (when fully
+applied to convertible arguments) constructors.
+
 See Chapter~\ref{Cic} for more details on convertibility and subtyping.
 The following is an example of a record with non-trivial subtyping relation:
 \begin{coq_example*}
@@ -167,8 +182,9 @@ Polymorphic Cumulative Record packType := {pk : Type}.
 \begin{coq_example}
 Print packType.
 \end{coq_example}
-Notice that as expected, \texttt{packType@\{i\}} and \texttt{packType@\{j\}} are
-convertible if and only if \texttt{i $=$ j}.
+\texttt{packType} binds a covariant universe, i.e.
+$\WTEGCONV{\mathtt{packType@\{i\}}}{\mathtt{packType@\{j\}}}$ whenever
+\texttt{i $\leq$ j}.
 
 Cumulative inductive types, coninductive types, variants and records
 only make sense when they are universe polymorphic. Therefore, an
@@ -284,8 +300,10 @@ universes and explicitly instantiate polymorphic definitions.
   \label{UniverseCmd}}
 
 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
+{\ident}, which can be referred to using its qualified name as
+well. Global universe names live in a separate namespace. The command
+supports the polymorphic flag only in sections, meaning the universe
+quantification will be discharged on each section definition
 independently. One cannot mix polymorphic and monomorphic declarations
 in the same section.
 
diff --git a/doc/refman/coqide-queries.png b/doc/refman/coqide-queries.png
index dea5626f8..7a46ac4e6 100644
--- a/doc/refman/coqide-queries.png
+++ b/doc/refman/coqide-queries.png
diff --git a/doc/refman/coqide.png b/doc/refman/coqide.png
index a6a0f5850..e300401c9 100644
--- a/doc/refman/coqide.png
+++ b/doc/refman/coqide.png
diff --git a/doc/refman/index.html b/doc/refman/index.html
index 9b5250abc..b937350e6 100644
--- a/doc/refman/index.html
+++ b/doc/refman/index.html
@@ -11,4 +11,4 @@
   <FRAME SRC="menu.html">
 </FRAMESET>
 
-</HTML>
\ No newline at end of file
+</HTML>
diff --git a/doc/stdlib/index-list.html.template b/doc/stdlib/index-list.html.template
index 48048b7a0..95e541f81 100644
--- a/doc/stdlib/index-list.html.template
+++ b/doc/stdlib/index-list.html.template
@@ -18,6 +18,7 @@ through the <tt>Require Import</tt> command.</p>
     theories/Init/Logic.v
     theories/Init/Logic_Type.v
     theories/Init/Nat.v
+    theories/Init/Decimal.v
     theories/Init/Peano.v
     theories/Init/Specif.v
     theories/Init/Tactics.v
@@ -225,6 +226,12 @@ through the <tt>Require Import</tt> command.</p>
     theories/Numbers/BinNums.v
     theories/Numbers/NumPrelude.v
     theories/Numbers/NaryFunctions.v
+    theories/Numbers/DecimalFacts.v
+    theories/Numbers/DecimalNat.v
+    theories/Numbers/DecimalPos.v
+    theories/Numbers/DecimalN.v
+    theories/Numbers/DecimalZ.v
+    theories/Numbers/DecimalString.v
     </dd>
 
     <dt> <b>&nbsp;&nbsp;NatInt</b>:
diff --git a/engine/eConstr.ml b/engine/eConstr.ml
index 7b879a803..9ac16b5b4 100644
--- a/engine/eConstr.ml
+++ b/engine/eConstr.ml
@@ -9,7 +9,7 @@
 open CErrors
 open Util
 open Names
-open Term
+open Constr
 open Context
 open Evd
 
@@ -34,7 +34,7 @@ end
 type t
 val kind : Evd.evar_map -> t -> (t, t, ESorts.t, EInstance.t) Constr.kind_of_term
 val kind_upto : Evd.evar_map -> constr -> (constr, types, Sorts.t, Univ.Instance.t) Constr.kind_of_term
-val kind_of_type : Evd.evar_map -> t -> (t, t) kind_of_type
+val kind_of_type : Evd.evar_map -> t -> (t, t) Term.kind_of_type
 val whd_evar : Evd.evar_map -> t -> t
 val of_kind : (t, t, ESorts.t, EInstance.t) Constr.kind_of_term -> t
 val of_constr : Constr.t -> t
@@ -54,7 +54,7 @@ struct
   type t = Sorts.t
   let make s = s
   let kind sigma = function
-  | Type u -> sort_of_univ (Evd.normalize_universe sigma u)
+  | Sorts.Type u -> Sorts.sort_of_univ (Evd.normalize_universe sigma u)
   | s -> s
   let unsafe_to_sorts s = s
 end
@@ -114,7 +114,7 @@ let rec to_constr sigma c = match Constr.kind c with
   | Some c -> to_constr sigma c
   | None -> Constr.map (fun c -> to_constr sigma c) c
   end
-| Sort (Type u) ->
+| Sort (Sorts.Type u) ->
   let u' = Evd.normalize_universe sigma u in
   if u' == u then c else mkSort (Sorts.sort_of_univ u')
 | Const (c', u) when not (Univ.Instance.is_empty u) ->
@@ -150,6 +150,8 @@ type rel_declaration = (constr, types) Context.Rel.Declaration.pt
 type named_context = (constr, types) Context.Named.pt
 type rel_context = (constr, types) Context.Rel.pt
 
+type 'a puniverses = 'a * EInstance.t
+
 let in_punivs a = (a, EInstance.empty)
 
 let mkProp = of_kind (Sort (ESorts.make Sorts.prop))
@@ -566,7 +568,6 @@ let compare_constr sigma cmp c1 c2 =
   let cmp c1 c2 = cmp (of_constr c1) (of_constr c2) in
   compare_gen kind (fun _ -> Univ.Instance.equal) Sorts.equal cmp (unsafe_to_constr c1) (unsafe_to_constr c2)
 
-(** TODO: factorize with universes.ml *)
 let test_constr_universes sigma leq m n =
   let open Universes in
   let kind c = kind_upto sigma c in
@@ -574,14 +575,20 @@ let test_constr_universes sigma leq m n =
   else 
     let cstrs = ref Constraints.empty in
     let eq_universes strict l l' = 
+      let l = EInstance.kind sigma (EInstance.make l) in
+      let l' = EInstance.kind sigma (EInstance.make l') in
       cstrs := enforce_eq_instances_univs strict l l' !cstrs; true in
     let eq_sorts s1 s2 = 
+      let s1 = ESorts.kind sigma (ESorts.make s1) in
+      let s2 = ESorts.kind sigma (ESorts.make s2) in
       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 leq_sorts s1 s2 = 
+      let s1 = ESorts.kind sigma (ESorts.make s1) in
+      let s2 = ESorts.kind sigma (ESorts.make s2) in
       if Sorts.equal s1 s2 then true
       else 
 	(cstrs := Constraints.add 
@@ -640,6 +647,37 @@ let eq_constr_universes_proj env sigma m n =
     let res = eq_constr' (unsafe_to_constr m) (unsafe_to_constr n) in
     if res then Some !cstrs else None
 
+let universes_of_constr env sigma c =
+  let open Univ in
+  let open Declarations in
+  let rec aux s c =
+    match kind sigma c with
+    | Const (c, u) ->
+      begin match (Environ.lookup_constant c env).const_universes with
+        | Polymorphic_const _ ->
+          LSet.fold LSet.add (Instance.levels (EInstance.kind sigma u)) s
+        | Monomorphic_const (univs, _) ->
+          LSet.union s univs
+      end
+    | Ind ((mind,_), u) | Construct (((mind,_),_), u) ->
+      begin match (Environ.lookup_mind mind env).mind_universes with
+        | Cumulative_ind _ | Polymorphic_ind _ ->
+          LSet.fold LSet.add (Instance.levels (EInstance.kind sigma u)) s
+        | Monomorphic_ind (univs,_) ->
+          LSet.union s univs
+      end
+    | Sort u ->
+       let sort = ESorts.kind sigma u in
+       if Sorts.is_small sort then s
+       else
+         let u = Sorts.univ_of_sort sort in
+         LSet.fold LSet.add (Universe.levels u) s
+    | Evar (k, args) ->
+       let concl = Evd.evar_concl (Evd.find sigma k) in
+       fold sigma aux (aux s (of_constr concl)) c
+    | _ -> fold sigma aux s c
+  in aux LSet.empty c
+
 open Context
 open Environ
 
@@ -657,6 +695,10 @@ let cast_rel_context :
   type a b. (a,b) eq -> (a, a) Rel.pt -> (b, b) Rel.pt =
   fun Refl x -> x
 
+let cast_rec_decl :
+  type a b. (a,b) eq -> (a, a) Constr.prec_declaration -> (b, b) Constr.prec_declaration =
+  fun Refl x -> x
+
 let cast_named_decl :
   type a b. (a,b) eq -> (a, a) Named.Declaration.pt -> (b, b) Named.Declaration.pt =
   fun Refl x -> x
@@ -732,6 +774,20 @@ let rec isArity sigma c =
   | Sort _          -> true
   | _               -> false
 
+type arity = rel_context * ESorts.t
+
+let destArity sigma =
+  let open Context.Rel.Declaration in
+  let rec prodec_rec l c =
+    match kind sigma c with
+    | Prod (x,t,c)    -> prodec_rec (LocalAssum (x,t) :: l) c
+    | LetIn (x,b,t,c) -> prodec_rec (LocalDef (x,b,t) :: l) c
+    | Cast (c,_,_)      -> prodec_rec l c
+    | Sort s          -> l,s
+    | _               -> anomaly ~label:"destArity" (Pp.str "not an arity.")
+  in
+  prodec_rec []
+
 let mkProd_or_LetIn decl c =
   let open Context.Rel.Declaration in
   match decl with
@@ -765,6 +821,7 @@ let it_mkLambda_or_LetIn t ctx = List.fold_left (fun c d -> mkLambda_or_LetIn d
 
 let push_rel d e = push_rel (cast_rel_decl unsafe_eq d) e
 let push_rel_context d e = push_rel_context (cast_rel_context unsafe_eq d) e
+let push_rec_types d e = push_rec_types (cast_rec_decl unsafe_eq d) e
 let push_named d e = push_named (cast_named_decl unsafe_eq d) e
 let push_named_context d e = push_named_context (cast_named_context unsafe_eq d) e
 let push_named_context_val d e = push_named_context_val (cast_named_decl unsafe_eq d) e
@@ -779,6 +836,15 @@ let lookup_rel i e = cast_rel_decl (sym unsafe_eq) (lookup_rel i e)
 let lookup_named n e = cast_named_decl (sym unsafe_eq) (lookup_named n e)
 let lookup_named_val n e = cast_named_decl (sym unsafe_eq) (lookup_named_val n e)
 
+let map_rel_context_in_env f env sign =
+  let rec aux env acc = function
+    | d::sign ->
+        aux (push_rel d env) (Context.Rel.Declaration.map_constr (f env) d :: acc) sign
+    | [] ->
+        acc
+  in
+  aux env [] (List.rev sign)
+
 let fresh_global ?loc ?rigid ?names env sigma reference =
   let (evd,t) = Evd.fresh_global ?loc ?rigid ?names env sigma reference in
   evd, of_constr t
diff --git a/engine/eConstr.mli b/engine/eConstr.mli
index 4dbf6c18a..6fa338c73 100644
--- a/engine/eConstr.mli
+++ b/engine/eConstr.mli
@@ -56,6 +56,8 @@ sig
   val is_empty : t -> bool
 end
 
+type 'a puniverses = 'a * EInstance.t
+
 (** {5 Destructors} *)
 
 val kind : Evd.evar_map -> t -> (t, t, ESorts.t, EInstance.t) Constr.kind_of_term
@@ -93,14 +95,14 @@ val mkEvar : t pexistential -> t
 val mkSort : Sorts.t -> t
 val mkProp : t
 val mkSet  : t
-val mkType : Univ.universe -> t
+val mkType : Univ.Universe.t -> t
 val mkCast : t * cast_kind * t -> t
 val mkProd : Name.t * t * t -> t
 val mkLambda : Name.t * t * t -> t
 val mkLetIn : Name.t * t * t * t -> t
 val mkApp : t * t array -> t
-val mkConst : constant -> t
-val mkConstU : constant * EInstance.t -> t
+val mkConst : Constant.t -> t
+val mkConstU : Constant.t * EInstance.t -> t
 val mkProj : (projection * t) -> t
 val mkInd : inductive -> t
 val mkIndU : inductive * EInstance.t -> t
@@ -144,7 +146,11 @@ val isFix : Evd.evar_map -> t -> bool
 val isCoFix : Evd.evar_map -> t -> bool
 val isCase : Evd.evar_map -> t -> bool
 val isProj : Evd.evar_map -> t -> bool
+
+type arity = rel_context * ESorts.t
+val destArity : Evd.evar_map -> types -> arity
 val isArity : Evd.evar_map -> t -> bool
+
 val isVarId  : Evd.evar_map -> Id.t -> t -> bool
 val isRelN : Evd.evar_map -> int -> t -> bool
 
@@ -157,7 +163,7 @@ val destProd : Evd.evar_map -> t -> Name.t * types * types
 val destLambda : Evd.evar_map -> t -> Name.t * types * t
 val destLetIn : Evd.evar_map -> t -> Name.t * t * types * t
 val destApp : Evd.evar_map -> t -> t * t array
-val destConst : Evd.evar_map -> t -> constant * EInstance.t
+val destConst : Evd.evar_map -> t -> Constant.t * EInstance.t
 val destEvar : Evd.evar_map -> t -> t pexistential
 val destInd : Evd.evar_map -> t -> inductive * EInstance.t
 val destConstruct : Evd.evar_map -> t -> constructor * EInstance.t
@@ -187,9 +193,9 @@ val whd_evar : Evd.evar_map -> constr -> constr
 
 val eq_constr : Evd.evar_map -> t -> t -> bool
 val eq_constr_nounivs : Evd.evar_map -> t -> t -> bool
-val eq_constr_universes : Evd.evar_map -> t -> t -> Universes.universe_constraints option
-val leq_constr_universes : Evd.evar_map -> t -> t -> Universes.universe_constraints option
-val eq_constr_universes_proj : Environ.env -> Evd.evar_map -> t -> t -> Universes.universe_constraints option
+val eq_constr_universes : Evd.evar_map -> t -> t -> Universes.Constraints.t option
+val leq_constr_universes : Evd.evar_map -> t -> t -> Universes.Constraints.t option
+val eq_constr_universes_proj : Environ.env -> Evd.evar_map -> t -> t -> Universes.Constraints.t option
 val compare_constr : Evd.evar_map -> (t -> t -> bool) -> t -> t -> bool
 
 (** {6 Iterators} *)
@@ -201,6 +207,10 @@ val iter_with_binders : Evd.evar_map -> ('a -> 'a) -> ('a -> t -> unit) -> 'a ->
 val iter_with_full_binders : Evd.evar_map -> (rel_declaration -> 'a -> 'a) -> ('a -> t -> unit) -> 'a -> t -> unit
 val fold : Evd.evar_map -> ('a -> t -> 'a) -> 'a -> t -> 'a
 
+(** Gather the universes transitively used in the term, including in the
+   type of evars appearing in it. *)
+val universes_of_constr : Environ.env -> Evd.evar_map -> t -> Univ.LSet.t
+
 (** {6 Substitutions} *)
 
 module Vars :
@@ -241,6 +251,7 @@ end
 
 val push_rel : rel_declaration -> env -> env
 val push_rel_context : rel_context -> env -> env
+val push_rec_types : (t, t) Constr.prec_declaration -> env -> env
 
 val push_named : named_declaration -> env -> env
 val push_named_context : named_context -> env -> env
@@ -256,6 +267,9 @@ val lookup_rel : int -> env -> rel_declaration
 val lookup_named : variable -> env -> named_declaration
 val lookup_named_val : variable -> named_context_val -> named_declaration
 
+val map_rel_context_in_env :
+  (env -> constr -> constr) -> env -> rel_context -> rel_context
+
 (* XXX Missing Sigma proxy *)
 val fresh_global :
   ?loc:Loc.t -> ?rigid:Evd.rigid -> ?names:Univ.Instance.t -> Environ.env ->
diff --git a/engine/engine.mllib b/engine/engine.mllib
index afc02d7f6..a3614f6c4 100644
--- a/engine/engine.mllib
+++ b/engine/engine.mllib
@@ -1,12 +1,13 @@
-Logic_monad
 Universes
+Univops
 UState
+Nameops
 Evd
 EConstr
 Namegen
 Termops
-Proofview_monad
 Evarutil
+Logic_monad
+Proofview_monad
 Proofview
 Ftactic
-Geninterp
diff --git a/engine/evarutil.ml b/engine/evarutil.ml
index 339c6a248..f82ffccdc 100644
--- a/engine/evarutil.ml
+++ b/engine/evarutil.ml
@@ -10,11 +10,12 @@ open CErrors
 open Util
 open Names
 open Term
-open Termops
-open Namegen
+open Constr
 open Pre_env
 open Environ
 open Evd
+open Termops
+open Namegen
 
 module RelDecl = Context.Rel.Declaration
 module NamedDecl = Context.Named.Declaration
@@ -53,15 +54,15 @@ let new_global evd x =
 
 (* flush_and_check_evars fails if an existential is undefined *)
 
-exception Uninstantiated_evar of existential_key
+exception Uninstantiated_evar of Evar.t
 
 let rec flush_and_check_evars sigma c =
-  match kind_of_term c with
+  match kind c with
   | Evar (evk,_ as ev) ->
       (match existential_opt_value sigma ev with
        | None -> raise (Uninstantiated_evar evk)
        | Some c -> flush_and_check_evars sigma c)
-  | _ -> map_constr (flush_and_check_evars sigma) c
+  | _ -> Constr.map (flush_and_check_evars sigma) c
 
 let flush_and_check_evars sigma c =
   flush_and_check_evars sigma (EConstr.Unsafe.to_constr c)
@@ -162,7 +163,7 @@ exception NoHeadEvar
 let head_evar sigma c =
   (** FIXME: this breaks if using evar-insensitive code *)
   let c = EConstr.Unsafe.to_constr c in
-  let rec hrec c = match kind_of_term c with
+  let rec hrec c = match kind c with
     | Evar (evk,_)   -> evk
     | Case (_,_,c,_) -> hrec c
     | App (c,_)      -> hrec c
@@ -198,9 +199,10 @@ let whd_head_evar sigma c =
 let meta_counter_summary_name = "meta counter"
 
 (* Generator of metavariables *)
-let new_meta =
-  let meta_ctr = Summary.ref 0 ~name:meta_counter_summary_name in
-  fun () -> incr meta_ctr; !meta_ctr
+let meta_ctr, meta_counter_summary_tag =
+  Summary.ref_tag 0 ~name:meta_counter_summary_name
+
+let new_meta () = incr meta_ctr; !meta_ctr
 
 let mk_new_meta () = EConstr.mkMeta(new_meta())
 
@@ -255,22 +257,6 @@ 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 =
-  (** Safe because this is a substitution *)
-  let c = EConstr.Unsafe.to_constr c in
-  let rec subst n c = match Constr.kind c with
-  | Rel m ->
-    if m <= n then c
-    else if m - n <= k then EConstr.Unsafe.to_constr (Int.Map.find (k - m + n) s)
-    else mkRel (m - k)
-  | _ -> Constr.map_with_binders succ subst n c
-  in
-  let c = if k = 0 then c else subst 0 c in
-  EConstr.of_constr c
-
-let subst2 subst vsubst c =
-  csubst_subst subst (EConstr.Vars.replace_vars vsubst c)
-
 let next_ident_away id avoid =
   let avoid id = Id.Set.mem id avoid in
   next_ident_away_from id avoid
@@ -280,19 +266,79 @@ let next_name_away na avoid =
   let id = match na with Name id -> id | Anonymous -> default_non_dependent_ident in
   next_ident_away_from id avoid
 
-type csubst = int * EConstr.t Int.Map.t
-
-let empty_csubst = (0, Int.Map.empty)
+type subst_val =
+| SRel of int
+| SVar of Id.t
+
+type csubst = {
+  csubst_len : int;
+  (** Cardinal of [csubst_rel] *)
+  csubst_var : Constr.t Id.Map.t;
+  (** A mapping of variables to variables. We use the more general
+      [Constr.t] to share allocations, but all values are of shape [Var _]. *)
+  csubst_rel : Constr.t Int.Map.t;
+  (** A contiguous mapping of integers to variables. Same remark for values. *)
+  csubst_rev : subst_val Id.Map.t;
+  (** Reverse mapping of the substitution *)
+}
+(** This type represent a name substitution for the named and De Bruijn parts of
+    a environment. For efficiency we also store the reverse substitution.
+    Invariant: all identifiers in the codomain of [csubst_var] and [csubst_rel]
+    must be pairwise distinct. *)
+
+let empty_csubst = {
+  csubst_len = 0;
+  csubst_rel = Int.Map.empty;
+  csubst_var = Id.Map.empty;
+  csubst_rev = Id.Map.empty;
+}
+
+let csubst_subst { csubst_len = k; csubst_var = v; csubst_rel = s } c =
+  (** Safe because this is a substitution *)
+  let c = EConstr.Unsafe.to_constr c in
+  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)
+  | Var id ->
+    begin try Id.Map.find id v with Not_found -> c end
+  | _ -> Constr.map_with_binders succ subst n c
+  in
+  let c = if k = 0 && Id.Map.is_empty v then c else subst 0 c in
+  EConstr.of_constr c
 
 type ext_named_context =
-  csubst * (Id.t * EConstr.constr) list *
-  Id.Set.t * EConstr.named_context
-
-let push_var id (n, s) =
-  let s = Int.Map.add n (EConstr.mkVar id) s in
-  (succ n, s)
-
-let push_rel_decl_to_named_context sigma decl (subst, vsubst, avoid, nc) =
+  csubst * Id.Set.t * EConstr.named_context
+
+let push_var id { csubst_len = n; csubst_var = v; csubst_rel = s; csubst_rev = r } =
+  let s = Int.Map.add n (Constr.mkVar id) s in
+  let r = Id.Map.add id (SRel n) r in
+  { csubst_len = succ n; csubst_var = v; csubst_rel = s; csubst_rev = r }
+
+(** Post-compose the substitution with the generator [src ↦ tgt] *)
+let update_var src tgt subst =
+  let cur =
+    try Some (Id.Map.find src subst.csubst_rev)
+    with Not_found -> None
+  in
+  match cur with
+  | None ->
+    (** Missing keys stand for identity substitution [src ↦ src] *)
+    let csubst_var = Id.Map.add src (Constr.mkVar tgt) subst.csubst_var in
+    let csubst_rev = Id.Map.add tgt (SVar src) subst.csubst_rev in
+    { subst with csubst_var; csubst_rev }
+  | Some bnd ->
+    let csubst_rev = Id.Map.add tgt bnd (Id.Map.remove src subst.csubst_rev) in
+    match bnd with
+    | SRel m ->
+      let csubst_rel = Int.Map.add m (Constr.mkVar tgt) subst.csubst_rel in
+      { subst with csubst_rel; csubst_rev }
+    | SVar id ->
+      let csubst_var = Id.Map.add id (Constr.mkVar tgt) subst.csubst_var in
+      { subst with csubst_var; csubst_rev }
+
+let push_rel_decl_to_named_context sigma decl (subst, avoid, nc) =
   let open EConstr in
   let open Vars in
   let map_decl f d =
@@ -306,7 +352,7 @@ let push_rel_decl_to_named_context sigma decl (subst, vsubst, avoid, nc) =
   in
   let extract_if_neq id = function
     | Anonymous -> None
-    | Name id' when id_ord id id' = 0 -> None
+    | Name id' when Id.compare id id' = 0 -> None
     | Name id' -> Some id'
   in
   let na = RelDecl.get_name decl in
@@ -328,18 +374,17 @@ let push_rel_decl_to_named_context sigma decl (subst, vsubst, avoid, nc) =
           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) |> map_decl (subst2 subst vsubst) in
+      let subst = update_var id0 id subst in
+      let d = decl |> NamedDecl.of_rel_decl (fun _ -> id0) |> map_decl (csubst_subst subst) 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)
+      (push_var id0 subst, 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) |> map_decl (subst2 subst vsubst) in
-      (push_var id subst, vsubst, Id.Set.add id avoid, d :: nc)
+      let d = decl |> NamedDecl.of_rel_decl (fun _ -> id) |> map_decl (csubst_subst subst) in
+      (push_var id subst, Id.Set.add id avoid, d :: nc)
 
 let push_rel_context_to_named_context env sigma typ =
   (* compute the instances relative to the named context and rel_context *)
@@ -348,17 +393,17 @@ let push_rel_context_to_named_context env sigma typ =
   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, [])
+    (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) =
+    let (subst, _, env) =
       Context.Rel.fold_outside (fun d acc -> push_rel_decl_to_named_context sigma d acc)
-        (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)
+        (rel_context env) ~init:(empty_csubst, avoid, named_context env) in
+    (val_of_named_context env, csubst_subst subst typ, inst_rels@inst_vars, subst)
 
 (*------------------------------------*
  * Entry points to define new evars   *
@@ -423,8 +468,8 @@ let new_evar_from_context sign evd ?src ?filter ?candidates ?store ?naming ?prin
 (* [new_evar] declares a new existential in an env env with type typ *)
 (* Converting the env into the sign of the evar to define *)
 let new_evar env evd ?src ?filter ?candidates ?store ?naming ?principal typ =
-  let sign,typ',instance,subst,vsubst = push_rel_context_to_named_context env evd typ in
-  let map c = subst2 subst vsubst c in
+  let sign,typ',instance,subst = push_rel_context_to_named_context env evd typ in
+  let map c = csubst_subst subst c in
   let candidates = Option.map (fun l -> List.map map l) candidates in
   let instance =
     match filter with
@@ -478,8 +523,6 @@ type clear_dependency_error =
 
 exception ClearDependencyError of Id.t * clear_dependency_error
 
-let cleared = Store.field ()
-
 exception Depends of Id.t
 
 let rec check_and_clear_in_constr env evdref err ids global c =
@@ -487,7 +530,7 @@ let rec check_and_clear_in_constr env evdref err ids global c =
      (ie the hypotheses ids have been removed from the contexts of
      evars). [global] should be true iff there is some variable of [ids] which
      is a section variable *)
-    match kind_of_term c with
+    match kind c with
       | Var id' ->
       if Id.Set.mem id' ids then raise (ClearDependencyError (id', err)) else c
 
@@ -552,16 +595,9 @@ let rec check_and_clear_in_constr env evdref err ids global c =
               let evd = !evdref in
               let (evd,_) = restrict_evar evd evk filter None in
               evdref := evd;
-	    (* spiwack: hacking session to mark the old [evk] as having been "cleared" *)
-	      let evi = Evd.find !evdref evk in
-	      let extra = evi.evar_extra in
-	      let extra' = Store.set extra cleared true in
-	      let evi' = { evi with evar_extra = extra' } in
-	      evdref := Evd.add !evdref evk evi' ;
-	    (* spiwack: /hacking session *)
               Evd.existential_value !evdref ev
 
-      | _ -> map_constr (check_and_clear_in_constr env evdref err ids global) c
+      | _ -> Constr.map (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
@@ -665,11 +701,9 @@ let rec advance sigma evk =
   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
+      match is_restricted_evar evi with
+      | Some evk -> advance sigma evk
+      | None -> None
 
 (** The following functions return the set of undefined evars
     contained in the object, the defined evars being traversed.
@@ -701,16 +735,65 @@ let undefined_evars_of_evar_info evd evi =
        (undefined_evars_of_named_context evd
 	  (named_context_of_val evi.evar_hyps)))
 
+type undefined_evars_cache = {
+  mutable cache : (EConstr.named_declaration * Evar.Set.t) ref Id.Map.t;
+}
+
+let create_undefined_evars_cache () = { cache = Id.Map.empty; }
+
+let cached_evar_of_hyp cache sigma decl accu = match cache with
+| None ->
+  let fold c acc =
+    let evs = undefined_evars_of_term sigma c in
+    Evar.Set.union evs acc
+  in
+  NamedDecl.fold_constr fold decl accu
+| Some cache ->
+  let id = NamedDecl.get_id decl in
+  let r =
+    try Id.Map.find id cache.cache
+    with Not_found ->
+      (** Dummy value *)
+      let r = ref (NamedDecl.LocalAssum (id, EConstr.mkProp), Evar.Set.empty) in
+      let () = cache.cache <- Id.Map.add id r cache.cache in
+      r
+  in
+  let (decl', evs) = !r in
+  let evs =
+    if NamedDecl.equal (==) decl decl' then snd !r
+    else
+      let fold c acc =
+        let evs = undefined_evars_of_term sigma c in
+        Evar.Set.union evs acc
+      in
+      let evs = NamedDecl.fold_constr fold decl Evar.Set.empty in
+      let () = r := (decl, evs) in
+      evs
+  in
+  Evar.Set.fold Evar.Set.add evs accu
+
+let filtered_undefined_evars_of_evar_info ?cache sigma evi =
+  let evars_of_named_context cache accu nc =
+    let fold decl accu = cached_evar_of_hyp cache sigma (EConstr.of_named_decl decl) accu in
+    Context.Named.fold_outside fold nc ~init:accu
+  in
+  let accu = match evi.evar_body with
+  | Evar_empty -> Evar.Set.empty
+  | Evar_defined b -> evars_of_term b
+  in
+  let accu = Evar.Set.union (undefined_evars_of_term sigma (EConstr.of_constr evi.evar_concl)) accu in
+  evars_of_named_context cache accu (evar_filtered_context evi)
+
 (* spiwack: this is a more complete version of
    {!Termops.occur_evar}. The latter does not look recursively into an
    [evar_map]. If unification only need to check superficially, tactics
    do not have this luxury, and need the more complete version. *)
 let occur_evar_upto sigma n c =
   let c = EConstr.Unsafe.to_constr c in
-  let rec occur_rec c = match kind_of_term c with
+  let rec occur_rec c = match kind c with
     | Evar (sp,_) when Evar.equal sp n -> raise Occur
     | Evar e -> Option.iter occur_rec (existential_opt_value sigma e)
-    | _ -> iter_constr occur_rec c
+    | _ -> Constr.iter occur_rec c
   in
   try occur_rec c; false with Occur -> true
 
diff --git a/engine/evarutil.mli b/engine/evarutil.mli
index 14173e774..923bf49a9 100644
--- a/engine/evarutil.mli
+++ b/engine/evarutil.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Evd
 open Environ
 open EConstr
@@ -38,9 +38,9 @@ val new_pure_evar :
   named_context_val -> evar_map -> ?src:Evar_kinds.t Loc.located -> ?filter:Filter.t ->
   ?candidates:constr list -> ?store:Store.t ->
   ?naming:Misctypes.intro_pattern_naming_expr ->
-  ?principal:bool -> types -> evar_map * evar
+  ?principal:bool -> types -> evar_map * Evar.t
 
-val new_pure_evar_full : evar_map -> evar_info -> evar_map * evar
+val new_pure_evar_full : evar_map -> evar_info -> evar_map * Evar.t
 
 (** the same with side-effects *)
 val e_new_evar :
@@ -54,17 +54,17 @@ val e_new_evar :
 val new_type_evar :
   env -> evar_map -> ?src:Evar_kinds.t Loc.located -> ?filter:Filter.t ->
   ?naming:Misctypes.intro_pattern_naming_expr -> ?principal:bool -> rigid ->
-  evar_map * (constr * sorts)
+  evar_map * (constr * Sorts.t)
 
 val e_new_type_evar : env -> evar_map ref ->
   ?src:Evar_kinds.t Loc.located -> ?filter:Filter.t ->
-  ?naming:Misctypes.intro_pattern_naming_expr -> ?principal:bool -> rigid -> constr * sorts
+  ?naming:Misctypes.intro_pattern_naming_expr -> ?principal:bool -> rigid -> constr * Sorts.t
 
 val new_Type : ?rigid:rigid -> env -> evar_map -> evar_map * constr
 val e_new_Type : ?rigid:rigid -> env -> evar_map ref -> constr
 
-val restrict_evar : evar_map -> existential_key -> Filter.t ->
-  ?src:Evar_kinds.t Loc.located -> constr list option -> evar_map * existential_key
+val restrict_evar : evar_map -> Evar.t -> Filter.t ->
+  ?src:Evar_kinds.t Loc.located -> constr list option -> evar_map * Evar.t
 
 (** Polymorphic constants *)
 
@@ -96,7 +96,7 @@ val non_instantiated : evar_map -> evar_info Evar.Map.t
 
 (** [head_evar c] returns the head evar of [c] if any *)
 exception NoHeadEvar
-val head_evar : evar_map -> constr -> existential_key (** may raise NoHeadEvar *)
+val head_evar : evar_map -> constr -> Evar.t (** may raise NoHeadEvar *)
 
 (* Expand head evar if any *)
 val whd_head_evar :  evar_map -> constr -> constr
@@ -116,13 +116,13 @@ val is_ground_env  :  evar_map -> env -> bool
     associating to each dependent evar [None] if it has no (partial)
     definition or [Some s] if [s] is the list of evars appearing in
     its (partial) definition. *)
-val gather_dependent_evars : evar_map -> evar list -> (Evar.Set.t option) Evar.Map.t
+val gather_dependent_evars : evar_map -> Evar.t 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
+val advance : evar_map -> Evar.t -> Evar.t option
 
 (** The following functions return the set of undefined evars
     contained in the object, the defined evars being traversed.
@@ -133,6 +133,12 @@ val undefined_evars_of_term : evar_map -> constr -> Evar.Set.t
 val undefined_evars_of_named_context : evar_map -> Context.Named.t -> Evar.Set.t
 val undefined_evars_of_evar_info : evar_map -> evar_info -> Evar.Set.t
 
+type undefined_evars_cache
+
+val create_undefined_evars_cache : unit -> undefined_evars_cache
+
+val filtered_undefined_evars_of_evar_info : ?cache:undefined_evars_cache -> evar_map -> evar_info -> Evar.Set.t
+
 (** [occur_evar_upto sigma k c] returns [true] if [k] appears in
     [c]. It looks up recursively in [sigma] for the value of existential
     variables. *)
@@ -177,7 +183,7 @@ val e_nf_evars_and_universes : evar_map ref -> (Constr.constr -> Constr.constr)
 val nf_evar_map_universes : evar_map -> evar_map * (Constr.constr -> Constr.constr)
 
 (** Replacing all evars, possibly raising [Uninstantiated_evar] *)
-exception Uninstantiated_evar of existential_key
+exception Uninstantiated_evar of Evar.t
 val flush_and_check_evars :  evar_map -> constr -> Constr.constr
 
 (** {6 Term manipulation up to instantiation} *)
@@ -204,10 +210,6 @@ type clear_dependency_error =
 
 exception ClearDependencyError of Id.t * clear_dependency_error
 
-(* spiwack: marks an evar that has been "defined" by clear.
-    used by [Goal] and (indirectly) [Proofview] to handle the clear tactic gracefully*)
-val cleared : bool Store.field
-
 val clear_hyps_in_evi : env -> evar_map ref -> named_context_val -> types ->
   Id.Set.t -> named_context_val * types
 
@@ -220,14 +222,13 @@ val empty_csubst : csubst
 val csubst_subst : csubst -> constr -> constr
 
 type ext_named_context =
-  csubst * (Id.t * constr) list *
-  Id.Set.t * named_context
+  csubst * Id.Set.t * named_context
 
 val push_rel_decl_to_named_context :
   evar_map -> rel_declaration -> ext_named_context -> ext_named_context
 
 val push_rel_context_to_named_context : Environ.env -> evar_map -> types ->
-  named_context_val * types * constr list * csubst * (identifier*constr) list
+  named_context_val * types * constr list * csubst
 
 val generalize_evar_over_rels : evar_map -> existential -> types * constr list
 
@@ -237,12 +238,13 @@ val evd_comb0 : (evar_map -> evar_map * 'a) -> evar_map ref -> 'a
 val evd_comb1 : (evar_map -> 'b -> evar_map * 'a) -> evar_map ref -> 'b -> 'a
 val evd_comb2 : (evar_map -> 'b -> 'c -> evar_map * 'a) -> evar_map ref -> 'b -> 'c -> 'a
 
-val subterm_source : existential_key -> Evar_kinds.t Loc.located ->
+val subterm_source : Evar.t -> Evar_kinds.t Loc.located ->
   Evar_kinds.t Loc.located
 
-val meta_counter_summary_name : string
-
-(** Deprecater *)
+val meta_counter_summary_tag : int Summary.Dyn.tag
 
+(** Deprecated *)
 type type_constraint = types option
+[@@ocaml.deprecated "use the version in Evardefine"]
 type val_constraint = constr option
+[@@ocaml.deprecated "use the version in Evardefine"]
diff --git a/engine/evd.ml b/engine/evd.ml
index cfc9aa635..2142cee37 100644
--- a/engine/evd.ml
+++ b/engine/evd.ml
@@ -8,10 +8,11 @@
 
 open Pp
 open CErrors
+open Sorts
 open Util
 open Names
 open Nameops
-open Term
+open Constr
 open Vars
 open Environ
 
@@ -124,10 +125,9 @@ end
 
 (* The type of mappings for existential variables *)
 
-module Dummy = struct end
-module Store = Store.Make(Dummy)
+module Store = Store.Make ()
 
-type evar = Term.existential_key
+type evar = Evar.t
 
 let string_of_existential evk = "?X" ^ string_of_int (Evar.repr evk)
 
@@ -281,9 +281,9 @@ type 'a freelisted = {
 (* Collects all metavars appearing in a constr *)
 let metavars_of c =
   let rec collrec acc c =
-    match kind_of_term c with
+    match kind c with
       | Meta mv -> Int.Set.add mv acc
-      | _         -> Term.fold_constr collrec acc c
+      | _         -> Constr.fold collrec acc c
   in
   collrec Int.Set.empty c
 
@@ -371,17 +371,17 @@ val key : Id.t -> t -> Evar.t
 end =
 struct
 
-type t = Id.t EvMap.t * existential_key Idmap.t
+type t = Id.t EvMap.t * Evar.t Id.Map.t
 
-let empty = (EvMap.empty, Idmap.empty)
+let empty = (EvMap.empty, Id.Map.empty)
 
 let add_name_newly_undefined id evk evi (evtoid, idtoev as names) =
   match id with
   | None -> names
   | Some id ->
-    if Idmap.mem id idtoev then
-      user_err  (str "Already an existential evar of name " ++ pr_id id);
-    (EvMap.add evk id evtoid, Idmap.add id evk idtoev)
+    if Id.Map.mem id idtoev then
+      user_err  (str "Already an existential evar of name " ++ Id.print id);
+    (EvMap.add evk id evtoid, Id.Map.add id evk idtoev)
 
 let add_name_undefined naming evk evi (evtoid,idtoev as evar_names) =
   if EvMap.mem evk evtoid then
@@ -393,15 +393,15 @@ let remove_name_defined evk (evtoid, idtoev as names) =
   let id = try Some (EvMap.find evk evtoid) with Not_found -> None in
   match id with
   | None -> names
-  | Some id -> (EvMap.remove evk evtoid, Idmap.remove id idtoev)
+  | Some id -> (EvMap.remove evk evtoid, Id.Map.remove id idtoev)
 
 let rename evk id (evtoid, idtoev) =
   let id' = try Some (EvMap.find evk evtoid) with Not_found -> None in
   match id' with
-  | None -> (EvMap.add evk id evtoid, Idmap.add id evk idtoev)
+  | None -> (EvMap.add evk id evtoid, Id.Map.add id evk idtoev)
   | Some id' ->
-    if Idmap.mem id idtoev then anomaly (str "Evar name already in use.");
-    (EvMap.update evk id evtoid (* overwrite old name *), Idmap.add id evk (Idmap.remove id' idtoev))
+    if Id.Map.mem id idtoev then anomaly (str "Evar name already in use.");
+    (EvMap.set evk id evtoid (* overwrite old name *), Id.Map.add id evk (Id.Map.remove id' idtoev))
 
 let reassign_name_defined evk evk' (evtoid, idtoev as names) =
   let id = try Some (EvMap.find evk evtoid) with Not_found -> None in
@@ -409,13 +409,13 @@ let reassign_name_defined evk evk' (evtoid, idtoev as names) =
   | None -> names (** evk' must not be defined *)
   | Some id ->
     (EvMap.add evk' id (EvMap.remove evk evtoid),
-    Idmap.add id evk' (Idmap.remove id idtoev))
+    Id.Map.add id evk' (Id.Map.remove id idtoev))
 
 let ident evk (evtoid, _) =
   try Some (EvMap.find evk evtoid) with Not_found -> None
 
 let key id (_, idtoev) =
-  Idmap.find id idtoev
+  Id.Map.find id idtoev
 
 end
 
@@ -466,9 +466,8 @@ let add d e i = add_with_name d e i
 let evar_counter_summary_name = "evar counter"
 
 (* Generator of existential names *)
-let new_untyped_evar =
-  let evar_ctr = Summary.ref 0 ~name:evar_counter_summary_name in
-  fun () -> incr evar_ctr; Evar.unsafe_of_int !evar_ctr
+let evar_ctr, evar_counter_summary_tag = Summary.ref_tag 0 ~name:evar_counter_summary_name
+let new_untyped_evar () = incr evar_ctr; Evar.unsafe_of_int !evar_ctr
 
 let new_evar evd ?name evi =
   let evk = new_untyped_evar () in
@@ -630,7 +629,9 @@ let evar_source evk d = (find d evk).evar_source
 let evar_ident evk evd = EvNames.ident evk evd.evar_names
 let evar_key id evd = EvNames.key id evd.evar_names
 
-let define_aux def undef evk body =
+let restricted = Store.field ()
+
+let define_aux ?dorestrict def undef evk body =
   let oldinfo =
     try EvMap.find evk undef
     with Not_found ->
@@ -640,7 +641,10 @@ let define_aux def undef evk body =
         anomaly ~label:"Evd.define" (Pp.str "cannot define undeclared evar.")
   in
   let () = assert (oldinfo.evar_body == Evar_empty) in
-  let newinfo = { oldinfo with evar_body = Evar_defined body } in
+  let evar_extra = match dorestrict with
+    | Some evk' -> Store.set oldinfo.evar_extra restricted evk'
+    | None -> oldinfo.evar_extra in
+  let newinfo = { oldinfo with evar_body = Evar_defined body; evar_extra } in
   EvMap.add evk newinfo def, EvMap.remove evk undef
 
 (* define the existential of section path sp as the constr body *)
@@ -653,6 +657,9 @@ let define evk body evd =
   let evar_names = EvNames.remove_name_defined evk evd.evar_names in
   { evd with defn_evars; undf_evars; last_mods; evar_names }
 
+let is_restricted_evar evi =
+  Store.get evi.evar_extra restricted
+
 let restrict evk filter ?candidates ?src evd =
   let evk' = new_untyped_evar () in
   let evar_info = EvMap.find evk evd.undf_evars in
@@ -667,7 +674,7 @@ let restrict evk filter ?candidates ?src evd =
   let ctxt = Filter.filter_list filter (evar_context evar_info) 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
+  let (defn_evars, undf_evars) = define_aux ~dorestrict:evk' evd.defn_evars evd.undf_evars evk body in
   { evd with undf_evars = EvMap.add evk' evar_info' undf_evars;
     defn_evars; last_mods; evar_names }, evk'
 
@@ -699,10 +706,10 @@ let extract_all_conv_pbs evd =
   extract_conv_pbs evd (fun _ -> true)
 
 let loc_of_conv_pb evd (pbty,env,t1,t2) =
-  match kind_of_term (fst (decompose_app t1)) with
+  match kind (fst (decompose_app t1)) with
   | Evar (evk1,_) -> fst (evar_source evk1 evd)
   | _ ->
-  match kind_of_term (fst (decompose_app t2)) with
+  match kind (fst (decompose_app t2)) with
   | Evar (evk2,_) -> fst (evar_source evk2 evd)
   | _             -> None
 
@@ -713,9 +720,9 @@ let loc_of_conv_pb evd (pbty,env,t1,t2) =
 
 let evars_of_term c =
   let rec evrec acc c =
-    match kind_of_term c with
+    match kind c with
     | Evar (n, l) -> Evar.Set.add n (Array.fold_left evrec acc l)
-    | _ -> Term.fold_constr evrec acc c
+    | _ -> Constr.fold evrec acc c
   in
   evrec Evar.Set.empty c
 
@@ -748,7 +755,12 @@ let evar_universe_context d = d.universes
 
 let universe_context_set d = UState.context_set d.universes
 
-let universe_context ?names evd = UState.universe_context ?names evd.universes
+let to_universe_context evd = UState.context evd.universes
+
+let const_univ_entry ~poly evd = UState.const_univ_entry ~poly evd.universes
+let ind_univ_entry ~poly evd = UState.ind_univ_entry ~poly evd.universes
+
+let check_univ_decl ~poly evd decl = UState.check_univ_decl ~poly evd.universes decl
 
 let restrict_universe_context evd vars =
   { evd with universes = UState.restrict evd.universes vars }
@@ -790,8 +802,8 @@ let make_evar_universe_context e l =
   | None -> uctx
   | Some us ->
       List.fold_left
-        (fun uctx (loc,id) ->
-        fst (UState.new_univ_variable ?loc univ_rigid (Some (Id.to_string id)) uctx))
+        (fun uctx { CAst.loc; v = id } ->
+        fst (UState.new_univ_variable ?loc univ_rigid (Some id) uctx))
         uctx us
 
 (****************************************)
@@ -843,7 +855,7 @@ let normalize_universe evd =
 
 let normalize_universe_instance evd l =
   let vars = ref (UState.subst evd.universes) in
-  let normalize = Univ.level_subst_of (Universes.normalize_univ_variable_opt_subst vars) in
+  let normalize = Universes.level_subst_of (Universes.normalize_univ_variable_opt_subst vars) in
     Univ.Instance.subst_fn normalize l
 
 let normalize_sort evars s =
@@ -922,8 +934,7 @@ let nf_constraints evd =
 
 let universe_of_name evd s = UState.universe_of_name evd.universes s
 
-let add_universe_name evd s l =
-  { evd with universes = UState.add_universe_name evd.universes s l }
+let universe_binders evd = UState.universe_binders evd.universes
 
 let universes evd = UState.ugraph evd.universes
 
diff --git a/engine/evd.mli b/engine/evd.mli
index 3f00a3b0b..84fa70ef2 100644
--- a/engine/evd.mli
+++ b/engine/evd.mli
@@ -9,7 +9,7 @@
 open Util
 open Loc
 open Names
-open Term
+open Constr
 open Environ
 
 (** This file defines the pervasive unification state used everywhere in Coq
@@ -28,12 +28,13 @@ open Environ
 
 (** {5 Existential variables and unification states} *)
 
-(** {6 Evars} *)
-
-type evar = existential_key
-(** Existential variables. TODO: Should be made opaque one day. *)
+type evar = Evar.t
+[@@ocaml.deprecated "use Evar.t"]
+(** Existential variables. *)
 
-val string_of_existential : evar -> string
+(** {6 Evars} *)
+val string_of_existential : Evar.t -> string
+[@@ocaml.deprecated "use Evar.print"]
 
 (** {6 Evar filters} *)
 
@@ -125,6 +126,7 @@ val map_evar_info : (constr -> constr) -> evar_info -> evar_info
 (** {6 Unification state} **)
 
 type evar_universe_context = UState.t
+[@@ocaml.deprecated "Alias of UState.t"]
 (** The universe context associated to an evar map *)
 
 type evar_map
@@ -138,7 +140,7 @@ val from_env : env -> evar_map
 (** The empty evar map with given universe context, taking its initial 
     universes from env. *)
 
-val from_ctx : evar_universe_context -> evar_map
+val from_ctx : UState.t -> evar_map
 (** The empty evar map with given universe context *)
 
 val is_empty : evar_map -> bool
@@ -149,44 +151,44 @@ val has_undefined : evar_map -> bool
     there are uninstantiated evars in [sigma]. *)
 
 val new_evar : evar_map ->
-  ?name:Id.t -> evar_info -> evar_map * evar
+  ?name:Id.t -> evar_info -> evar_map * Evar.t
 (** Creates a fresh evar mapping to the given information. *)
 
-val add : evar_map -> evar -> evar_info -> evar_map
+val add : evar_map -> Evar.t -> evar_info -> evar_map
 (** [add sigma ev info] adds [ev] with evar info [info] in sigma.
     Precondition: ev must not preexist in [sigma]. *)
 
-val find : evar_map -> evar -> evar_info
+val find : evar_map -> Evar.t -> evar_info
 (** Recover the data associated to an evar. *)
 
-val find_undefined : evar_map -> evar -> evar_info
+val find_undefined : evar_map -> Evar.t -> evar_info
 (** Same as {!find} but restricted to undefined evars. For efficiency
     reasons. *)
 
-val remove : evar_map -> evar -> evar_map
+val remove : evar_map -> Evar.t -> evar_map
 (** Remove an evar from an evar map. Use with caution. *)
 
-val mem : evar_map -> evar -> bool
+val mem : evar_map -> Evar.t -> bool
 (** Whether an evar is present in an evarmap. *)
 
-val fold : (evar -> evar_info -> 'a -> 'a) -> evar_map -> 'a -> 'a
+val fold : (Evar.t -> evar_info -> 'a -> 'a) -> evar_map -> 'a -> 'a
 (** Apply a function to all evars and their associated info in an evarmap. *)
 
-val fold_undefined : (evar -> evar_info -> 'a -> 'a) -> evar_map -> 'a -> 'a
+val fold_undefined : (Evar.t -> evar_info -> 'a -> 'a) -> evar_map -> 'a -> 'a
 (** Same as {!fold}, but restricted to undefined evars. For efficiency
     reasons. *)
 
-val raw_map : (evar -> evar_info -> evar_info) -> evar_map -> evar_map
+val raw_map : (Evar.t -> evar_info -> evar_info) -> evar_map -> evar_map
 (** Apply the given function to all evars in the map. Beware: this function
     expects the argument function to preserve the kind of [evar_body], i.e. it
     must send [Evar_empty] to [Evar_empty] and [Evar_defined c] to some
     [Evar_defined c']. *)
 
-val raw_map_undefined : (evar -> evar_info -> evar_info) -> evar_map -> evar_map
+val raw_map_undefined : (Evar.t -> evar_info -> evar_info) -> evar_map -> evar_map
 (** Same as {!raw_map}, but restricted to undefined evars. For efficiency
     reasons. *)
 
-val define : evar -> constr -> evar_map -> evar_map
+val define : Evar.t-> constr -> evar_map -> evar_map
 (** Set the body of an evar to the given constr. It is expected that:
     {ul
       {- The evar is already present in the evarmap.}
@@ -197,16 +199,16 @@ val define : evar -> constr -> evar_map -> evar_map
 val cmap : (constr -> constr) -> evar_map -> evar_map
 (** Map the function on all terms in the evar map. *)
 
-val is_evar : evar_map -> evar -> bool
+val is_evar : evar_map -> Evar.t-> bool
 (** Alias for {!mem}. *)
 
-val is_defined : evar_map -> evar -> bool
+val is_defined : evar_map -> Evar.t-> bool
 (** Whether an evar is defined in an evarmap. *)
 
-val is_undefined : evar_map -> evar -> bool
+val is_undefined : evar_map -> Evar.t-> bool
 (** Whether an evar is not defined in an evarmap. *)
 
-val add_constraints : evar_map -> Univ.constraints -> evar_map
+val add_constraints : evar_map -> Univ.Constraint.t -> evar_map
 (** Add universe constraints in an evar map. *)
 
 val undefined_map : evar_map -> evar_info Evar.Map.t
@@ -239,28 +241,31 @@ val evars_reset_evd  : ?with_conv_pbs:bool -> ?with_univs:bool ->
 
 (** {6 Misc} *)
 
-val restrict : evar -> Filter.t -> ?candidates:constr list ->
-  ?src:Evar_kinds.t located -> evar_map -> evar_map * evar
+val restrict : Evar.t-> Filter.t -> ?candidates:constr list ->
+  ?src:Evar_kinds.t located -> evar_map -> evar_map * Evar.t
 (** Restrict an undefined evar into a new evar by filtering context and
     possibly limiting the instances to a set of candidates *)
 
-val downcast : evar -> types -> evar_map -> evar_map
+val is_restricted_evar : evar_info -> Evar.t option
+(** Tell if an evar comes from restriction of another evar, and if yes, which *)
+
+val downcast : Evar.t-> types -> evar_map -> evar_map
 (** Change the type of an undefined evar to a new type assumed to be a
     subtype of its current type; subtyping must be ensured by caller *)
 
-val evar_source : existential_key -> evar_map -> Evar_kinds.t located
+val evar_source : Evar.t -> evar_map -> Evar_kinds.t located
 (** Convenience function. Wrapper around {!find} to recover the source of an
     evar in a given evar map. *)
 
-val evar_ident : existential_key -> evar_map -> Id.t option
+val evar_ident : Evar.t -> evar_map -> Id.t option
 
-val rename : existential_key -> Id.t -> evar_map -> evar_map
+val rename : Evar.t -> Id.t -> evar_map -> evar_map
 
-val evar_key : Id.t -> evar_map -> existential_key
+val evar_key : Id.t -> evar_map -> Evar.t
 
 val evar_source_of_meta : metavariable -> evar_map -> Evar_kinds.t located
 
-val dependent_evar_ident : existential_key -> evar_map -> Id.t
+val dependent_evar_ident : Evar.t -> evar_map -> Id.t
 
 (** {5 Side-effects} *)
 
@@ -311,7 +316,7 @@ val whd_sort_variable : evar_map -> constr -> constr
 
 exception UniversesDiffer
 
-val add_universe_constraints : evar_map -> Universes.universe_constraints -> evar_map
+val add_universe_constraints : evar_map -> Universes.Constraints.t -> evar_map
 (** Add the given universe unification constraints to the evar map.
     @raises UniversesDiffer in case a first-order unification fails.
     @raises UniverseInconsistency
@@ -483,86 +488,97 @@ val univ_rigid : rigid
 val univ_flexible : rigid
 val univ_flexible_alg : rigid
 
-type 'a in_evar_universe_context = 'a * evar_universe_context
+type 'a in_evar_universe_context = 'a * UState.t
 
-val evar_universe_context_set : evar_universe_context -> Univ.universe_context_set
-val evar_universe_context_constraints : evar_universe_context -> Univ.constraints
-val evar_context_universe_context : evar_universe_context -> Univ.universe_context
-val evar_universe_context_of : Univ.universe_context_set -> evar_universe_context
-val empty_evar_universe_context : evar_universe_context
-val union_evar_universe_context : evar_universe_context -> evar_universe_context ->
-  evar_universe_context
-val evar_universe_context_subst : evar_universe_context -> Universes.universe_opt_subst
-val constrain_variables : Univ.LSet.t -> evar_universe_context -> Univ.constraints
+val evar_universe_context_set : UState.t -> Univ.ContextSet.t
+val evar_universe_context_constraints : UState.t -> Univ.Constraint.t
+val evar_context_universe_context : UState.t -> Univ.UContext.t
+[@@ocaml.deprecated "alias of UState.context"]
+
+val evar_universe_context_of : Univ.ContextSet.t -> UState.t
+val empty_evar_universe_context : UState.t
+val union_evar_universe_context : UState.t -> UState.t ->
+  UState.t
+val evar_universe_context_subst : UState.t -> Universes.universe_opt_subst
+val constrain_variables : Univ.LSet.t -> UState.t -> UState.t
 
 
 val evar_universe_context_of_binders :
-  Universes.universe_binders -> evar_universe_context
-							    
-val make_evar_universe_context : env -> (Id.t located) list option -> evar_universe_context
-val restrict_universe_context : evar_map -> Univ.universe_set -> evar_map							   
+  Universes.universe_binders -> UState.t
+
+val make_evar_universe_context : env -> Misctypes.lident list option -> UState.t
+val restrict_universe_context : evar_map -> Univ.LSet.t -> evar_map
 (** Raises Not_found if not a name for a universe in this map. *)
-val universe_of_name : evar_map -> string -> Univ.universe_level
-val add_universe_name : evar_map -> string -> Univ.universe_level -> evar_map
+val universe_of_name : evar_map -> Id.t -> Univ.Level.t
 
-val add_constraints_context : evar_universe_context -> 
-  Univ.constraints -> evar_universe_context
+val universe_binders : evar_map -> Universes.universe_binders
+val add_constraints_context : UState.t ->
+  Univ.Constraint.t -> UState.t
 
 
-val normalize_evar_universe_context_variables : evar_universe_context -> 
+val normalize_evar_universe_context_variables : UState.t -> 
   Univ.universe_subst in_evar_universe_context
 
-val normalize_evar_universe_context : evar_universe_context -> 
-  evar_universe_context
+val normalize_evar_universe_context : UState.t -> 
+  UState.t
 
-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 new_univ_level_variable : ?loc:Loc.t -> ?name:Id.t -> rigid -> evar_map -> evar_map * Univ.Level.t
+val new_univ_variable : ?loc:Loc.t -> ?name:Id.t -> rigid -> evar_map -> evar_map * Univ.Universe.t
+val new_sort_variable : ?loc:Loc.t -> ?name:Id.t -> rigid -> evar_map -> evar_map * Sorts.t
 
 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 -> algebraic:bool -> Univ.universe_level -> evar_map
+val make_flexible_variable : evar_map -> algebraic:bool -> Univ.Level.t -> evar_map
 (** See [UState.make_flexible_variable] *)
 
-val is_sort_variable : evar_map -> sorts -> Univ.universe_level option 
+val is_sort_variable : evar_map -> Sorts.t -> Univ.Level.t option 
 (** [is_sort_variable evm s] returns [Some u] or [None] if [s] is 
     not a local sort variable declared in [evm] *)
 val is_flexible_level : evar_map -> Univ.Level.t -> bool
 
-(* val normalize_universe_level : evar_map -> Univ.universe_level -> Univ.universe_level *)
-val normalize_universe : evar_map -> Univ.universe -> Univ.universe
-val normalize_universe_instance : evar_map -> Univ.universe_instance -> Univ.universe_instance
+(* val normalize_universe_level : evar_map -> Univ.Level.t -> Univ.Level.t *)
+val normalize_universe : evar_map -> Univ.Universe.t -> Univ.Universe.t
+val normalize_universe_instance : evar_map -> Univ.Instance.t -> Univ.Instance.t
 
-val set_leq_sort : env -> evar_map -> sorts -> sorts -> evar_map
-val set_eq_sort : env -> evar_map -> sorts -> sorts -> evar_map
-val has_lub : evar_map -> Univ.universe -> Univ.universe -> evar_map
-val set_eq_level : evar_map -> Univ.universe_level -> Univ.universe_level -> evar_map
-val set_leq_level : evar_map -> Univ.universe_level -> Univ.universe_level -> evar_map
+val set_leq_sort : env -> evar_map -> Sorts.t -> Sorts.t -> evar_map
+val set_eq_sort : env -> evar_map -> Sorts.t -> Sorts.t -> evar_map
+val has_lub : evar_map -> Univ.Universe.t -> Univ.Universe.t -> evar_map
+val set_eq_level : evar_map -> Univ.Level.t -> Univ.Level.t -> evar_map
+val set_leq_level : evar_map -> Univ.Level.t -> Univ.Level.t -> evar_map
 val set_eq_instances : ?flex:bool -> 
-  evar_map -> Univ.universe_instance -> Univ.universe_instance -> evar_map
+  evar_map -> Univ.Instance.t -> Univ.Instance.t -> evar_map
 
-val check_eq : evar_map -> Univ.universe -> Univ.universe -> bool
-val check_leq : evar_map -> Univ.universe -> Univ.universe -> bool
+val check_eq : evar_map -> Univ.Universe.t -> Univ.Universe.t -> bool
+val check_leq : evar_map -> Univ.Universe.t -> Univ.Universe.t -> bool
 
-val evar_universe_context : evar_map -> evar_universe_context
-val universe_context_set : evar_map -> Univ.universe_context_set
-val universe_context : ?names:(Id.t located) list -> evar_map ->
-		       (Id.t * Univ.Level.t) list * Univ.universe_context
+val evar_universe_context : evar_map -> UState.t
+val universe_context_set : evar_map -> Univ.ContextSet.t
 val universe_subst : evar_map -> Universes.universe_opt_subst
 val universes : evar_map -> UGraph.t
 
+(** [to_universe_context evm] extracts the local universes and
+    constraints of [evm] and orders the universes the same as
+    [Univ.ContextSet.to_context]. *)
+val to_universe_context : evar_map -> Univ.UContext.t
+
+val const_univ_entry : poly:bool -> evar_map -> Entries.constant_universes_entry
 
-val merge_universe_context : evar_map -> evar_universe_context -> evar_map
-val set_universe_context : evar_map -> evar_universe_context -> evar_map
+(** NB: [ind_univ_entry] cannot create cumulative entries. *)
+val ind_univ_entry : poly:bool -> evar_map -> Entries.inductive_universes
 
-val merge_context_set : ?loc:Loc.t -> ?sideff:bool -> rigid -> evar_map -> Univ.universe_context_set -> evar_map
+val check_univ_decl : poly:bool -> evar_map -> UState.universe_decl -> Entries.constant_universes_entry
+
+val merge_universe_context : evar_map -> UState.t -> evar_map
+val set_universe_context : evar_map -> UState.t -> evar_map
+
+val merge_context_set : ?loc:Loc.t -> ?sideff:bool -> rigid -> evar_map -> Univ.ContextSet.t -> evar_map
 val merge_universe_subst : evar_map -> Universes.universe_opt_subst -> evar_map
 
 val with_context_set : ?loc:Loc.t -> rigid -> evar_map -> 'a Univ.in_universe_context_set -> evar_map * 'a
 
 val nf_univ_variables : evar_map -> evar_map * Univ.universe_subst
-val abstract_undefined_variables : evar_universe_context -> evar_universe_context
+val abstract_undefined_variables : UState.t -> UState.t
 
 val fix_undefined_variables : evar_map -> evar_map
 
@@ -574,8 +590,8 @@ val update_sigma_env : evar_map -> env -> evar_map
 
 (** Polymorphic universes *)
 
-val fresh_sort_in_family : ?loc:Loc.t -> ?rigid:rigid -> env -> evar_map -> sorts_family -> evar_map * sorts
-val fresh_constant_instance : ?loc:Loc.t -> env -> evar_map -> constant -> evar_map * pconstant
+val fresh_sort_in_family : ?loc:Loc.t -> ?rigid:rigid -> env -> evar_map -> Sorts.family -> evar_map * Sorts.t
+val fresh_constant_instance : ?loc:Loc.t -> env -> evar_map -> Constant.t -> evar_map * pconstant
 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
 
@@ -593,11 +609,16 @@ type open_constr = evar_map * constr (* Special case when before is empty *)
 type unsolvability_explanation = SeveralInstancesFound of int
 (** Failure explanation. *)
 
+(** {5 Summary names} *)
+
+(* This stuff is internal and should not be used. Currently a hack in
+   the STM relies on it. *)
+val evar_counter_summary_tag : int Summary.Dyn.tag
+
 (** {5 Deprecated functions} *)
+val create_evar_defs : evar_map -> evar_map
+(* XXX: This is supposed to be deprecated by used by ssrmatching, what
+   should the replacement be? *)
 
-val create_evar_defs      : evar_map -> evar_map
 (** Create an [evar_map] with empty meta map: *)
 
-(** {5 Summary names} *)
-
-val evar_counter_summary_name : string
diff --git a/engine/ftactic.mli b/engine/ftactic.mli
index c108c0c2e..65ee929c8 100644
--- a/engine/ftactic.mli
+++ b/engine/ftactic.mli
@@ -39,10 +39,10 @@ val run : 'a t -> ('a -> unit Proofview.tactic) -> unit Proofview.tactic
 
 (** {5 Focussing} *)
 
-val nf_enter : ([ `NF ] Proofview.Goal.t -> 'a t) -> 'a t
+val nf_enter : (Proofview.Goal.t -> 'a t) -> 'a t
 (** Enter a goal. The resulting tactic is focussed. *)
 
-val enter : ([ `LZ ] Proofview.Goal.t -> 'a t) -> 'a t
+val enter : (Proofview.Goal.t -> 'a t) -> 'a t
 (** Enter a goal, without evar normalization. The resulting tactic is
     focussed. *)
 
diff --git a/engine/logic_monad.ml b/engine/logic_monad.ml
index bf1b3e0e8..3674bb943 100644
--- a/engine/logic_monad.ml
+++ b/engine/logic_monad.ml
@@ -95,7 +95,7 @@ struct
   let print_char = fun c -> (); fun () -> print_char c
 
   let timeout = fun n t -> (); fun () ->
-    Control.timeout n t (Exception Timeout)
+    Control.timeout n t () (Exception Timeout)
 
   let make f = (); fun () ->
     try f ()
@@ -107,7 +107,6 @@ struct
   let print_debug   s = make (fun _ -> Feedback.msg_info s)
   let print_info    s = make (fun _ -> Feedback.msg_info s)
   let print_warning s = make (fun _ -> Feedback.msg_warning s)
-  let print_error   s = make (fun _ -> Feedback.msg_error s)
   let print_notice  s = make (fun _ -> Feedback.msg_notice s)
 
   let run = fun x ->
diff --git a/engine/logic_monad.mli b/engine/logic_monad.mli
index 8c8f9fe93..50b4abd8b 100644
--- a/engine/logic_monad.mli
+++ b/engine/logic_monad.mli
@@ -61,7 +61,6 @@ module NonLogical : sig
   val print_warning : Pp.t -> unit t
   val print_notice : Pp.t -> unit t
   val print_info : Pp.t -> unit t
-  val print_error : Pp.t -> unit t
 
   (** [Pervasives.raise]. Except that exceptions are wrapped with
       {!Exception}. *)
diff --git a/engine/namegen.ml b/engine/namegen.ml
index a75fe721f..ff0b5a74e 100644
--- a/engine/namegen.ml
+++ b/engine/namegen.ml
@@ -43,6 +43,8 @@ let default_non_dependent_ident = Id.of_string default_non_dependent_string
 
 let default_dependent_ident = Id.of_string "x"
 
+let default_generated_non_letter_string = "x"
+
 (**********************************************************************)
 (* Globality of identifiers *)
 
@@ -59,9 +61,9 @@ let is_imported_ref = function
   | VarRef _ -> false
   | IndRef (kn,_)
   | ConstructRef ((kn,_),_) ->
-      let (mp,_,_) = repr_mind kn in is_imported_modpath mp
+      let (mp,_,_) = MutInd.repr3 kn in is_imported_modpath mp
   | ConstRef kn ->
-      let (mp,_,_) = repr_con kn in is_imported_modpath mp
+      let (mp,_,_) = Constant.repr3 kn in is_imported_modpath mp
 
 let is_global id =
   try
@@ -97,7 +99,7 @@ let head_name sigma c = (* Find the head constant of a constr if any *)
     match EConstr.kind sigma c with
     | Prod (_,_,c) | Lambda (_,_,c) | LetIn (_,_,_,c)
     | Cast (c,_,_) | App (c,_) -> hdrec c
-    | Proj (kn,_) -> Some (Label.to_id (con_label (Projection.constant kn)))
+    | Proj (kn,_) -> Some (Label.to_id (Constant.label (Projection.constant kn)))
     | Const _ | Ind _ | Construct _ | Var _ as c ->
 	Some (basename_of_global (global_of_constr c))
     | Fix ((_,i),(lna,_,_)) | CoFix (i,(lna,_,_)) ->
@@ -107,7 +109,17 @@ let head_name sigma c = (* Find the head constant of a constr if any *)
   hdrec c
 
 let lowercase_first_char id = (* First character of a constr *)
-  Unicode.lowercase_first_char (Id.to_string id)
+  let s = Id.to_string id in
+  match Unicode.split_at_first_letter s with
+  | None ->
+    (* General case: nat -> n *)
+    Unicode.lowercase_first_char s
+  | Some (s,s') ->
+      if String.length s' = 0 then
+      (* No letter, e.g. __, or __'_, etc. *)
+        default_generated_non_letter_string
+      else
+        s ^ Unicode.lowercase_first_char s'
 
 let sort_hdchar = function
   | Prop(_) -> "P"
@@ -118,10 +130,10 @@ let hdchar env sigma c =
     match EConstr.kind sigma c with
     | Prod (_,_,c) | Lambda (_,_,c) | LetIn (_,_,_,c) -> hdrec (k+1) c
     | Cast (c,_,_) | App (c,_) -> hdrec k c
-    | Proj (kn,_) -> lowercase_first_char (Label.to_id (con_label (Projection.constant kn)))
-    | Const (kn,_) -> lowercase_first_char (Label.to_id (con_label kn))
-    | Ind (x,_) -> lowercase_first_char (basename_of_global (IndRef x))
-    | Construct (x,_) -> lowercase_first_char (basename_of_global (ConstructRef x))
+    | Proj (kn,_) -> lowercase_first_char (Label.to_id (Constant.label (Projection.constant kn)))
+    | Const (kn,_) -> lowercase_first_char (Label.to_id (Constant.label kn))
+    | Ind (x,_) -> (try lowercase_first_char (basename_of_global (IndRef x)) with Not_found when !Flags.in_debugger -> "zz")
+    | Construct (x,_) -> (try lowercase_first_char (basename_of_global (ConstructRef x)) with Not_found when !Flags.in_debugger -> "zz")
     | Var id  -> lowercase_first_char id
     | Sort s -> sort_hdchar (ESorts.kind sigma s)
     | Rel n ->
@@ -239,7 +251,7 @@ let visible_ids sigma (nenv, c) =
 let next_name_away_in_cases_pattern sigma env_t na avoid =
   let id = match na with Name id -> id | Anonymous -> default_dependent_ident in
   let visible = visible_ids sigma env_t in
-  let bad id = Id.List.mem id avoid || is_constructor id
+  let bad id = Id.Set.mem id avoid || is_constructor id
                                     || Id.Set.mem id visible in
   next_ident_away_from id bad
 
@@ -253,8 +265,8 @@ let next_name_away_in_cases_pattern sigma 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 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
+  let id = if Id.Set.mem id avoid then restart_subscript id else id in
+  let bad id = Id.Set.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 =
@@ -271,16 +283,16 @@ let next_name_away_in_goal na avoid =
    beyond the current subscript *)
 
 let next_global_ident_away id avoid =
-  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
+  let id = if Id.Set.mem id avoid then restart_subscript id else id in
+  let bad id = Id.Set.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 Id.List.mem id avoid then
-    next_ident_away_from (restart_subscript id) (fun id -> Id.List.mem id avoid)
+  if Id.Set.mem id avoid then
+    next_ident_away_from (restart_subscript id) (fun id -> Id.Set.mem id avoid)
   else id
 
 let next_name_away_with_default default na avoid =
@@ -302,7 +314,7 @@ let next_name_away = next_name_away_with_default default_non_dependent_string
 
 let make_all_name_different env sigma =
   (** FIXME: this is inefficient, but only used in printing *)
-  let avoid = ref (Id.Set.elements (Context.Named.to_vars (named_context env))) in
+  let avoid = ref (ids_of_named_context_val (named_context_val env)) in
   let sign = named_context_val env in
   let rels = rel_context env in
   let env0 = reset_with_named_context sign env in
@@ -310,7 +322,7 @@ let make_all_name_different env sigma =
     (fun decl newenv ->
        let na = named_hd newenv sigma (RelDecl.get_type decl) (RelDecl.get_name decl) in
        let id = next_name_away na !avoid in
-       avoid := id::!avoid;
+       avoid := Id.Set.add id !avoid;
        push_rel (RelDecl.set_name (Name id) decl) newenv)
     rels ~init:env0
 
@@ -321,7 +333,7 @@ let make_all_name_different env sigma =
 
 let next_ident_away_for_default_printing sigma env_t id avoid =
   let visible = visible_ids sigma env_t in
-  let bad id = Id.List.mem id avoid || Id.Set.mem id visible in
+  let bad id = Id.Set.mem id avoid || Id.Set.mem id visible in
   next_ident_away_from id bad
 
 let next_name_away_for_default_printing sigma env_t na avoid =
@@ -364,14 +376,21 @@ let next_name_for_display sigma flags =
   | RenamingElsewhereFor env_t -> next_name_away_for_default_printing sigma env_t
 
 (* Remark: Anonymous var may be dependent in Evar's contexts *)
-let compute_displayed_name_in sigma flags avoid na c =
+let compute_displayed_name_in_gen_poly noccurn_fun sigma flags avoid na c =
   match na with
-  | Anonymous when noccurn sigma 1 c ->
+  | Anonymous when noccurn_fun sigma 1 c ->
     (Anonymous,avoid)
   | _ ->
     let fresh_id = next_name_for_display sigma flags na avoid in
-    let idopt = if noccurn sigma 1 c then Anonymous else Name fresh_id in
-    (idopt, fresh_id::avoid)
+    let idopt = if noccurn_fun sigma 1 c then Anonymous else Name fresh_id in
+    (idopt, Id.Set.add fresh_id avoid)
+
+let compute_displayed_name_in = compute_displayed_name_in_gen_poly noccurn
+
+let compute_displayed_name_in_gen f sigma =
+  (* only flag which does not need a constr, maybe to be refined *)
+  let flag = RenamingForGoal in
+  compute_displayed_name_in_gen_poly f sigma flag
 
 let compute_and_force_displayed_name_in sigma flags avoid na c =
   match na with
@@ -379,11 +398,11 @@ let compute_and_force_displayed_name_in sigma flags avoid na c =
     (Anonymous,avoid)
   | _ ->
     let fresh_id = next_name_for_display sigma flags na avoid in
-    (Name fresh_id, fresh_id::avoid)
+    (Name fresh_id, Id.Set.add fresh_id avoid)
 
 let compute_displayed_let_name_in sigma flags avoid na c =
   let fresh_id = next_name_for_display sigma flags na avoid in
-  (Name fresh_id, fresh_id::avoid)
+  (Name fresh_id, Id.Set.add fresh_id avoid)
 
 let rename_bound_vars_as_displayed sigma avoid env c =
   let rec rename avoid env c =
diff --git a/engine/namegen.mli b/engine/namegen.mli
index 14846a918..abeed9f62 100644
--- a/engine/namegen.mli
+++ b/engine/namegen.mli
@@ -9,7 +9,6 @@
 (** This file features facilities to generate fresh names. *)
 
 open Names
-open Term
 open Environ
 open Evd
 open EConstr
@@ -27,7 +26,7 @@ val default_dependent_ident : Id.t     (* "x" *)
    Generating "intuitive" names from their type *)
 
 val lowercase_first_char : Id.t -> string
-val sort_hdchar : sorts -> string
+val sort_hdchar : Sorts.t -> string
 val hdchar : env -> evar_map -> types -> string
 val id_of_name_using_hdchar : env -> evar_map -> types -> Name.t -> Id.t
 val named_hd : env -> evar_map -> types -> Name.t -> Name.t
@@ -72,23 +71,22 @@ val next_ident_away_from : Id.t -> (Id.t -> bool) -> Id.t
     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
+val next_ident_away : Id.t -> Id.Set.t -> Id.t
 
 (** Avoid clashing with a name already used in current module *)
-val next_ident_away_in_goal : Id.t -> Id.t list -> Id.t
+val next_ident_away_in_goal : Id.t -> Id.Set.t -> Id.t
 
 (** Avoid clashing with a name already used in current module 
    but tolerate overwriting section variables, as in goals *)
-val next_global_ident_away : Id.t -> Id.t list -> Id.t
+val next_global_ident_away : Id.t -> Id.Set.t -> Id.t
 
 (** Default is [default_non_dependent_ident] *)
-val next_name_away  : Name.t -> Id.t list -> Id.t
+val next_name_away  : Name.t -> Id.Set.t -> Id.t
 
-val next_name_away_with_default : string -> Name.t -> Id.t list ->
-  Id.t
+val next_name_away_with_default : string -> Name.t -> Id.Set.t -> Id.t
 
 val next_name_away_with_default_using_types : string -> Name.t ->
-  Id.t list -> types -> Id.t
+  Id.Set.t -> types -> Id.t
 
 val set_reserved_typed_name : (types -> Name.t) -> unit
 
@@ -103,13 +101,18 @@ type renaming_flags =
 val make_all_name_different : env -> evar_map -> env
 
 val compute_displayed_name_in :
-  evar_map -> renaming_flags -> Id.t list -> Name.t -> constr -> Name.t * Id.t list
+  evar_map -> renaming_flags -> Id.Set.t -> Name.t -> constr -> Name.t * Id.Set.t
 val compute_and_force_displayed_name_in :
-  evar_map -> renaming_flags -> Id.t list -> Name.t -> constr -> Name.t * Id.t list
+  evar_map -> renaming_flags -> Id.Set.t -> Name.t -> constr -> Name.t * Id.Set.t
 val compute_displayed_let_name_in :
-  evar_map -> renaming_flags -> Id.t list -> Name.t -> constr -> Name.t * Id.t list
+  evar_map -> renaming_flags -> Id.Set.t -> Name.t -> 'a -> Name.t * Id.Set.t
 val rename_bound_vars_as_displayed :
-  evar_map -> Id.t list -> Name.t list -> types -> types
+  evar_map -> Id.Set.t -> Name.t list -> types -> types
+
+(* Generic function expecting a "not occurn" function *)
+val compute_displayed_name_in_gen :
+  (evar_map -> int -> 'a -> bool) ->
+  evar_map -> Id.Set.t -> Name.t -> 'a -> Name.t * Id.Set.t
 
 (**********************************************************************)
 (* Naming strategy for arguments in Prop when eliminating inductive types *)
diff --git a/library/nameops.ml b/engine/nameops.ml
index d598a63b8..5105d7bec 100644
--- a/library/nameops.ml
+++ b/engine/nameops.ml
@@ -203,13 +203,14 @@ let pr_name = print
 
 let pr_lab l = Label.print l
 
-let default_library = Names.DirPath.initial (* = ["Top"] *)
-
-(*s Roots of the space of absolute names *)
-let coq_string = "Coq"
-let coq_root = Id.of_string coq_string
-let default_root_prefix = DirPath.empty
-
 (* Metavariables *)
 let pr_meta = Pp.int
 let string_of_meta = string_of_int
+
+(* Deprecated *)
+open Libnames
+let default_library = default_library
+let coq_string = coq_string
+let coq_root = coq_root
+let default_root_prefix = default_root_prefix
+
diff --git a/library/nameops.mli b/engine/nameops.mli
index 58cd6ed4e..0fec8a925 100644
--- a/library/nameops.mli
+++ b/engine/nameops.mli
@@ -89,47 +89,50 @@ module Name : sig
 
 end
 
+(** Metavariables *)
+val pr_meta : Constr.metavariable -> Pp.t
+val string_of_meta : Constr.metavariable -> string
+
 val out_name : Name.t -> Id.t
-(** @deprecated Same as [Name.get_id] *)
+[@@ocaml.deprecated "Same as [Name.get_id]"]
 
 val name_fold : (Id.t -> 'a -> 'a) -> Name.t -> 'a -> 'a
-(** @deprecated Same as [Name.fold_right] *)
+[@@ocaml.deprecated "Same as [Name.fold_right]"]
 
 val name_iter : (Id.t -> unit) -> Name.t -> unit
-(** @deprecated Same as [Name.iter] *)
+[@@ocaml.deprecated "Same as [Name.iter]"]
 
 val name_app : (Id.t -> Id.t) -> Name.t -> Name.t
-(** @deprecated Same as [Name.map] *)
+[@@ocaml.deprecated "Same as [Name.map]"]
 
 val name_fold_map : ('a -> Id.t -> 'a * Id.t) -> 'a -> Name.t -> 'a * Name.t
-(** @deprecated Same as [Name.fold_left_map] *)
+[@@ocaml.deprecated "Same as [Name.fold_left_map]"]
 
 val name_max : Name.t -> Name.t -> Name.t
-(** @deprecated Same as [Name.pick] *)
+[@@ocaml.deprecated "Same as [Name.pick]"]
 
 val name_cons : Name.t -> Id.t list -> Id.t list
-(** @deprecated Same as [Name.cons] *)
+[@@ocaml.deprecated "Same as [Name.cons]"]
 
 val pr_name : Name.t -> Pp.t
-(** @deprecated Same as [Name.print] *)
+[@@ocaml.deprecated "Same as [Name.print]"]
 
 val pr_id : Id.t -> Pp.t
-(** @deprecated Same as [Names.Id.print] *)
+[@@ocaml.deprecated "Same as [Names.Id.print]"]
 
 val pr_lab : Label.t -> Pp.t
+[@@ocaml.deprecated "Same as [Names.Label.print]"]
 
-(** some preset paths *)
-
+(** Deprecated stuff to libnames *)
 val default_library : DirPath.t
+[@@ocaml.deprecated "Same as [Libnames.default_library]"]
 
-(** This is the root of the standard library of Coq *)
 val coq_root : module_ident (** "Coq" *)
+[@@ocaml.deprecated "Same as [Libnames.coq_root]"]
+
 val coq_string : string (** "Coq" *)
+[@@ocaml.deprecated "Same as [Libnames.coq_string]"]
 
-(** This is the default root prefix for developments which doesn't
-   mention a root *)
 val default_root_prefix : DirPath.t
+[@@ocaml.deprecated "Same as [Libnames.default_root_prefix]"]
 
-(** Metavariables *)
-val pr_meta : Term.metavariable -> Pp.t
-val string_of_meta : Term.metavariable -> string
diff --git a/engine/proofview.ml b/engine/proofview.ml
index eef2b83f4..c41b0b0dc 100644
--- a/engine/proofview.ml
+++ b/engine/proofview.ml
@@ -153,8 +153,12 @@ let focus i j sp =
   ( { sp with comb = new_comb } , context )
 
 (** [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 (Evarutil.advance defs) l
+    unsolved (after advancing cleared goals). Note that order matters. *)
+let undefined defs l =
+  List.fold_right (fun evk l ->
+      match Evarutil.advance defs evk with
+      | Some evk -> List.add_set Evar.equal evk l
+      | None -> l) l []
 
 (** Unfocuses a proofview with respect to a context. *)
 let unfocus c sp =
@@ -630,32 +634,42 @@ let shelve_goals l =
   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
-    [evi]. Note: since we want to use it on goals, the body is actually
-    supposed to be empty. *)
-let contained_in_info sigma e evi =
-  Evar.Set.mem e (Evd.evars_of_filtered_evar_info (Evarutil.nf_evar_info sigma evi))
-
 (** [depends_on sigma src tgt] checks whether the goal [src] appears
     as an existential variable in the definition of the goal [tgt] in
     [sigma]. *)
 let depends_on sigma src tgt =
   let evi = Evd.find sigma tgt in
-  contained_in_info sigma src evi
+  Evar.Set.mem src (Evd.evars_of_filtered_evar_info (Evarutil.nf_evar_info sigma evi))
+
+let unifiable_delayed g l =
+  CList.exists (fun (tgt, lazy evs) -> not (Evar.equal g tgt) && Evar.Set.mem g evs) l
+
+let free_evars sigma l =
+  let cache = Evarutil.create_undefined_evars_cache () in
+  let map ev =
+  (** Computes the set of evars appearing in the hypotheses, the conclusion or
+      the body of the evar_info [evi]. Note: since we want to use it on goals,
+      the body is actually supposed to be empty. *)
+    let evi = Evd.find sigma ev in
+    let fevs = lazy (Evarutil.filtered_undefined_evars_of_evar_info ~cache sigma evi) in
+    (ev, fevs)
+  in
+  List.map map l
 
 (** [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. *)
 let unifiable sigma g l =
-  CList.exists (fun tgt -> not (Evar.equal g tgt) && depends_on sigma g tgt) l
+  let l = free_evars sigma l in
+  unifiable_delayed g l
 
 (** [partition_unifiable sigma l] partitions [l] into a pair [(u,n)]
     where [u] is composed of the unifiable goals, i.e. the goals on
     whose definition other goals of [l] depend, and [n] are the
     non-unifiable goals. *)
 let partition_unifiable sigma l =
-  CList.partition (fun g -> unifiable sigma g l) l
+  let fevs = free_evars sigma l in
+  CList.partition (fun g -> unifiable_delayed g fevs) l
 
 (** Shelves the unifiable goals under focus, i.e. the goals which
     appear in other goals under focus (the unfocused goals are not
@@ -1009,14 +1023,14 @@ let catchable_exception = function
 
 module Goal = struct
 
-  type 'a t = {
+  type t = {
     env : Environ.env;
     sigma : Evd.evar_map;
     concl : EConstr.constr ;
     self : Evar.t ; (* for compatibility with old-style definitions *)
   }
 
-  let assume (gl : 'a t) = (gl :> [ `NF ] t)
+  let assume (gl : t) = (gl : t)
 
   let env {env} = env
   let sigma {sigma} = sigma
@@ -1072,7 +1086,7 @@ module Goal = struct
     end
     end
 
-  let enter_one f =
+  let enter_one ?(__LOC__=__LOC__) f =
     let open Proof in
     Comb.get >>= function
     | [goal] -> begin
@@ -1083,7 +1097,8 @@ module Goal = struct
          let (e, info) = CErrors.push e in
          tclZERO ~info e
       end
-    | _ -> assert false (* unsatisfied not-exactly-one-goal precondition *)
+    | _ ->
+       CErrors.anomaly Pp.(str __LOC__ ++ str " enter_one")
 
   let goals =
     Pv.get >>= fun step ->
@@ -1196,7 +1211,7 @@ module V82 = struct
    { Evd.it = comb ; sigma = solution }
 
   let top_goals initial { solution=solution; } =
-    let goals = CList.map (fun (t,_) -> fst (Term.destEvar (EConstr.Unsafe.to_constr t))) initial in
+    let goals = CList.map (fun (t,_) -> fst (Constr.destEvar (EConstr.Unsafe.to_constr t))) initial in
     { Evd.it = goals ; sigma=solution; }
 
   let top_evars initial =
diff --git a/engine/proofview.mli b/engine/proofview.mli
index d92d0a7d5..721ce507d 100644
--- a/engine/proofview.mli
+++ b/engine/proofview.mli
@@ -25,7 +25,7 @@ type proofview
    new nearly identical function everytime. Hence the generic name. *)
 (* In this version: returns the list of focused goals together with
    the [evar_map] context. *)
-val proofview : proofview -> Evd.evar list * Evd.evar_map
+val proofview : proofview -> Evar.t list * Evd.evar_map
 
 
 (** {6 Starting and querying a proof view} *)
@@ -88,7 +88,7 @@ type focus_context
    new nearly identical function everytime. Hence the generic name. *)
 (* In this version: the goals in the context, as a "zipper" (the first
    list is in reversed order). *)
-val focus_context : focus_context -> Evd.evar list * Evd.evar list
+val focus_context : focus_context -> Evar.t list * Evar.t list
 
 (** [focus i j] focuses a proofview on the goals from index [i] to
     index [j] (inclusive, goals are indexed from [1]). I.e. goals
@@ -148,7 +148,7 @@ type +'a tactic
     {!Logic_monad.TacticFailure}*)
 val apply : Environ.env -> 'a tactic -> proofview -> 'a
                                                    * proofview
-                                                   * (bool*Evd.evar list*Evd.evar list)
+                                                   * (bool*Evar.t list*Evar.t list)
                                                    * Proofview_monad.Info.tree
 
 (** {7 Monadic primitives} *)
@@ -304,12 +304,12 @@ 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 : Evd.evar list -> unit tactic
+val shelve_goals : Evar.t 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 -> Evd.evar -> Evd.evar list -> bool
+val unifiable : Evd.evar_map -> Evar.t -> Evar.t list -> bool
 
 (** Shelves the unifiable goals under focus, i.e. the goals which
     appear in other goals under focus (the unfocused goals are not
@@ -322,15 +322,15 @@ val guard_no_unifiable : Names.Name.t list option tactic
 
 (** [unshelve l p] adds all the goals in [l] at the end of the focused
     goals of p *)
-val unshelve : Evd.evar list -> proofview -> proofview
+val unshelve : Evar.t list -> proofview -> proofview
 
 (** [depends_on g1 g2 sigma] checks if g1 occurs in the type/ctx of g2 *)
-val depends_on : Evd.evar_map -> Evd.evar -> Evd.evar -> bool
+val depends_on : Evd.evar_map -> Evar.t -> Evar.t -> 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 -> (Evd.evar list * 'a) tactic
+val with_shelf : 'a tactic -> (Evar.t list * 'a) tactic
 
 (** If [n] is positive, [cycle n] puts the [n] first goal last. If [n]
     is negative, then it puts the [n] last goals first.*)
@@ -416,17 +416,17 @@ module Unsafe : sig
   (** [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. *)
-  val tclNEWGOALS : Evd.evar list -> unit tactic
+  val tclNEWGOALS : Evar.t list -> unit tactic
 
   (** [tclSETGOALS gls] sets goals [gls] as the goals being under focus. If a
       goal is already solved, it is not set. *)
-  val tclSETGOALS : Evd.evar list -> unit tactic
+  val tclSETGOALS : Evar.t list -> unit tactic
 
   (** [tclGETGOALS] returns the list of goals under focus. *)
-  val tclGETGOALS : Evd.evar list tactic
+  val tclGETGOALS : Evar.t list tactic
 
   (** Sets the evar universe context. *)
-  val tclEVARUNIVCONTEXT : Evd.evar_universe_context -> unit tactic
+  val tclEVARUNIVCONTEXT : UState.t -> unit tactic
 
   (** Clears the future goals store in the proof view. *)
   val reset_future_goals : proofview -> proofview
@@ -461,56 +461,49 @@ end
 
 module Goal : sig
 
-  (** Type of goals.
-
-      The first parameter type is a phantom argument indicating whether the data
-      contained in the goal has been normalized w.r.t. the current sigma. If it
-      is the case, it is flagged [ `NF ]. You may still access the un-normalized
-      data using {!assume} if you known you do not rely on the assumption of
-      being normalized, at your own risk.
-
-  *)
-  type 'a t
+  (** Type of goals. *)
+  type t
 
   (** Assume that you do not need the goal to be normalized. *)
-  val assume : 'a t -> [ `NF ] t
+  val assume : t -> t
+  [@@ocaml.deprecated "Normalization is enforced by EConstr, [assume] is not needed anymore"]
 
   (** Normalises the argument goal. *)
-  val normalize : 'a t -> [ `NF ] t tactic
+  val normalize : t -> t tactic
 
   (** [concl], [hyps], [env] and [sigma] given a goal [gl] return
       respectively the conclusion of [gl], the hypotheses of [gl], the
       environment of [gl] (i.e. the global environment and the
       hypotheses) and the current evar map. *)
-  val concl : 'a t -> constr
-  val hyps : 'a t -> named_context
-  val env : 'a t -> Environ.env
-  val sigma : 'a t -> Evd.evar_map
-  val extra : 'a t -> Evd.Store.t
+  val concl : t -> constr
+  val hyps : t -> named_context
+  val env : t -> Environ.env
+  val sigma : t -> Evd.evar_map
+  val extra : t -> Evd.Store.t
 
   (** [nf_enter t] applies the goal-dependent tactic [t] in each goal
       independently, in the manner of {!tclINDEPENDENT} except that
       the current goal is also given as an argument to [t]. The goal
       is normalised with respect to evars. *)
-  val nf_enter : ([ `NF ] t -> unit tactic) -> unit tactic
+  val nf_enter : (t -> unit tactic) -> unit tactic
 
   (** Like {!nf_enter}, but does not normalize the goal beforehand. *)
-  val enter : ([ `LZ ] t -> unit tactic) -> unit tactic
+  val enter : (t -> unit tactic) -> unit tactic
 
   (** Like {!enter}, but assumes exactly one goal under focus, raising *)
   (** a fatal error otherwise. *)
-  val enter_one : ([ `LZ ] t -> 'a tactic) -> 'a tactic
+  val enter_one : ?__LOC__:string -> (t -> 'a tactic) -> 'a tactic
 
   (** Recover the list of current goals under focus, without evar-normalization.
       FIXME: encapsulate the level in an existential type. *)
-  val goals : [ `LZ ] t tactic list tactic
+  val goals : t tactic list tactic
 
   (** [unsolved g] is [true] if [g] is still unsolved in the current
       proof state. *)
-  val unsolved : 'a t -> bool tactic
+  val unsolved : t -> bool tactic
 
   (** Compatibility: avoid if possible *)
-  val goal : [ `NF ] t -> Evar.t
+  val goal : t -> Evar.t
 
 end
 
@@ -563,11 +556,12 @@ module V82 : sig
   (* Returns the open goals of the proofview together with the evar_map to 
      interpret them. *)
   val goals : proofview -> Evar.t list Evd.sigma
+  [@@ocaml.deprecated "Use [Proofview.proofview]"]
 
   val top_goals : entry -> proofview -> Evar.t list Evd.sigma
-  
+
   (* returns the existential variable used to start the proof *)
-  val top_evars : entry -> Evd.evar list
+  val top_evars : entry -> Evar.t list
 
   (* Caution: this function loses quite a bit of information. It
      should be avoided as much as possible.  It should work as
diff --git a/engine/termops.ml b/engine/termops.ml
index 2bd0c06d6..40b3d0d8b 100644
--- a/engine/termops.ml
+++ b/engine/termops.ml
@@ -12,6 +12,7 @@ open Util
 open Names
 open Nameops
 open Term
+open Constr
 open Vars
 open Environ
 
@@ -31,7 +32,7 @@ let pr_sort_family = function
   | InProp -> (str "Prop")
   | InType -> (str "Type")
 
-let pr_con sp = str(string_of_con sp)
+let pr_con sp = str(Constant.to_string sp)
 
 let pr_fix pr_constr ((t,i),(lna,tl,bl)) =
   let fixl = Array.mapi (fun i na -> (na,t.(i),tl.(i),bl.(i))) lna in
@@ -46,16 +47,16 @@ let pr_puniverses p u =
   if Univ.Instance.is_empty u then p 
   else p ++ str"(*" ++ Univ.Instance.pr Universes.pr_with_global_universes u ++ str"*)"
 
-let rec pr_constr c = match kind_of_term c with
+let rec pr_constr c = match kind c with
   | Rel n -> str "#"++int n
   | Meta n -> str "Meta(" ++ int n ++ str ")"
-  | Var id -> pr_id id
+  | Var id -> Id.print id
   | Sort s -> print_sort s
   | Cast (c,_, t) -> hov 1
       (str"(" ++ pr_constr c ++ cut() ++
        str":" ++ pr_constr t ++ str")")
   | Prod (Name(id),t,c) -> hov 1
-      (str"forall " ++ pr_id id ++ str":" ++ pr_constr t ++ str"," ++
+      (str"forall " ++ Id.print id ++ str":" ++ pr_constr t ++ str"," ++
        spc() ++ pr_constr c)
   | Prod (Anonymous,t,c) -> hov 0
       (str"(" ++ pr_constr t ++ str " ->" ++ spc() ++
@@ -74,9 +75,9 @@ let rec pr_constr c = match kind_of_term c with
       (str"Evar#" ++ int (Evar.repr e) ++ str"{" ++
        prlist_with_sep spc pr_constr (Array.to_list l) ++str"}")
   | Const (c,u) -> str"Cst(" ++ pr_puniverses (pr_con c) u ++ str")"
-  | Ind ((sp,i),u) -> str"Ind(" ++ pr_puniverses (pr_mind sp ++ str"," ++ int i) u ++ str")"
+  | Ind ((sp,i),u) -> str"Ind(" ++ pr_puniverses (MutInd.print sp ++ str"," ++ int i) u ++ str")"
   | Construct (((sp,i),j),u) ->
-      str"Constr(" ++ pr_puniverses (pr_mind sp ++ str"," ++ int i ++ str"," ++ int j) u ++ str")"
+      str"Constr(" ++ pr_puniverses (MutInd.print sp ++ str"," ++ int i ++ str"," ++ int j) u ++ str")"
   | Proj (p,c) -> str"Proj(" ++ pr_con (Projection.constant p) ++ str"," ++ bool (Projection.unfolded p) ++ pr_constr c ++ str")"
   | Case (ci,p,c,bl) -> v 0
       (hv 0 (str"<"++pr_constr p++str">"++ cut() ++ str"Case " ++
@@ -129,9 +130,9 @@ let pr_existential_key sigma evk =
 let open Evd in
 match evar_ident evk sigma with
 | None ->
-  str "?" ++ pr_id (pr_evar_suggested_name evk sigma)
+  str "?" ++ Id.print (pr_evar_suggested_name evk sigma)
 | Some id ->
-  str "?" ++ pr_id id
+  str "?" ++ Id.print id
 
 let pr_instance_status (sc,typ) =
   let open Evd in
@@ -157,7 +158,7 @@ let pr_meta_map evd =
   let open Evd in
   let print_constr = print_kconstr in
   let pr_name = function
-      Name id -> str"[" ++ pr_id id ++ str"]"
+      Name id -> str"[" ++ Id.print id ++ str"]"
     | _ -> mt() in
   let pr_meta_binding = function
     | (mv,Cltyp (na,b)) ->
@@ -177,23 +178,23 @@ let pr_decl (decl,ok) =
   let open NamedDecl in
   let print_constr = print_kconstr in
   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 ":=" ++
+  | LocalAssum (id,_) -> if ok then Id.print id else (str "{" ++ Id.print id ++ str "}")
+  | LocalDef (id,c,_) -> str (if ok then "(" else "{") ++ Id.print id ++ str ":=" ++
                            print_constr c ++ str (if ok then ")" else "}")
 
 let pr_evar_source = function
-  | Evar_kinds.NamedHole id -> pr_id id
+  | Evar_kinds.NamedHole id -> Id.print id
   | Evar_kinds.QuestionMark _ -> str "underscore"
   | Evar_kinds.CasesType false -> str "pattern-matching return predicate"
   | Evar_kinds.CasesType true ->
       str "subterm of pattern-matching return predicate"
-  | Evar_kinds.BinderType (Name id) -> str "type of " ++ Nameops.pr_id id
+  | Evar_kinds.BinderType (Name id) -> str "type of " ++ Id.print id
   | Evar_kinds.BinderType Anonymous -> str "type of anonymous binder"
   | Evar_kinds.ImplicitArg (c,(n,ido),b) ->
       let open Globnames in
       let print_constr = print_kconstr in
       let id = Option.get ido in
-      str "parameter " ++ pr_id id ++ spc () ++ str "of" ++
+      str "parameter " ++ Id.print id ++ spc () ++ str "of" ++
       spc () ++ print_constr (printable_constr_of_global c)
   | Evar_kinds.InternalHole -> str "internal placeholder"
   | Evar_kinds.TomatchTypeParameter (ind,n) ->
@@ -202,10 +203,9 @@ let pr_evar_source = function
   | Evar_kinds.GoalEvar -> str "goal evar"
   | Evar_kinds.ImpossibleCase -> str "type of impossible pattern-matching clause"
   | Evar_kinds.MatchingVar _ -> str "matching variable"
-  | Evar_kinds.VarInstance id -> str "instance of " ++ pr_id id
+  | Evar_kinds.VarInstance id -> str "instance of " ++ Id.print id
   | Evar_kinds.SubEvar evk ->
-      let open Evd in
-      str "subterm of " ++ str (string_of_existential evk)
+    str "subterm of " ++ Evar.print evk
 
 let pr_evar_info evi =
   let open Evd in
@@ -288,6 +288,7 @@ let has_no_evar sigma =
   with Exit -> false
 
 let pr_evd_level evd = UState.pr_uctx_level (Evd.evar_universe_context evd)
+let reference_of_level evd l = UState.reference_of_level (Evd.evar_universe_context evd) l
 
 let pr_evar_universe_context ctx =
   let open UState in
@@ -327,11 +328,11 @@ let pr_evar_constraints sigma pbs =
       Namegen.make_all_name_different env sigma
     in
     print_env_short env ++ spc () ++ str "|-" ++ spc () ++
-      print_constr_env env sigma (EConstr.of_constr t1) ++ spc () ++
+      protect (print_constr_env env sigma) (EConstr.of_constr t1) ++ spc () ++
       str (match pbty with
             | Reduction.CONV -> "=="
             | Reduction.CUMUL -> "<=") ++
-      spc () ++ print_constr_env env Evd.empty (EConstr.of_constr t2)
+      spc () ++ protect (print_constr_env env Evd.empty) (EConstr.of_constr t2)
   in
   prlist_with_sep fnl pr_evconstr pbs
 
@@ -355,40 +356,40 @@ let pr_evar_map_gen with_univs pr_evars sigma =
 let pr_evar_list sigma l =
   let open Evd in
   let pr (ev, evi) =
-    h 0 (str (string_of_existential ev) ++
+    h 0 (Evar.print ev ++
       str "==" ++ pr_evar_info evi ++
       (if evi.evar_body == Evar_empty
-       then str " {" ++  pr_existential_key sigma ev ++ str "}"
+       then str " {" ++ pr_existential_key sigma ev ++ str "}"
        else mt ()))
   in
   h 0 (prlist_with_sep fnl pr l)
 
-let pr_evar_by_depth depth sigma = match depth with
-| None ->
-  (* Print all evars *)
-  let to_list d =
-    let open Evd in
-    (* Workaround for change in Map.fold behavior in ocaml 3.08.4 *)
-    let l = ref [] in
-    let fold_def evk evi () = match evi.evar_body with
+let to_list d =
+  let open Evd in
+  (* Workaround for change in Map.fold behavior in ocaml 3.08.4 *)
+  let l = ref [] in
+  let fold_def evk evi () = match evi.evar_body with
     | Evar_defined _ -> l := (evk, evi) :: !l
     | Evar_empty -> ()
-    in
-    let fold_undef evk evi () = match evi.evar_body with
+  in
+  let fold_undef evk evi () = match evi.evar_body with
     | Evar_empty -> l := (evk, evi) :: !l
     | Evar_defined _ -> ()
-    in
-    Evd.fold fold_def d ();
-    Evd.fold fold_undef d ();
-    !l
   in
-  str"EVARS:"++brk(0,1)++pr_evar_list sigma (to_list sigma)++fnl()
-| Some n ->
+  Evd.fold fold_def d ();
+  Evd.fold fold_undef d ();
+  !l
+
+let pr_evar_by_depth depth sigma = match depth with
+| None ->
   (* Print all evars *)
+  str"EVARS:" ++ brk(0,1) ++ pr_evar_list sigma (to_list sigma) ++ fnl()
+| Some n ->
+  (* Print closure of undefined evars *)
   str"UNDEFINED EVARS:"++
   (if Int.equal n 0 then mt() else str" (+level "++int n++str" closure):")++
   brk(0,1)++
-  pr_evar_list sigma (evar_dependency_closure n sigma)++fnl()
+  pr_evar_list sigma (evar_dependency_closure n sigma) ++ fnl()
 
 let pr_evar_by_filter filter sigma =
   let open Evd in
@@ -434,7 +435,7 @@ let pr_var_decl env decl =
 	  (str" := " ++ pb ++ cut () ) in
   let pt = print_constr_env env Evd.empty (EConstr.of_constr (get_type decl)) in
   let ptyp = (str" : " ++ pt) in
-    (pr_id (get_id decl) ++ hov 0 (pbody ++ ptyp))
+    (Id.print (get_id decl) ++ hov 0 (pbody ++ ptyp))
 
 let pr_rel_decl env decl =
   let open RelDecl in
@@ -448,7 +449,7 @@ let pr_rel_decl env decl =
   let ptyp = print_constr_env env Evd.empty (EConstr.of_constr (get_type decl)) in
     match get_name decl with
       | Anonymous -> hov 0 (str"<>" ++ spc () ++ pbody ++ str":" ++ spc () ++ ptyp)
-      | Name id -> hov 0 (pr_id id ++ spc () ++ pbody ++ str":" ++ spc () ++ ptyp)
+      | Name id -> hov 0 (Id.print id ++ spc () ++ pbody ++ str":" ++ spc () ++ ptyp)
 
 let print_named_context env =
   hv 0 (fold_named_context
@@ -798,7 +799,7 @@ let fold_constr_with_binders sigma g f n acc c =
 
 let iter_constr_with_full_binders g f l c =
   let open RelDecl in
-  match kind_of_term c with
+  match kind c with
   | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
     | Construct _) -> ()
   | Cast (c,_, t) -> f l c; f l t
@@ -983,9 +984,9 @@ let isMetaOf sigma mv c =
   match EConstr.kind sigma c with Meta mv' -> Int.equal mv mv' | _ -> false
 
 let rec subst_meta bl c =
-  match kind_of_term c with
+  match kind c with
     | Meta i -> (try Int.List.assoc i bl with Not_found -> c)
-    | _ -> map_constr (subst_meta bl) c
+    | _ -> Constr.map (subst_meta bl) c
 
 let rec strip_outer_cast sigma c = match EConstr.kind sigma c with
   | Cast (c,_,_) -> strip_outer_cast sigma c
@@ -1071,9 +1072,9 @@ let replace_term_gen sigma eq_fun c by_c in_t =
 let replace_term sigma c byc t = replace_term_gen sigma EConstr.eq_constr c byc t
 
 let vars_of_env env =
-  let s =
-    Context.Named.fold_outside (fun decl s -> Id.Set.add (NamedDecl.get_id decl) s)
-      (named_context env) ~init:Id.Set.empty in
+  let s = Environ.ids_of_named_context_val (Environ.named_context_val env) in
+  if List.is_empty (Environ.rel_context env) then s
+  else
   Context.Rel.fold_outside
     (fun decl s -> match RelDecl.get_name decl with Name id -> Id.Set.add id s | _ -> s)
     (rel_context env) ~init:s
@@ -1165,6 +1166,24 @@ let rec is_Prop sigma c = match EConstr.kind sigma c with
   | Cast (c,_,_) -> is_Prop sigma c
   | _ -> false
 
+let rec is_Set sigma c = match EConstr.kind sigma c with
+  | Sort u ->
+    begin match EConstr.ESorts.kind sigma u with
+    | Prop Pos -> true
+    | _ -> false
+    end
+  | Cast (c,_,_) -> is_Set sigma c
+  | _ -> false
+
+let rec is_Type sigma c = match EConstr.kind sigma c with
+  | Sort u ->
+    begin match EConstr.ESorts.kind sigma u with
+    | Type _ -> true
+    | _ -> false
+    end
+  | Cast (c,_,_) -> is_Type sigma c
+  | _ -> false
+
 (* eq_constr extended with universe erasure *)
 let compare_constr_univ sigma f cv_pb t1 t2 =
   let open EConstr in
@@ -1444,6 +1463,18 @@ let prod_applist sigma c l =
     | _ -> anomaly (Pp.str "Not enough prod's.") in
   app [] c l
 
+let prod_applist_assum sigma n c l =
+  let open EConstr in
+  let rec app n subst c l =
+    if Int.equal n 0 then
+      if l == [] then Vars.substl subst c
+      else anomaly (Pp.str "Not enough arguments.")
+    else match EConstr.kind sigma c, l with
+    | Prod(_,_,c), arg::l -> app (n-1) (arg::subst) c l
+    | LetIn(_,b,_,c), _ -> app (n-1) (Vars.substl subst b::subst) c l
+    | _ -> anomaly (Pp.str "Not enough prod/let's.") in
+  app n [] c l
+
 (* Combinators on judgments *)
 
 let on_judgment f j = { uj_val = f j.uj_val; uj_type = f j.uj_type }
diff --git a/engine/termops.mli b/engine/termops.mli
index 2624afd30..a3559a693 100644
--- a/engine/termops.mli
+++ b/engine/termops.mli
@@ -10,13 +10,13 @@
     needed in the kernel. *)
 
 open Names
-open Term
+open Constr
 open Environ
 open EConstr
 
 (** printers *)
-val print_sort : sorts -> Pp.t
-val pr_sort_family : sorts_family -> Pp.t
+val print_sort : Sorts.t -> Pp.t
+val pr_sort_family : Sorts.family -> Pp.t
 val pr_fix : ('a -> Pp.t) -> ('a, 'a) pfixpoint -> Pp.t
 
 (** about contexts *)
@@ -91,7 +91,7 @@ exception Occur
 val occur_meta : Evd.evar_map -> constr -> bool
 val occur_existential : Evd.evar_map -> constr -> bool
 val occur_meta_or_existential : Evd.evar_map -> constr -> bool
-val occur_evar : Evd.evar_map -> existential_key -> constr -> bool
+val occur_evar : Evd.evar_map -> Evar.t -> constr -> bool
 val occur_var : env -> Evd.evar_map -> Id.t -> constr -> bool
 val occur_var_in_decl :
   env -> Evd.evar_map ->
@@ -113,6 +113,7 @@ val collect_metas : Evd.evar_map -> constr -> int list
 val collect_vars : Evd.evar_map -> constr -> Id.Set.t (** for visible vars only *)
 val vars_of_global_reference : env -> Globnames.global_reference -> Id.Set.t
 val occur_term : Evd.evar_map -> constr -> constr -> bool (** Synonymous of dependent *)
+[@@ocaml.deprecated "alias of Termops.dependent"]
 
 (* Substitution of metavariables *)
 type meta_value_map = (metavariable * Constr.constr) list
@@ -147,7 +148,7 @@ val subst_term : Evd.evar_map -> constr -> constr -> constr
 val replace_term : Evd.evar_map -> constr -> constr -> constr -> constr
 
 (** Alternative term equalities *)
-val base_sort_cmp : Reduction.conv_pb -> sorts -> sorts -> bool
+val base_sort_cmp : Reduction.conv_pb -> Sorts.t -> Sorts.t -> bool
 val compare_constr_univ : Evd.evar_map -> (Reduction.conv_pb -> constr -> constr -> bool) ->
   Reduction.conv_pb -> constr -> constr -> bool
 val constr_cmp : Evd.evar_map -> Reduction.conv_pb -> constr -> constr -> bool
@@ -158,8 +159,18 @@ val eta_reduce_head : Evd.evar_map -> constr -> constr
 (** Flattens application lists *)
 val collapse_appl : Evd.evar_map -> constr -> constr
 
+(** [prod_applist] [forall (x1:B1;...;xn:Bn), B] [a1...an] @return [B[a1...an]] *)
 val prod_applist : Evd.evar_map -> constr -> constr list -> constr
 
+(** In [prod_applist_assum n c args], [c] is supposed to have the
+    form [∀Γ.c] with [Γ] of length [m] and possibly with let-ins; it
+    returns [c] with the assumptions of [Γ] instantiated by [args] and
+    the local definitions of [Γ] expanded.
+    Note that [n] counts both let-ins and prods, while the length of [args]
+    only counts prods. In other words, varying [n] changes how many
+    trailing let-ins are expanded. *)
+val prod_applist_assum : Evd.evar_map -> int -> constr -> constr list -> constr
+
 (** Remove recursively the casts around a term i.e.
    [strip_outer_cast (Cast (Cast ... (Cast c, t) ... ))] is [c]. *)
 val strip_outer_cast : Evd.evar_map -> constr -> constr
@@ -267,6 +278,10 @@ val isGlobalRef : Evd.evar_map -> constr -> bool
 val is_template_polymorphic : env -> Evd.evar_map -> constr -> bool
 
 val is_Prop : Evd.evar_map -> constr -> bool
+val is_Set : Evd.evar_map -> constr -> bool
+val is_Type : Evd.evar_map -> constr -> bool
+
+val reference_of_level : Evd.evar_map -> Univ.Level.t -> Libnames.reference
 
 (** Combinators on judgments *)
 
@@ -278,9 +293,9 @@ val on_judgment_type  : ('t -> 't) -> ('c, 't) punsafe_judgment -> ('c, 't) puns
 
 open Evd
 
-val pr_existential_key : evar_map -> evar -> Pp.t
+val pr_existential_key : evar_map -> Evar.t -> Pp.t
 
-val pr_evar_suggested_name : existential_key -> evar_map -> Id.t
+val pr_evar_suggested_name : Evar.t -> evar_map -> Id.t
 
 val pr_evar_info : evar_info -> Pp.t
 val pr_evar_constraints : evar_map -> evar_constraint list -> Pp.t
@@ -288,7 +303,7 @@ val pr_evar_map : ?with_univs:bool -> int option -> evar_map -> Pp.t
 val pr_evar_map_filter : ?with_univs:bool -> (Evar.t -> evar_info -> bool) ->
   evar_map -> Pp.t
 val pr_metaset : Metaset.t -> Pp.t
-val pr_evar_universe_context : evar_universe_context -> Pp.t
+val pr_evar_universe_context : UState.t -> Pp.t
 val pr_evd_level : evar_map -> Univ.Level.t -> Pp.t
 
 (** debug printer: do not use to display terms to the casual user... *)
diff --git a/engine/uState.ml b/engine/uState.ml
index 63bd247d5..625495866 100644
--- a/engine/uState.ml
+++ b/engine/uState.ml
@@ -11,32 +11,21 @@ open CErrors
 open Util
 open Names
 
-module StringOrd = struct type t = string let compare = String.compare end
-module UNameMap = struct
+module UNameMap = Names.Id.Map
     
-  include Map.Make(StringOrd)
-    
-  let union s t = 
-    if s == t then s
-    else
-      merge (fun k l r -> 
-        match l, r with
-        | Some _, _ -> l
-        | _, _ -> r) s t
-end
-
 type uinfo = {
-  uname : string option;
+  uname : Id.t option;
   uloc : Loc.t option;
 }
 
 (* 2nd part used to check consistency on the fly. *)
 type t =
- { uctx_names : Univ.Level.t UNameMap.t * uinfo Univ.LMap.t;
-   uctx_local : Univ.universe_context_set; (** The local context of variables *)
+ { uctx_names : Universes.universe_binders * uinfo Univ.LMap.t;
+   uctx_local : Univ.ContextSet.t; (** The local context of variables *)
+   uctx_seff_univs : Univ.LSet.t; (** Local universes used through private constants *)
    uctx_univ_variables : Universes.universe_opt_subst;
    (** The local universes that are unification variables *)
-   uctx_univ_algebraic : Univ.universe_set; 
+   uctx_univ_algebraic : Univ.LSet.t; 
    (** The subset of unification variables that can be instantiated with
         algebraic universes as they appear in inferred types only. *)
    uctx_universes : UGraph.t; (** The current graph extended with the local constraints *)
@@ -46,6 +35,7 @@ type t =
 let empty =
   { uctx_names = UNameMap.empty, Univ.LMap.empty;
     uctx_local = Univ.ContextSet.empty;
+    uctx_seff_univs = Univ.LSet.empty;
     uctx_univ_variables = Univ.LMap.empty;
     uctx_univ_algebraic = Univ.LSet.empty;
     uctx_universes = UGraph.initial_universes;
@@ -59,12 +49,21 @@ let is_empty ctx =
   Univ.ContextSet.is_empty ctx.uctx_local && 
     Univ.LMap.is_empty ctx.uctx_univ_variables
 
+let uname_union s t =
+  if s == t then s
+  else
+    UNameMap.merge (fun k l r ->
+        match l, r with
+        | Some _, _ -> l
+        | _, _ -> r) s t
+
 let union ctx ctx' =
   if ctx == ctx' then ctx
   else if is_empty ctx' then ctx
   else
     let local = Univ.ContextSet.union ctx.uctx_local ctx'.uctx_local in
-    let names = UNameMap.union (fst ctx.uctx_names) (fst ctx'.uctx_names) in
+    let seff = Univ.LSet.union ctx.uctx_seff_univs ctx'.uctx_seff_univs in
+    let names = uname_union (fst ctx.uctx_names) (fst ctx'.uctx_names) in
     let newus = Univ.LSet.diff (Univ.ContextSet.levels ctx'.uctx_local)
                                (Univ.ContextSet.levels ctx.uctx_local) in
     let newus = Univ.LSet.diff newus (Univ.LMap.domain ctx.uctx_univ_variables) in
@@ -74,6 +73,7 @@ let union ctx ctx' =
     let names_rev = Univ.LMap.union (snd ctx.uctx_names) (snd ctx'.uctx_names) in
       { uctx_names = (names, names_rev);
         uctx_local = local;
+        uctx_seff_univs = seff;
         uctx_univ_variables = 
           Univ.LMap.subst_union ctx.uctx_univ_variables ctx'.uctx_univ_variables;
         uctx_univ_algebraic = 
@@ -91,25 +91,31 @@ let constraints ctx = snd ctx.uctx_local
 
 let context ctx = Univ.ContextSet.to_context ctx.uctx_local
 
+let const_univ_entry ~poly uctx =
+  let open Entries in
+  if poly then Polymorphic_const_entry (context uctx)
+  else Monomorphic_const_entry (context_set uctx)
+
+(* does not support cumulativity since you need more info *)
+let ind_univ_entry ~poly uctx =
+  let open Entries in
+  if poly then Polymorphic_ind_entry (context uctx)
+  else Monomorphic_ind_entry (context_set uctx)
+
 let of_context_set ctx = { empty with uctx_local = ctx }
 
 let subst ctx = ctx.uctx_univ_variables
 
 let ugraph ctx = ctx.uctx_universes
 
-let algebraics ctx = ctx.uctx_univ_algebraic
+let initial_graph ctx = ctx.uctx_initial_universes
 
-let constrain_variables diff ctx =
-  Univ.LSet.fold
-    (fun l cstrs ->
-      try
-        match Univ.LMap.find l ctx.uctx_univ_variables with
-        | Some u -> Univ.Constraint.add (l, Univ.Eq, Option.get (Univ.Universe.level u)) cstrs
-        | None -> cstrs
-      with Not_found | Option.IsNone -> cstrs)
-    diff Univ.Constraint.empty
+let algebraics ctx = ctx.uctx_univ_algebraic
 
 let add_uctx_names ?loc s l (names, names_rev) =
+  if UNameMap.mem s names
+  then user_err ?loc ~hdr:"add_uctx_names"
+      Pp.(str "Universe " ++ Names.Id.print s ++ str" already bound.");
   (UNameMap.add s l names, Univ.LMap.add l { uname = Some s; uloc = loc } names_rev)
 
 let add_uctx_loc l loc (names, names_rev) =
@@ -119,13 +125,17 @@ let add_uctx_loc l loc (names, names_rev) =
 
 let of_binders b =
   let ctx = empty in
-  let names =
-    List.fold_left (fun acc (id, l) -> add_uctx_names (Id.to_string id) l acc)
-                   ctx.uctx_names b
-  in { ctx with uctx_names = names }
+  let rmap =
+    UNameMap.fold (fun id l rmap ->
+        Univ.LMap.add l { uname = Some id; uloc = None } rmap)
+      b Univ.LMap.empty
+  in
+  { ctx with uctx_names = b, rmap }
+
+let universe_binders ctx = fst ctx.uctx_names
 
 let instantiate_variable l b v =
-  try v := Univ.LMap.update l (Some b) !v
+  try v := Univ.LMap.set l (Some b) !v
   with Not_found -> assert false
 
 exception UniversesDiffer
@@ -191,14 +201,18 @@ let process_universe_constraints ctx cstrs =
               | None -> user_err Pp.(str "Algebraic universe on the right")
               | Some r' ->
                 if Univ.Level.is_small r' then
-                  let levels = Univ.Universe.levels l in
-                  let fold l' local =
-                    let l = Univ.Universe.make l' in
-                    if Univ.Level.is_small l' || is_local l' then
-                      equalize_variables false l l' r r' local
-                    else raise (Univ.UniverseInconsistency (Univ.Le, l, r, None))
-                  in
-                  Univ.LSet.fold fold levels local
+                  if not (Univ.Universe.is_levels l)
+                  then
+                    raise (Univ.UniverseInconsistency (Univ.Le, l, r, None))
+                  else
+                    let levels = Univ.Universe.levels l in
+                    let fold l' local =
+                      let l = Univ.Universe.make l' in
+                      if Univ.Level.is_small l' || is_local l' then
+                        equalize_variables false l l' r r' local
+                      else raise (Univ.UniverseInconsistency (Univ.Le, l, r, None))
+                    in
+                    Univ.LSet.fold fold levels local
                 else
                   Univ.enforce_leq l r local
               end
@@ -230,8 +244,8 @@ let add_constraints ctx cstrs =
       uctx_univ_variables = vars;
       uctx_universes = UGraph.merge_constraints local' ctx.uctx_universes }
 
-(* let addconstrkey = Profile.declare_profile "add_constraints_context";; *)
-(* let add_constraints_context = Profile.profile2 addconstrkey add_constraints_context;; *)
+(* let addconstrkey = CProfile.declare_profile "add_constraints_context";; *)
+(* let add_constraints_context = CProfile.profile2 addconstrkey add_constraints_context;; *)
 
 let add_universe_constraints ctx cstrs =
   let univs, local = ctx.uctx_local in
@@ -240,53 +254,140 @@ let add_universe_constraints ctx cstrs =
       uctx_univ_variables = vars;
       uctx_universes = UGraph.merge_constraints local' ctx.uctx_universes }
 
-let pr_uctx_level uctx = 
+let constrain_variables diff ctx =
+  let univs, local = ctx.uctx_local in
+  let univs, vars, local =
+    Univ.LSet.fold
+      (fun l (univs, vars, cstrs) ->
+        try
+          match Univ.LMap.find l vars with
+          | Some u ->
+             (Univ.LSet.add l univs,
+              Univ.LMap.remove l vars,
+              Univ.Constraint.add (l, Univ.Eq, Option.get (Univ.Universe.level u)) cstrs)
+          | None -> (univs, vars, cstrs)
+        with Not_found | Option.IsNone -> (univs, vars, cstrs))
+      diff (univs, ctx.uctx_univ_variables, local)
+  in
+  { ctx with uctx_local = (univs, local); uctx_univ_variables = vars }
+  
+let reference_of_level uctx =
   let map, map_rev = uctx.uctx_names in 
     fun l ->
-      try str (Option.get (Univ.LMap.find l map_rev).uname)
+      try Libnames.Ident (Loc.tag @@ Option.get (Univ.LMap.find l map_rev).uname)
       with Not_found | Option.IsNone ->
-        Universes.pr_with_global_universes l
-
-let universe_context ?names ctx =
-  match names with
-  | None -> [], Univ.ContextSet.to_context ctx.uctx_local
-  | Some pl ->
-     let levels = Univ.ContextSet.levels ctx.uctx_local in
-     let newinst, map, left =
-       List.fold_right
-         (fun (loc,id) (newinst, map, acc) ->
-          let l =
-            try UNameMap.find (Id.to_string id) (fst ctx.uctx_names)
-            with Not_found ->
-              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 =
-           try
-             let info =
-               Univ.LMap.find (Univ.LSet.choose left) (snd ctx.uctx_names) in
-             info.uloc
-           with Not_found -> None
-         in
-           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,
-          Univ.ContextSet.constraints ctx.uctx_local)
-        in map, ctx
+        Universes.reference_of_level l
+
+let pr_uctx_level uctx l =
+  Libnames.pr_reference (reference_of_level uctx l)
+
+type universe_decl =
+  (Misctypes.lident list, Univ.Constraint.t) Misctypes.gen_universe_decl
+
+let error_unbound_universes left uctx =
+  let open Univ in
+  let n = LSet.cardinal left in
+  let loc =
+    try
+      let info =
+        LMap.find (LSet.choose left) (snd uctx.uctx_names) in
+      info.uloc
+    with Not_found -> None
+  in
+  user_err ?loc ~hdr:"universe_context"
+    ((str(CString.plural n "Universe") ++ spc () ++
+      LSet.pr (pr_uctx_level uctx) left ++
+      spc () ++ str (CString.conjugate_verb_to_be n) ++
+      str" unbound."))
+
+let universe_context ~names ~extensible uctx =
+  let open Univ in
+  let levels = ContextSet.levels uctx.uctx_local in
+  let newinst, left =
+    List.fold_right
+      (fun { CAst.loc; v = id } (newinst, acc) ->
+         let l =
+           try UNameMap.find id (fst uctx.uctx_names)
+           with Not_found -> assert false
+         in (l :: newinst, LSet.remove l acc))
+      names ([], levels)
+  in
+  if not extensible && not (LSet.is_empty left)
+  then error_unbound_universes left uctx
+  else
+    let left = ContextSet.sort_levels (Array.of_list (LSet.elements left)) in
+    let inst = Array.append (Array.of_list newinst) left in
+    let inst = Instance.of_array inst in
+    let ctx = UContext.make (inst, ContextSet.constraints uctx.uctx_local) in
+    ctx
+
+let check_universe_context_set ~names ~extensible uctx =
+  if extensible then ()
+  else
+    let open Univ in
+    let left = List.fold_left (fun left { CAst.loc; v = id } ->
+        let l =
+          try UNameMap.find id (fst uctx.uctx_names)
+          with Not_found -> assert false
+        in LSet.remove l left)
+        (ContextSet.levels uctx.uctx_local) names
+    in
+    if not (LSet.is_empty left)
+    then error_unbound_universes left uctx
+
+let check_implication uctx cstrs cstrs' =
+  let gr = initial_graph uctx in
+  let grext = UGraph.merge_constraints cstrs gr in
+  if UGraph.check_constraints cstrs' grext then ()
+  else CErrors.user_err ~hdr:"check_univ_decl"
+      (str "Universe constraints are not implied by the ones declared.")
+
+let check_mono_univ_decl uctx decl =
+  let open Misctypes in
+  let () =
+    let names = decl.univdecl_instance in
+    let extensible = decl.univdecl_extensible_instance in
+    check_universe_context_set ~names ~extensible uctx
+  in
+  if not decl.univdecl_extensible_constraints then
+    check_implication uctx
+      decl.univdecl_constraints
+      (Univ.ContextSet.constraints uctx.uctx_local);
+  uctx.uctx_local
+
+let check_univ_decl ~poly uctx decl =
+  let open Misctypes in
+  let ctx =
+    let names = decl.univdecl_instance in
+    let extensible = decl.univdecl_extensible_instance in
+    if poly
+    then Entries.Polymorphic_const_entry (universe_context ~names ~extensible uctx)
+    else
+      let () = check_universe_context_set ~names ~extensible uctx in
+      Entries.Monomorphic_const_entry uctx.uctx_local
+  in
+  if not decl.univdecl_extensible_constraints then
+    check_implication uctx
+      decl.univdecl_constraints
+      (Univ.ContextSet.constraints uctx.uctx_local);
+  ctx
 
 let restrict ctx vars =
+  let vars = Univ.LSet.union vars ctx.uctx_seff_univs in
+  let vars = Names.Id.Map.fold (fun na l vars -> Univ.LSet.add l vars)
+      (fst ctx.uctx_names) vars
+  in
   let uctx' = Univops.restrict_universe_context ctx.uctx_local vars in
   { ctx with uctx_local = uctx' }
 
+let demote_seff_univs entry uctx =
+  let open Entries in
+  match entry.const_entry_universes with
+  | Polymorphic_const_entry _ -> uctx
+  | Monomorphic_const_entry (univs, _) ->
+    let seff = Univ.LSet.union uctx.uctx_seff_univs univs in
+    { uctx with uctx_seff_univs = seff }
+
 type rigid = 
   | UnivRigid
   | UnivFlexible of bool (** Is substitution by an algebraic ok? *)
@@ -348,7 +449,7 @@ let emit_side_effects eff u =
 
 let new_univ_variable ?loc rigid name
   ({ uctx_local = ctx; uctx_univ_variables = uvars; uctx_univ_algebraic = avars} as uctx) =
-  let u = Universes.new_univ_level (Global.current_dirpath ()) in
+  let u = Universes.new_univ_level () in
   let ctx' = Univ.ContextSet.add_universe u ctx in
   let uctx', pred =
     match rigid with
@@ -405,6 +506,9 @@ let make_flexible_variable ctx ~algebraic u =
   {ctx with uctx_univ_variables = uvars'; 
       uctx_univ_algebraic = avars'}
 
+let make_flexible_nonalgebraic ctx =
+  {ctx with uctx_univ_algebraic = Univ.LSet.empty}
+
 let is_sort_variable uctx s = 
   match s with 
   | Sorts.Type u -> 
@@ -416,7 +520,7 @@ let is_sort_variable uctx s =
   | _ -> None
 
 let subst_univs_context_with_def def usubst (ctx, cst) =
-  (Univ.LSet.diff ctx def, Univ.subst_univs_constraints usubst cst)
+  (Univ.LSet.diff ctx def, Universes.subst_univs_constraints usubst cst)
 
 let normalize_variables uctx =
   let normalized_variables, undef, def, subst = 
@@ -465,7 +569,8 @@ let refresh_undefined_univ_variables uctx =
   let initial = declare uctx.uctx_initial_universes in
   let univs = declare UGraph.initial_universes in
   let uctx' = {uctx_names = uctx.uctx_names;
-               uctx_local = ctx'; 
+               uctx_local = ctx';
+               uctx_seff_univs = uctx.uctx_seff_univs;
                uctx_univ_variables = vars; uctx_univ_algebraic = alg;
                uctx_universes = univs;
                uctx_initial_universes = initial } in
@@ -482,7 +587,8 @@ let normalize uctx =
       Universes.refresh_constraints uctx.uctx_initial_universes us'
     in
       { uctx_names = uctx.uctx_names;
-        uctx_local = us'; 
+        uctx_local = us';
+        uctx_seff_univs = uctx.uctx_seff_univs; (* not sure about this *)
         uctx_univ_variables = vars'; 
         uctx_univ_algebraic = algs';
         uctx_universes = universes;
@@ -491,10 +597,6 @@ let normalize uctx =
 let universe_of_name uctx s = 
   UNameMap.find s (fst uctx.uctx_names)
 
-let add_universe_name uctx s l =
-  let names' = add_uctx_names s l uctx.uctx_names in
-  { uctx with uctx_names = names' }
-
 let update_sigma_env uctx env =
   let univs = Environ.universes env in
   let eunivs =
diff --git a/engine/uState.mli b/engine/uState.mli
index d198fbfbe..5c85b2b84 100644
--- a/engine/uState.mli
+++ b/engine/uState.mli
@@ -28,13 +28,15 @@ val is_empty : t -> bool
 
 val union : t -> t -> t
 
-val of_context_set : Univ.universe_context_set -> t
+val of_context_set : Univ.ContextSet.t -> t
 
 val of_binders : Universes.universe_binders -> t
 
+val universe_binders : t -> Universes.universe_binders
+
 (** {5 Projections} *)
 
-val context_set : t -> Univ.universe_context_set
+val context_set : t -> Univ.ContextSet.t
 (** The local context of the state, i.e. a set of bound variables together
     with their associated constraints. *)
 
@@ -44,39 +46,48 @@ val subst : t -> Universes.universe_opt_subst
 val ugraph : t -> UGraph.t
 (** The current graph extended with the local constraints *)
 
+val initial_graph : t -> UGraph.t
+(** The initial graph with just the declarations of new universes. *)
+
 val algebraics : t -> Univ.LSet.t
 (** The subset of unification variables that can be instantiated with algebraic
     universes as they appear in inferred types only. *)
 
-val constraints : t -> Univ.constraints
+val constraints : t -> Univ.Constraint.t
 (** Shorthand for {!context_set} composed with {!ContextSet.constraints}. *)
 
-val context : t -> Univ.universe_context
+val context : t -> Univ.UContext.t
 (** Shorthand for {!context_set} with {!Context_set.to_context}. *)
 
+val const_univ_entry : poly:bool -> t -> Entries.constant_universes_entry
+(** Pick from {!context} or {!context_set} based on [poly]. *)
+
+val ind_univ_entry : poly:bool -> t -> Entries.inductive_universes
+(** Pick from {!context} or {!context_set} based on [poly].
+    Cannot create cumulative entries. *)
+
 (** {5 Constraints handling} *)
 
-val add_constraints : t -> Univ.constraints -> t
+val add_constraints : t -> Univ.Constraint.t -> t
 (**
   @raise UniversesDiffer when universes differ
 *)
 
-val add_universe_constraints : t -> Universes.universe_constraints -> t
+val add_universe_constraints : t -> Universes.Constraints.t -> t
 (**
   @raise UniversesDiffer when universes differ
 *)
 
 (** {5 Names} *)
 
-val add_universe_name : t -> string -> Univ.Level.t -> t
-(** Associate a human-readable name to a local variable. *)
-
-val universe_of_name : t -> string -> Univ.Level.t
+val universe_of_name : t -> Id.t -> Univ.Level.t
 (** Retrieve the universe associated to the name. *)
 
 (** {5 Unification} *)
 
-val restrict : t -> Univ.universe_set -> t
+val restrict : t -> Univ.LSet.t -> t
+
+val demote_seff_univs : Safe_typing.private_constants Entries.definition_entry -> t -> t
 
 type rigid = 
   | UnivRigid
@@ -86,11 +97,11 @@ val univ_rigid : rigid
 val univ_flexible : rigid
 val univ_flexible_alg : rigid
 
-val merge : ?loc:Loc.t -> bool -> rigid -> t -> Univ.universe_context_set -> t
+val merge : ?loc:Loc.t -> bool -> rigid -> t -> Univ.ContextSet.t -> t
 val merge_subst : t -> Universes.universe_opt_subst -> t
 val emit_side_effects : Safe_typing.private_constants -> t -> t
 
-val new_univ_variable : ?loc:Loc.t -> rigid -> string option -> t -> t * Univ.Level.t
+val new_univ_variable : ?loc:Loc.t -> rigid -> Id.t option -> t -> t * Univ.Level.t
 val add_global_univ : t -> Univ.Level.t -> t
 
 (** [make_flexible_variable g algebraic l]
@@ -101,11 +112,16 @@ val add_global_univ : t -> Univ.Level.t -> t
   universe. Otherwise the variable is just made flexible. *)
 val make_flexible_variable : t -> algebraic:bool -> Univ.Level.t -> t
 
+(** Turn all undefined flexible algebraic variables into simply flexible
+   ones. Can be used in case the variables might appear in universe instances
+   (typically for polymorphic program obligations). *)
+val make_flexible_nonalgebraic : t -> t
+
 val is_sort_variable : t -> Sorts.t -> Univ.Level.t option
 
 val normalize_variables : t -> Univ.universe_subst * t
 
-val constrain_variables : Univ.LSet.t -> t -> Univ.constraints
+val constrain_variables : Univ.LSet.t -> t -> t
 
 val abstract_undefined_variables : t -> t
 
@@ -115,12 +131,29 @@ val refresh_undefined_univ_variables : t -> t * Univ.universe_level_subst
 
 val normalize : t -> t
 
-(** {5 TODO: Document me} *)
+type universe_decl =
+  (Misctypes.lident list, Univ.Constraint.t) Misctypes.gen_universe_decl
+
+(** [check_univ_decl ctx decl]
+
+   If non extensible in [decl], check that the local universes (resp.
+   universe constraints) in [ctx] are implied by [decl].
+
+   Return a [Entries.constant_universes_entry] containing the local
+   universes of [ctx] and their constraints.
 
-val universe_context : ?names:(Id.t Loc.located) list -> t -> (Id.t * Univ.Level.t) list * Univ.universe_context
+   When polymorphic, the universes corresponding to
+   [decl.univdecl_instance] come first in the order defined by that
+   list. *)
+val check_univ_decl : poly:bool -> t -> universe_decl -> Entries.constant_universes_entry
+
+val check_mono_univ_decl : t -> universe_decl -> Univ.ContextSet.t
+
+(** {5 TODO: Document me} *)
 
 val update_sigma_env : t -> Environ.env -> t
 
 (** {5 Pretty-printing} *)
 
 val pr_uctx_level : t -> Univ.Level.t -> Pp.t
+val reference_of_level : t -> Univ.Level.t -> Libnames.reference
diff --git a/engine/universes.ml b/engine/universes.ml
index 719af43ed..f3660a559 100644
--- a/engine/universes.ml
+++ b/engine/universes.ml
@@ -6,32 +6,107 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+open Sorts
 open Util
 open Pp
 open Names
-open Term
+open Constr
 open Environ
 open Univ
 open Globnames
-
-let pr_with_global_universes l = 
-  try Nameops.pr_id (LMap.find l (snd (Global.global_universe_names ())))
-  with Not_found -> Level.pr l
+open Nametab
+
+let reference_of_level l =
+  match Level.name l with
+  | Some (d, n as na)  ->
+     let qid =
+       try Nametab.shortest_qualid_of_universe na
+       with Not_found ->
+         let name = Id.of_string_soft (string_of_int n) in
+         Libnames.make_qualid d name
+     in Libnames.Qualid (Loc.tag @@ qid)
+  | None -> Libnames.Ident (Loc.tag @@ Id.of_string_soft (Level.to_string l))
+
+let pr_with_global_universes l = Libnames.pr_reference (reference_of_level l)
+
+(** Global universe information outside the kernel, to handle
+    polymorphic universe names in sections that have to be discharged. *)
+
+let universe_map = (Summary.ref UnivIdMap.empty ~name:"global universe info" : bool Nametab.UnivIdMap.t ref)
+
+let add_global_universe u p =
+  match Level.name u with
+  | Some n -> universe_map := Nametab.UnivIdMap.add n p !universe_map
+  | None -> ()
+
+let is_polymorphic l =
+  match Level.name l with
+  | Some n ->
+     (try Nametab.UnivIdMap.find n !universe_map
+      with Not_found -> false)
+  | None -> false
 
 (** Local universe names of polymorphic references *)
 
-type universe_binders = (Id.t * Univ.universe_level) list
+type universe_binders = Univ.Level.t Names.Id.Map.t
+
+let empty_binders = Id.Map.empty
 
 let universe_binders_table = Summary.ref Refmap.empty ~name:"universe binders"
 
-let universe_binders_of_global ref =
+let universe_binders_of_global ref : universe_binders =
   try
     let l = Refmap.find ref !universe_binders_table in l
-  with Not_found -> []
+  with Not_found -> Names.Id.Map.empty
 
-let register_universe_binders ref l =
+let cache_ubinder (_,(ref,l)) =
   universe_binders_table := Refmap.add ref l !universe_binders_table
-		     
+
+let subst_ubinder (subst,(ref,l as orig)) =
+  let ref' = fst (Globnames.subst_global subst ref) in
+  if ref == ref' then orig else ref', l
+
+let discharge_ubinder (_,(ref,l)) =
+  Some (Lib.discharge_global ref, l)
+
+let ubinder_obj : Globnames.global_reference * universe_binders -> Libobject.obj =
+  let open Libobject in
+  declare_object { (default_object "universe binder") with
+    cache_function = cache_ubinder;
+    load_function = (fun _ x -> cache_ubinder x);
+    classify_function = (fun x -> Substitute x);
+    subst_function = subst_ubinder;
+    discharge_function = discharge_ubinder;
+    rebuild_function = (fun x -> x); }
+
+let register_universe_binders ref ubinders =
+  let open Names in
+  (* Add the polymorphic (section) universes *)
+  let ubinders = UnivIdMap.fold (fun lvl poly ubinders ->
+    let qid = Nametab.shortest_qualid_of_universe lvl in
+    let level = Level.make (fst lvl) (snd lvl) in
+    if poly then Id.Map.add (snd (Libnames.repr_qualid qid)) level ubinders
+    else ubinders)
+    !universe_map ubinders
+  in
+  if not (Id.Map.is_empty ubinders)
+  then Lib.add_anonymous_leaf (ubinder_obj (ref,ubinders))
+
+type univ_name_list = Misctypes.lname list
+
+let universe_binders_with_opt_names ref levels = function
+  | None -> universe_binders_of_global ref
+  | Some udecl ->
+    if Int.equal(List.length levels) (List.length udecl)
+    then
+      List.fold_left2 (fun acc { CAst.v = na} lvl -> match na with
+          | Anonymous -> acc
+          | Name na -> Names.Id.Map.add na lvl acc)
+        empty_binders udecl levels
+    else
+      CErrors.user_err ~hdr:"universe_binders_with_opt_names"
+        Pp.(str "Universe instance should have length " ++ int (List.length levels))
+
 (* To disallow minimization to Set *)
 
 let set_minimization = ref true
@@ -39,7 +114,7 @@ let is_set_minimization () = !set_minimization
 			    
 type universe_constraint_type = ULe | UEq | ULub
 
-type universe_constraint = universe * universe_constraint_type * universe
+type universe_constraint = Universe.t * universe_constraint_type * Universe.t
 
 module Constraints = struct
   module S = Set.Make(
@@ -106,6 +181,30 @@ let enforce_eq_instances_univs strict x y c =
       (fun x y -> Constraints.add (Universe.make x, d, Universe.make y))
       ax ay c
 
+let enforce_univ_constraint (u,d,v) =
+  match d with
+  | Eq -> enforce_eq u v
+  | Le -> enforce_leq u v
+  | Lt -> enforce_leq (super u) v
+
+let subst_univs_level fn l =
+  try Some (fn l)
+  with Not_found -> None
+
+let subst_univs_constraint fn (u,d,v as c) cstrs =
+  let u' = subst_univs_level fn u in
+  let v' = subst_univs_level fn v in
+  match u', v' with
+  | None, None -> Constraint.add c cstrs
+  | Some u, None -> enforce_univ_constraint (u,d,Universe.make v) cstrs
+  | None, Some v -> enforce_univ_constraint (Universe.make u,d,v) cstrs
+  | Some u, Some v -> enforce_univ_constraint (u,d,v) cstrs
+
+let subst_univs_constraints subst csts =
+  Constraint.fold
+    (fun c cstrs -> subst_univs_constraint subst c cstrs)
+    csts Constraint.empty
+
 let subst_univs_universe_constraint fn (u,d,v) =
   let u' = subst_univs_universe fn u and v' = subst_univs_universe fn v in
     if Universe.equal u' v' then None
@@ -131,47 +230,6 @@ let to_constraints g s =
 		   "to_constraints: non-trivial algebraic constraint between universes")
   in Constraints.fold tr s Constraint.empty
 
-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 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 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 =
@@ -197,48 +255,12 @@ 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 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' = 
-      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 leq_sorts s1 s2 = 
-      if Sorts.equal s1 s2 then true
-      else 
-	(cstrs := Constraints.add 
-	   (Sorts.univ_of_sort s1,ULe,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 =
-      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
+  match kind m, kind n with
   | Proj (p, c), App (f, args)
   | App (f, args), Proj (p, c) -> 
-      (match kind_of_term f with
-      | Const (p', u) when eq_constant (Projection.constant p) p' -> 
+      (match kind f with
+      | Const (p', u) when Constant.equal (Projection.constant p) p' -> 
           let pb = Environ.lookup_projection p env in
           let npars = pb.Declarations.proj_npars in
 	  if Array.length args == npars + 1 then
@@ -267,14 +289,17 @@ let eq_constr_universes_proj env m n =
     res, !cstrs
 
 (* Generator of levels *)
-let new_univ_level, set_remote_new_univ_level =
+type universe_id = DirPath.t * int
+
+let new_univ_id, set_remote_new_univ_id =
   RemoteCounter.new_counter ~name:"Universes" 0 ~incr:((+) 1)
-    ~build:(fun n -> Univ.Level.make (Global.current_dirpath ()) n)
+    ~build:(fun n -> Global.current_dirpath (), n)
 
-let new_univ_level _ = new_univ_level ()
-  (* Univ.Level.make db (new_univ_level ()) *)
+let new_univ_level () =
+  let dp, id = new_univ_id () in
+  Univ.Level.make dp id
 
-let fresh_level () = new_univ_level (Global.current_dirpath ())
+let fresh_level () = new_univ_level ()
 
 (* TODO: remove *)
 let new_univ dp = Univ.Universe.make (new_univ_level dp)
@@ -282,7 +307,7 @@ let new_Type dp = mkType (new_univ dp)
 let new_Type_sort dp = Type (new_univ dp)
 
 let fresh_universe_instance ctx =
-  let init _ = new_univ_level (Global.current_dirpath ()) in
+  let init _ = new_univ_level () in
   Instance.of_array (Array.init (AUContext.size ctx) init)
 
 let fresh_instance_from_context ctx =
@@ -293,7 +318,7 @@ let fresh_instance_from_context ctx =
 let fresh_instance ctx =
   let ctx' = ref LSet.empty in
   let init _ =
-    let u = new_univ_level (Global.current_dirpath ()) in
+    let u = new_univ_level () in
     ctx' := LSet.add u !ctx'; u
   in
   let inst = Instance.of_array (Array.init (AUContext.size ctx) init)
@@ -405,7 +430,7 @@ let fresh_global_or_constr_instance env = function
   | IsGlobal gr -> fresh_global_instance env gr
 
 let global_of_constr c =
-  match kind_of_term c with
+  match kind c with
   | Const (c, u) -> ConstRef c, u
   | Ind (i, u) -> IndRef i, u
   | Construct (c, u) -> ConstructRef c, u
@@ -467,8 +492,8 @@ let type_of_reference env r =
 let type_of_global t = type_of_reference (Global.env ()) t
 
 let fresh_sort_in_family env = function
-  | InProp -> prop_sort, ContextSet.empty
-  | InSet -> set_sort, ContextSet.empty
+  | InProp -> Sorts.prop, ContextSet.empty
+  | InSet -> Sorts.set, ContextSet.empty
   | InType -> 
     let u = fresh_level () in
       Type (Univ.Universe.make u), ContextSet.singleton u
@@ -490,7 +515,7 @@ module LevelUnionFind = Unionfind.Make (Univ.LSet) (Univ.LMap)
 let add_list_map u t map =
   try
     let l = LMap.find u map in
-    LMap.update u (t :: l) map
+    LMap.set u (t :: l) map
   with Not_found ->
     LMap.add u [t] map
 
@@ -518,15 +543,62 @@ let choose_canonical ctx flexible algs s =
 	      let canon = LSet.choose algs in
 		canon, (global, rigid, LSet.remove canon flexible)
 
+let level_subst_of f =
+  fun l ->
+    try let u = f l in
+          match Universe.level u with
+          | None -> l
+          | Some l -> l
+    with Not_found -> l
+
+let subst_univs_fn_constr f c =
+  let changed = ref false in
+  let fu = Univ.subst_univs_universe f in
+  let fi = Univ.Instance.subst_fn (level_subst_of f) in
+  let rec aux t =
+    match kind t with
+    | Sort (Sorts.Type u) ->
+      let u' = fu u in
+        if u' == u then t else
+          (changed := true; mkSort (Sorts.sort_of_univ u'))
+    | Const (c, u) ->
+      let u' = fi u in
+        if u' == u then t
+        else (changed := true; mkConstU (c, u'))
+    | Ind (i, u) ->
+      let u' = fi u in
+        if u' == u then t
+        else (changed := true; mkIndU (i, u'))
+    | Construct (c, u) ->
+      let u' = fi u in
+        if u' == u then t
+        else (changed := true; mkConstructU (c, u'))
+    | _ -> map aux t
+  in
+  let c' = aux c in
+    if !changed then c' else c
+
+let subst_univs_constr subst c =
+  if Univ.is_empty_subst subst then c
+  else
+    let f = Univ.make_subst subst in
+      subst_univs_fn_constr f c
+
+let subst_univs_constr =
+  if Flags.profile then
+    let subst_univs_constr_key = CProfile.declare_profile "subst_univs_constr" in
+      CProfile.profile2 subst_univs_constr_key subst_univs_constr
+  else subst_univs_constr
+
 let subst_univs_fn_puniverses lsubst (c, u as cu) =
   let u' = Instance.subst_fn lsubst u in
     if u' == u then cu else (c, u')
 
 let nf_evars_and_universes_opt_subst f subst =
   let subst = fun l -> match LMap.find l subst with None -> raise Not_found | Some l' -> l' in
-  let lsubst = Univ.level_subst_of subst in
+  let lsubst = level_subst_of subst in
   let rec aux c =
-    match kind_of_term c with
+    match kind c with
     | Evar (evk, args) ->
       let args = Array.map aux args in
       (match try f (evk, args) with Not_found -> None with
@@ -544,7 +616,7 @@ let nf_evars_and_universes_opt_subst f subst =
     | Sort (Type u) ->
       let u' = Univ.subst_univs_universe subst u in
 	if u' == u then c else mkSort (sort_of_univ u')
-    | _ -> map_constr aux c
+    | _ -> Constr.map aux c
   in aux
 
 let fresh_universe_context_set_instance ctx =
@@ -583,7 +655,7 @@ let normalize_univ_variable_subst subst =
   let find l = Univ.LMap.find l !subst in
   let update l b =
     assert (match Universe.level b with Some l' -> not (Level.equal l l') | None -> true);
-    try subst := Univ.LMap.update l b !subst; b with Not_found -> assert false in
+    try subst := Univ.LMap.set l b !subst; b with Not_found -> assert false in
     normalize_univ_variable ~find ~update
 
 let normalize_universe_opt_subst subst =
@@ -603,8 +675,8 @@ let normalize_opt_subst ctx =
       else try ignore(normalize u) with Not_found -> assert(false)) ctx 
   in !ectx
 
-type universe_opt_subst = universe option universe_map
-	  
+type universe_opt_subst = Universe.t option universe_map
+
 let make_opt_subst s = 
   fun x -> 
     (match Univ.LMap.find x s with
@@ -613,8 +685,7 @@ let make_opt_subst s =
 
 let subst_opt_univs_constr s = 
   let f = make_opt_subst s in
-    Vars.subst_univs_fn_constr f
-
+  subst_univs_fn_constr f
 
 let normalize_univ_variables ctx = 
   let ctx = normalize_opt_subst ctx in
@@ -865,7 +936,7 @@ let normalize_context_set ctx us algs =
     (* We first put constraints in a normal-form: all self-loops are collapsed
        to equalities. *)
     let g = Univ.LSet.fold (fun v g -> UGraph.add_universe v false g)
-			   ctx UGraph.empty_universes
+			   ctx UGraph.initial_universes
     in
     let g =
       Univ.Constraint.fold
@@ -945,8 +1016,8 @@ let normalize_context_set ctx us algs =
   let us = normalize_opt_subst us in
     (us, algs), (ctx', Constraint.union noneqs eqs)
 
-(* let normalize_conkey = Profile.declare_profile "normalize_context_set" *)
-(* let normalize_context_set a b c = Profile.profile3 normalize_conkey normalize_context_set a b c *)
+(* let normalize_conkey = CProfile.declare_profile "normalize_context_set" *)
+(* let normalize_context_set a b c = CProfile.profile3 normalize_conkey normalize_context_set a b c *)
 
 let is_trivial_leq (l,d,r) =
   Univ.Level.is_prop l && (d == Univ.Le || (d == Univ.Lt && Univ.Level.is_set r))
@@ -1032,14 +1103,3 @@ let solve_constraints_system levels level_bounds level_min =
     done;
   done;
   v
-
-
-(** Operations for universe_info_ind *)
-
-(** Given a universe context representing constraints of an inductive
-    this function produces a UInfoInd.t that with the trivial subtyping relation. *)
-let univ_inf_ind_from_universe_context univcst =
-  let freshunivs = Instance.of_array
-      (Array.map (fun _ -> new_univ_level ())
-         (Instance.to_array (UContext.instance univcst)))
-  in CumulativityInfo.from_universe_context univcst freshunivs
diff --git a/engine/universes.mli b/engine/universes.mli
index fe40f8238..04586a6f8 100644
--- a/engine/universes.mli
+++ b/engine/universes.mli
@@ -8,7 +8,7 @@
 
 open Util
 open Names
-open Term
+open Constr
 open Environ
 open Univ
 
@@ -18,29 +18,52 @@ val is_set_minimization : unit -> bool
 (** Universes *)
 
 val pr_with_global_universes : Level.t -> Pp.t
+val reference_of_level : Level.t -> Libnames.reference
+
+(** Global universe information outside the kernel, to handle
+    polymorphic universes in sections that have to be discharged. *)
+val add_global_universe : Level.t -> Decl_kinds.polymorphic -> unit
+
+val is_polymorphic : Level.t -> bool
 
 (** Local universe name <-> level mapping *)
 
-type universe_binders = (Id.t * Univ.universe_level) list
-					   
+type universe_binders = Univ.Level.t Names.Id.Map.t
+
+val empty_binders : universe_binders
+
 val register_universe_binders : Globnames.global_reference -> universe_binders -> unit
 val universe_binders_of_global : Globnames.global_reference -> universe_binders
 
+type univ_name_list = Misctypes.lname list
+
+(** [universe_binders_with_opt_names ref u l]
+
+    If [l] is [Some univs] return the universe binders naming the levels of [u] by [univs] (skipping Anonymous).
+    May error if the lengths mismatch.
+
+    Otherwise return [universe_binders_of_global ref]. *)
+val universe_binders_with_opt_names : Globnames.global_reference ->
+  Univ.Level.t list -> univ_name_list option -> universe_binders
+
 (** The global universe counter *)
-val set_remote_new_univ_level : universe_level RemoteCounter.installer
+type universe_id = DirPath.t * int
+
+val set_remote_new_univ_id : universe_id RemoteCounter.installer
 
 (** Side-effecting functions creating new universe levels. *)
 
-val new_univ_level : Names.dir_path -> universe_level
-val new_univ : Names.dir_path -> universe
-val new_Type : Names.dir_path -> types
-val new_Type_sort : Names.dir_path -> sorts
+val new_univ_id : unit -> universe_id
+val new_univ_level : unit -> Level.t
+val new_univ : unit -> Universe.t
+val new_Type : unit -> types
+val new_Type_sort : unit -> Sorts.t
 
-val new_global_univ : unit -> universe in_universe_context_set
-val new_sort_in_family : sorts_family -> sorts
+val new_global_univ : unit -> Universe.t in_universe_context_set
+val new_sort_in_family : Sorts.family -> Sorts.t
 
 (** {6 Constraints for type inference}
-    
+
     When doing conversion of universes, not only do we have =/<= constraints but
     also Lub constraints which correspond to unification of two levels which might
     not be necessary if unfolding is performed.
@@ -48,29 +71,26 @@ val new_sort_in_family : sorts_family -> sorts
 
 type universe_constraint_type = ULe | UEq | ULub
 
-type universe_constraint = universe * universe_constraint_type * universe
+type universe_constraint = Universe.t * universe_constraint_type * Universe.t
 module Constraints : sig
   include Set.S with type elt = universe_constraint
-		       
+
   val pr : t -> Pp.t
 end
 
 type universe_constraints = Constraints.t
-type 'a constraint_accumulator = universe_constraints -> 'a -> 'a option
-type 'a universe_constrained = 'a * universe_constraints
-type 'a universe_constraint_function = 'a -> 'a -> universe_constraints -> universe_constraints
+[@@ocaml.deprecated "Use Constraints.t"]
 
-val subst_univs_universe_constraints : universe_subst_fn -> 
-  universe_constraints -> universe_constraints
+type 'a constraint_accumulator = Constraints.t -> 'a -> 'a option
+type 'a universe_constrained = 'a * Constraints.t
+type 'a universe_constraint_function = 'a -> 'a -> Constraints.t -> Constraints.t
 
-val enforce_eq_instances_univs : bool -> universe_instance universe_constraint_function
+val subst_univs_universe_constraints : universe_subst_fn -> 
+  Constraints.t -> Constraints.t
 
-val to_constraints : UGraph.t -> universe_constraints -> constraints
+val enforce_eq_instances_univs : bool -> Instance.t universe_constraint_function
 
-(** [eq_constr_univs_infer u a b] is [true, c] if [a] equals [b] modulo alpha, casts,
-   application grouping, the universe constraints in [u] and additional constraints [c]. *)
-val eq_constr_univs_infer : UGraph.t -> 'a constraint_accumulator ->
-  constr -> constr -> 'a -> 'a option
+val to_constraints : UGraph.t -> Constraints.t -> Constraint.t
 
 (** [eq_constr_univs_infer_With kind1 kind2 univs m n] is a variant of
     {!eq_constr_univs_infer} taking kind-of-term functions, to expose
@@ -80,20 +100,6 @@ val eq_constr_univs_infer_with :
   (constr -> (constr, types, Sorts.t, Univ.Instance.t) kind_of_term) ->
   UGraph.t -> 'a constraint_accumulator -> constr -> constr -> 'a -> 'a option
 
-(** [leq_constr_univs u a b] is [true, c] if [a] is convertible to [b]
-    modulo alpha, casts, application grouping, the universe constraints
-    in [u] and additional constraints [c]. *)
-val leq_constr_univs_infer : UGraph.t -> 'a constraint_accumulator ->
-  constr -> constr -> 'a -> 'a option
-
-(** [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 -> 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 -> 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]. *)
 val eq_constr_universes_proj : env -> constr -> constr -> bool universe_constrained
@@ -101,15 +107,15 @@ val eq_constr_universes_proj : env -> constr -> constr -> bool universe_constrai
 (** Build a fresh instance for a given context, its associated substitution and 
     the instantiated constraints. *)
 
-val fresh_instance_from_context : abstract_universe_context -> 
-  universe_instance constrained
+val fresh_instance_from_context : AUContext.t -> 
+  Instance.t constrained
 
-val fresh_instance_from : abstract_universe_context -> universe_instance option ->
-  universe_instance in_universe_context_set
+val fresh_instance_from : AUContext.t -> Instance.t option ->
+  Instance.t in_universe_context_set
 
-val fresh_sort_in_family : env -> sorts_family -> 
-  sorts in_universe_context_set
-val fresh_constant_instance : env -> constant ->
+val fresh_sort_in_family : env -> Sorts.family -> 
+  Sorts.t in_universe_context_set
+val fresh_constant_instance : env -> Constant.t ->
   pconstant in_universe_context_set
 val fresh_inductive_instance : env -> inductive ->
   pinductive in_universe_context_set
@@ -124,15 +130,15 @@ val fresh_global_or_constr_instance : env -> Globnames.global_reference_or_const
 
 (** Get fresh variables for the universe context.
     Useful to make tactics that manipulate constrs in universe contexts polymorphic. *)
-val fresh_universe_context_set_instance : universe_context_set -> 
-  universe_level_subst * universe_context_set
+val fresh_universe_context_set_instance : ContextSet.t -> 
+  universe_level_subst * ContextSet.t
 
 (** Raises [Not_found] if not a global reference. *)
 val global_of_constr : constr -> Globnames.global_reference puniverses
 
 val constr_of_global_univ : Globnames.global_reference puniverses -> constr
 
-val extend_context : 'a in_universe_context_set -> universe_context_set -> 
+val extend_context : 'a in_universe_context_set -> ContextSet.t -> 
   'a in_universe_context_set
 
 (** Simplification and pruning of constraints:
@@ -146,38 +152,43 @@ val extend_context : 'a in_universe_context_set -> universe_context_set ->
     (a global one if there is one) and transitively saturate
     the constraints w.r.t to the equalities. *)
 
-module UF : Unionfind.PartitionSig with type elt = universe_level
+module UF : Unionfind.PartitionSig with type elt = Level.t
+
+val level_subst_of : universe_subst_fn -> universe_level_subst_fn
+val subst_univs_constraints : universe_subst_fn -> Constraint.t -> Constraint.t
+
+val subst_univs_constr : universe_subst -> constr -> constr
 
-type universe_opt_subst = universe option universe_map
+type universe_opt_subst = Universe.t option universe_map
 
 val make_opt_subst : universe_opt_subst -> universe_subst_fn
 
 val subst_opt_univs_constr : universe_opt_subst -> constr -> constr
 
-val normalize_context_set : universe_context_set -> 
+val normalize_context_set : ContextSet.t -> 
   universe_opt_subst (* The defined and undefined variables *) ->
-  universe_set (* univ variables that can be substituted by algebraics *) -> 
-  (universe_opt_subst * universe_set) in_universe_context_set
+  LSet.t (* univ variables that can be substituted by algebraics *) -> 
+  (universe_opt_subst * LSet.t) in_universe_context_set
 
 val normalize_univ_variables : universe_opt_subst -> 
-  universe_opt_subst * universe_set * universe_set * universe_subst
+  universe_opt_subst * LSet.t * LSet.t * universe_subst
 
 val normalize_univ_variable : 
-  find:(universe_level -> universe) ->
-  update:(universe_level -> universe -> universe) ->
-  universe_level -> universe
+  find:(Level.t -> Universe.t) ->
+  update:(Level.t -> Universe.t -> Universe.t) ->
+  Level.t -> Universe.t
 
 val normalize_univ_variable_opt_subst : universe_opt_subst ref ->
-  (universe_level -> universe)
+  (Level.t -> Universe.t)
 
 val normalize_univ_variable_subst : universe_subst ref ->
-  (universe_level -> universe)
+  (Level.t -> Universe.t)
 
 val normalize_universe_opt_subst : universe_opt_subst ref ->
-  (universe -> universe)
+  (Universe.t -> Universe.t)
 
 val normalize_universe_subst : universe_subst ref ->
-  (universe -> universe)
+  (Universe.t -> Universe.t)
 
 (** Create a fresh global in the global environment, without side effects.
     BEWARE: this raises an ANOMALY on polymorphic constants/inductives: 
@@ -188,6 +199,7 @@ val constr_of_global : Globnames.global_reference -> constr
 
 (** ** DEPRECATED ** synonym of [constr_of_global] *)
 val constr_of_reference : Globnames.global_reference -> constr
+[@@ocaml.deprecated "synonym of [constr_of_global]"]
 
 (** Returns the type of the global reference, by creating a fresh instance of polymorphic 
     references and computing their instantiated universe context. (side-effect on the
@@ -199,7 +211,7 @@ val type_of_global : Globnames.global_reference -> types in_universe_context_set
 val nf_evars_and_universes_opt_subst : (existential -> constr option) -> 
   universe_opt_subst -> constr -> constr
 
-val refresh_constraints : UGraph.t -> universe_context_set -> universe_context_set * UGraph.t
+val refresh_constraints : UGraph.t -> ContextSet.t -> ContextSet.t * UGraph.t
 
 (** Pretty-printing *)
 
@@ -207,11 +219,5 @@ val pr_universe_opt_subst : universe_opt_subst -> Pp.t
 
 (** {6 Support for template polymorphism } *)
 
-val solve_constraints_system : universe option array -> universe array -> universe array ->
-  universe array
-
-(** Operations for universe_info_ind *)
-
-(** Given a universe context representing constraints of an inductive
-    this function produces a UInfoInd.t that with the trivial subtyping relation. *)
-val univ_inf_ind_from_universe_context : universe_context -> cumulativity_info
+val solve_constraints_system : Universe.t option array -> Universe.t array -> Universe.t array ->
+  Universe.t array
diff --git a/engine/univops.ml b/engine/univops.ml
new file mode 100644
index 000000000..df25d8725
--- /dev/null
+++ b/engine/univops.ml
@@ -0,0 +1,111 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Univ
+open Constr
+
+let universes_of_constr env c =
+  let open Declarations in
+  let rec aux s c = 
+    match kind c with
+    | Const (c, u) ->
+      begin match (Environ.lookup_constant c env).const_universes with
+        | Polymorphic_const _ ->
+          LSet.fold LSet.add (Instance.levels u) s
+        | Monomorphic_const (univs, _) ->
+          LSet.union s univs
+      end
+    | Ind ((mind,_), u) | Construct (((mind,_),_), u) ->
+      begin match (Environ.lookup_mind mind env).mind_universes with
+        | Cumulative_ind _ | Polymorphic_ind _ ->
+          LSet.fold LSet.add (Instance.levels u) s
+        | Monomorphic_ind (univs,_) ->
+          LSet.union s univs
+      end
+    | Sort u when not (Sorts.is_small u) ->
+      let u = Sorts.univ_of_sort u in
+      LSet.fold LSet.add (Universe.levels u) s
+    | _ -> Constr.fold aux s c
+  in aux LSet.empty c
+
+type graphnode = {
+  mutable up : constraint_type LMap.t;
+  mutable visited : bool
+}
+
+let merge_types d d0 =
+  match d, d0 with
+  | _, Lt | Lt, _ -> Lt
+  | Le, _ | _, Le -> Le
+  | Eq, Eq -> Eq
+
+let merge_up d b up =
+  let find = try Some (LMap.find b up) with Not_found -> None in
+  match find with
+  | Some d0 ->
+    let d = merge_types d d0 in
+    if d == d0 then up else LMap.add b d up
+  | None -> LMap.add b d up
+
+let add_up a d b graph =
+  let node, graph =
+    try LMap.find a graph, graph
+    with Not_found ->
+      let node = { up = LMap.empty; visited = false } in
+      node, LMap.add a node graph
+  in
+  node.up <- merge_up d b node.up;
+  graph
+
+(* for each node transitive close until you find a non removable, discard the rest *)
+let transitive_close removable graph =
+  let rec do_node a node =
+    if not node.visited
+    then
+      let keepup =
+        LMap.fold (fun b d keepup ->
+            if not (LSet.mem b removable)
+            then merge_up d b keepup
+            else
+              begin
+                match LMap.find b graph with
+                | bnode ->
+                  do_node b bnode;
+                  LMap.fold (fun k d' keepup ->
+                    merge_up (merge_types d d') k keepup)
+                    bnode.up keepup
+                | exception Not_found -> keepup
+              end
+          )
+          node.up LMap.empty
+      in
+      node.up <- keepup;
+      node.visited <- true
+  in
+  LMap.iter do_node graph
+
+let restrict_universe_context (univs,csts) keep =
+  let removable = LSet.diff univs keep in
+  let (csts, rem) =
+    Constraint.fold (fun (a,d,b as cst) (csts, rem) ->
+        if LSet.mem a removable || LSet.mem b removable
+        then (csts, add_up a d b rem)
+        else (Constraint.add cst csts, rem))
+      csts (Constraint.empty, LMap.empty)
+  in
+  transitive_close removable rem;
+  let csts =
+    LMap.fold (fun a node csts ->
+        if LSet.mem a removable
+        then csts
+        else
+          LMap.fold (fun b d csts -> Constraint.add (a,d,b) csts)
+            node.up csts)
+      rem csts
+  in
+  (LSet.inter univs keep, csts)
diff --git a/library/univops.mli b/engine/univops.mli
index 09147cb41..30fcc4368 100644
--- a/library/univops.mli
+++ b/engine/univops.mli
@@ -6,10 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Term
+open Constr
 open Univ
 
-(** Shrink a universe context to a restricted set of variables *)
+(** The universes of monomorphic constants appear. *)
+val universes_of_constr : Environ.env -> constr -> LSet.t
 
-val universes_of_constr : constr -> universe_set
-val restrict_universe_context : universe_context_set -> universe_set -> universe_context_set
+(** Shrink a universe context to a restricted set of variables *)
+val restrict_universe_context : ContextSet.t -> LSet.t -> ContextSet.t
diff --git a/grammar/argextend.mlp b/grammar/argextend.mlp
index 12b7b171b..01138702b 100644
--- a/grammar/argextend.mlp
+++ b/grammar/argextend.mlp
@@ -138,7 +138,6 @@ let declare_tactic_argument loc s (typ, f, g, h) cl =
       <:expr<
         let f = $lid:f$ in
         fun ist v -> Ftactic.enter (fun gl ->
-          let gl = Proofview.Goal.assume gl in
           let (sigma, v) = Tacmach.New.of_old (fun gl -> f ist gl v) gl in
           let v = Geninterp.Val.inject (Geninterp.val_tag $make_topwit loc typ$) v in
           Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma) (Ftactic.return v)
@@ -186,12 +185,7 @@ let declare_vernac_argument loc s pr cl =
       value ($lid:"wit_"^s$ : Genarg.genarg_type 'a unit unit) =
         Genarg.create_arg $se$ >>;
      make_extend loc s cl wit;
-    <:str_item< do {
-      Pptactic.declare_extra_genarg_pprule $wit$
-        $pr_rules$
-        (fun _ _ _ _ -> CErrors.anomaly (Pp.str "vernac argument needs not globwit printer."))
-        (fun _ _ _ _ -> CErrors.anomaly (Pp.str "vernac argument needs not wit printer.")) }
-      >> ]
+    <:str_item< Pptactic.declare_extra_vernac_genarg_pprule $wit$ $pr_rules$ >> ]
 
 open Pcaml
 
diff --git a/grammar/q_util.mlp b/grammar/q_util.mlp
index 536ee7ca5..c2d767396 100644
--- a/grammar/q_util.mlp
+++ b/grammar/q_util.mlp
@@ -94,10 +94,14 @@ let coincide s pat off =
   done;
   !break
 
+let check_separator sep =
+  if sep <> "" then failwith "Separator is only for arguments with suffix _list_sep."
+
 let rec parse_user_entry s sep =
   let l = String.length s in
   if l > 8 && coincide s "ne_" 0 && coincide s "_list" (l - 5) then
     let entry = parse_user_entry (String.sub s 3 (l-8)) "" in
+    check_separator sep;
     Ulist1 entry
   else if l > 12 && coincide s "ne_" 0 &&
                    coincide s "_list_sep" (l-9) then
@@ -105,16 +109,20 @@ let rec parse_user_entry s sep =
     Ulist1sep (entry, sep)
   else if l > 5 && coincide s "_list" (l-5) then
     let entry = parse_user_entry (String.sub s 0 (l-5)) "" in
+    check_separator sep;
     Ulist0 entry
   else if l > 9 && coincide s "_list_sep" (l-9) then
     let entry = parse_user_entry (String.sub s 0 (l-9)) "" in
     Ulist0sep (entry, sep)
   else if l > 4 && coincide s "_opt" (l-4) then
     let entry = parse_user_entry (String.sub s 0 (l-4)) "" in
+    check_separator sep;
     Uopt entry
   else if l = 7 && coincide s "tactic" 0 && '5' >= s.[6] && s.[6] >= '0' then
     let n = Char.code s.[6] - 48 in
+    check_separator sep;
     Uentryl ("tactic", n)
   else
     let s = match s with "hyp" -> "var" | _ -> s in
+    check_separator sep;
     Uentry s
diff --git a/grammar/tacextend.mlp b/grammar/tacextend.mlp
index 0b33dab05..c52a0040b 100644
--- a/grammar/tacextend.mlp
+++ b/grammar/tacextend.mlp
@@ -45,7 +45,7 @@ let rec make_let raw e = function
       <:expr< let $lid:p$ = $v$ in $e$ >>
   | _::l -> make_let raw e l
 
-let make_clause (pt,_,e) =
+let make_clause (pt,e) =
   (make_patt pt,
    ploc_vala None,
    make_let false e pt)
@@ -76,7 +76,7 @@ let make_prod_item = function
     <:expr< Tacentries.TacNonTerm (Loc.tag ( $mlexpr_of_symbol g$ , $mlexpr_of_option mlexpr_of_ident id$ ) ) >>
 
 let mlexpr_of_clause cl =
-  mlexpr_of_list (fun (a,_,_) -> mlexpr_of_list make_prod_item a) cl
+  mlexpr_of_list (fun (a,_) -> mlexpr_of_list make_prod_item a) cl
 
 (** Special treatment of constr entries *)
 let is_constr_gram = function
@@ -88,8 +88,8 @@ let make_var = function
   | ExtNonTerminal (_, p) -> p
   | _ -> assert false
 
-let declare_tactic loc tacname ~level classification clause = match clause with
-| [(ExtTerminal name) :: rem, _, tac] when List.for_all is_constr_gram rem ->
+let declare_tactic loc tacname ~level clause = match clause with
+| [(ExtTerminal name) :: rem, tac] when List.for_all is_constr_gram rem ->
   (** The extension is only made of a name followed by constr entries: we do not
       add any grammar nor printing rule and add it as a true Ltac definition. *)
   let patt = make_patt rem in
@@ -141,16 +141,14 @@ EXTEND
   str_item:
     [ [ "TACTIC"; "EXTEND"; s = tac_name;
         level = OPT [ "AT"; UIDENT "LEVEL"; level = INT -> level ];
-        c = OPT [ "CLASSIFIED"; "BY"; c = LIDENT -> <:expr< $lid:c$ >> ];
         OPT "|"; l = LIST1 tacrule SEP "|";
         "END" ->
         let level = match level with Some i -> int_of_string i | None -> 0 in
-         declare_tactic loc s ~level c l ] ]
+         declare_tactic loc s ~level l ] ]
   ;
   tacrule:
     [ [ "["; l = LIST1 tacargs; "]";
-        c = OPT [ "=>"; "["; c = Pcaml.expr; "]" -> c ];
-        "->"; "["; e = Pcaml.expr; "]" -> (l,c,e)
+        "->"; "["; e = Pcaml.expr; "]" -> (l,e)
     ] ]
   ;
   tacargs:
diff --git a/grammar/vernacextend.mlp b/grammar/vernacextend.mlp
index a529185dd..a561ea370 100644
--- a/grammar/vernacextend.mlp
+++ b/grammar/vernacextend.mlp
@@ -59,7 +59,7 @@ let make_clause_classifier cg s { r_patt = pt; r_class = c; } =
   | None, Some cg ->
      (make_patt pt,
       ploc_vala None,
-      <:expr< fun () -> $cg$ $str:s$ >>)
+      <:expr< fun loc -> $cg$ $str:s$ >>)
   | None, None -> prerr_endline
       (("Vernac entry \""^s^"\" misses a classifier. "^
          "A classifier is a function that returns an expression "^
@@ -82,7 +82,7 @@ let make_clause_classifier cg s { r_patt = pt; r_class = c; } =
          "classifiers. Only one classifier is called.") ^ "\n");
     (make_patt pt,
       ploc_vala None,
-      <:expr< fun () -> (Vernacexpr.VtUnknown, Vernacexpr.VtNow) >>)
+      <:expr< fun () -> ( CErrors.anomaly (Pp.str "No classification given for command " ^ s ) ) >>)
 
 let make_fun_clauses loc s l =
   let map c =
@@ -136,6 +136,10 @@ EXTEND
         OPT "|"; l = LIST1 rule SEP "|";
         "END" ->
          declare_command loc s c <:expr<None>> l
+      | "VERNAC"; "COMMAND"; "FUNCTIONAL"; "EXTEND"; s = UIDENT; c = OPT classification;
+        OPT "|"; l = LIST1 fun_rule SEP "|";
+        "END" ->
+         declare_command loc s c <:expr<None>> l
       | "VERNAC"; nt = LIDENT ; "EXTEND"; s = UIDENT; c = OPT classification;
         OPT "|"; l = LIST1 rule SEP "|";
         "END" ->
@@ -158,23 +162,36 @@ EXTEND
   deprecation:
     [ [ "DEPRECATED" -> () ] ]
   ;
-  (* spiwack: comment-by-guessing: it seems that the isolated string (which
-      otherwise could have been another argument) is not passed to the
-      VernacExtend interpreter function to discriminate between the clauses. *)
+  (* spiwack: comment-by-guessing: it seems that the isolated string
+      (which otherwise could have been another argument) is not passed
+      to the VernacExtend interpreter function to discriminate between
+      the clauses. *)
   rule:
     [ [ "["; s = STRING; l = LIST0 args; "]";
         d = OPT deprecation; c = OPT classifier; "->"; "["; e = Pcaml.expr; "]" ->
       let () = if s = "" then failwith "Command name is empty." in
-      let b = <:expr< fun () -> $e$ >> in
+      let b = <:expr< fun ~{atts} ~{st} -> ( let () = $e$ in st ) >> in
+      { r_head = Some s; r_patt = l; r_class = c; r_branch = b; r_depr = d; }
+      | "[" ; "-" ; l = LIST1 args ; "]" ;
+        d = OPT deprecation; c = OPT classifier; "->"; "["; e = Pcaml.expr; "]" ->
+      let b = <:expr< fun ~{atts} ~{st} -> ( let () = $e$ in st ) >> in
+      { r_head = None; r_patt = l; r_class = c; r_branch = b; r_depr = d; }
+    ] ]
+  ;
+  fun_rule:
+    [ [ "["; s = STRING; l = LIST0 args; "]";
+        d = OPT deprecation; c = OPT classifier; "->"; "["; e = Pcaml.expr; "]" ->
+      let () = if s = "" then failwith "Command name is empty." in
+      let b = <:expr< $e$ >> in
       { r_head = Some s; r_patt = l; r_class = c; r_branch = b; r_depr = d; }
       | "[" ; "-" ; l = LIST1 args ; "]" ;
         d = OPT deprecation; c = OPT classifier; "->"; "["; e = Pcaml.expr; "]" ->
-      let b = <:expr< fun () -> $e$ >> in
+      let b = <:expr< $e$ >> in
       { r_head = None; r_patt = l; r_class = c; r_branch = b; r_depr = d; }
     ] ]
   ;
   classifier:
-    [ [ "=>"; "["; c = Pcaml.expr; "]" -> <:expr< fun () -> $c$>> ] ]
+    [ [ "=>"; "["; c = Pcaml.expr; "]" -> <:expr< fun loc -> $c$>> ] ]
   ;
   args:
     [ [ e = LIDENT; "("; s = LIDENT; ")" ->
diff --git a/ide/config_lexer.mli b/ide/config_lexer.mli
new file mode 100644
index 000000000..0c0c5d1e7
--- /dev/null
+++ b/ide/config_lexer.mli
@@ -0,0 +1,10 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+val print_file : string -> string list Util.String.Map.t -> unit
+val load_file : string -> string list Util.String.Map.t
diff --git a/ide/coq-ssreflect.lang b/ide/coq-ssreflect.lang
index 7cfc16701..bd9cb4bfa 100644
--- a/ide/coq-ssreflect.lang
+++ b/ide/coq-ssreflect.lang
@@ -228,7 +228,7 @@
 	  <keyword>Implicit\%{space}+Arguments</keyword>
 	  <keyword>(Import)|(Include)</keyword>
 	  <keyword>Require(\%{space}+((Import)|(Export)))?</keyword>
-	  <keyword>(Recursive\%{space}+)?Extraction(\%{space}+(Language\%{space}+(Ocaml)|(Haskell)|(Scheme)|(Toplevel))|(Library)|((No)?Inline)|(Blacklist))?</keyword>
+          <keyword>(Recursive\%{space}+)?Extraction(\%{space}+(Language\%{space}+(OCaml)|(Haskell)|(Scheme)|(Toplevel))|(Library)|((No)?Inline)|(Blacklist))?</keyword>
 	  <keyword>Extract\%{space}+(Inlined\%{space}+)?(Constant)|(Inductive)</keyword>
 	  <include>
 	    <context sub-pattern="1" style-ref="vernac-keyword"/>
diff --git a/ide/coq.lang b/ide/coq.lang
index 484264ece..e9eab48de 100644
--- a/ide/coq.lang
+++ b/ide/coq.lang
@@ -188,7 +188,7 @@
           <keyword>(\%{locality}|(Reserved|Tactic)\%{space})?Notation</keyword>
           <keyword>\%{locality}Infix</keyword>
           <keyword>Declare\%{space}ML\%{space}Module</keyword>
-          <keyword>Extraction\%{space}Language\%{space}(Ocaml|Haskell|Scheme|JSON)</keyword>
+          <keyword>Extraction\%{space}Language\%{space}(OCaml|Haskell|Scheme|JSON)</keyword>
         </context>
 
         <context id="hint-command" style-ref="vernac-keyword">
diff --git a/ide/coq.ml b/ide/coq.ml
index 42ab86dd6..34b4875af 100644
--- a/ide/coq.ml
+++ b/ide/coq.ml
@@ -9,6 +9,8 @@
 open Ideutils
 open Preferences
 
+let ideslave_coqtop_flags = ref None
+
 (** * Version and date *)
 
 let get_version_date () =
@@ -375,7 +377,7 @@ let spawn_handle args respawner feedback_processor =
   in
   let args = Array.of_list ("--xml_format=Ppcmds" :: "-async-proofs" :: async_default :: "-ideslave" :: args) in
   let env =
-    match !Flags.ideslave_coqtop_flags with
+    match !ideslave_coqtop_flags with
     | None -> None
     | Some s ->
       let open Str in
diff --git a/ide/coq.mli b/ide/coq.mli
index 463dd134a..8c4727b37 100644
--- a/ide/coq.mli
+++ b/ide/coq.mli
@@ -171,3 +171,6 @@ val check_connection : string list -> unit
 
 val interrupter : (int -> unit) ref
 val save_all : (unit -> unit) ref
+
+(* Flags to be used for ideslave *)
+val ideslave_coqtop_flags : string option ref
diff --git a/ide/coqOps.ml b/ide/coqOps.ml
index 364fc883b..ded28a998 100644
--- a/ide/coqOps.ml
+++ b/ide/coqOps.ml
@@ -422,7 +422,7 @@ object(self)
     let rec eat_feedback n =
       if n = 0 then true else
       let msg = Queue.pop feedbacks in
-      let id = msg.id in
+      let id = msg.span_id in
       let sentence =
         let finder _ state_id s =
           match state_id, id with
@@ -463,7 +463,7 @@ object(self)
           self#attach_tooltip ~loc sentence
             (Printf.sprintf "%s %s %s" filepath ident ty)
       | Message(Error, loc, msg), Some (id,sentence) ->
-          log_pp ?id Pp.(str "ErrorMsg" ++ msg);
+          log_pp ?id Pp.(str "ErrorMsg " ++ msg);
           remove_flag sentence `PROCESSING;
           let rmsg = Pp.string_of_ppcmds msg in
           add_flag sentence (`ERROR (loc, rmsg));
@@ -471,17 +471,20 @@ object(self)
           self#attach_tooltip ?loc sentence rmsg;
           self#position_tag_at_sentence ?loc Tags.Script.error sentence
       | Message(Warning, loc, msg), Some (id,sentence) ->
-          log_pp ?id Pp.(str "WarningMsg" ++ msg);
+          log_pp ?id Pp.(str "WarningMsg " ++ msg);
           let rmsg = Pp.string_of_ppcmds msg     in
           add_flag sentence (`WARNING (loc, rmsg));
           self#attach_tooltip ?loc sentence rmsg;
           self#position_tag_at_sentence ?loc Tags.Script.warning sentence;
           messages#push Warning msg
       | Message(lvl, loc, msg), Some (id,sentence) ->
-          log_pp ?id Pp.(str "Msg" ++ msg);
+          log_pp ?id Pp.(str "Msg " ++ msg);
           messages#push lvl msg
+      (* We do nothing here as for BZ#5583 *)
+      | Message(Error, loc, msg), None ->
+          log_pp Pp.(str "Error Msg without a sentence" ++ msg)
       | Message(lvl, loc, msg), None ->
-          log_pp Pp.(str "Msg" ++ msg);
+          log_pp Pp.(str "Msg without a sentence " ++ msg);
           messages#push lvl msg
       | InProgress n, _ ->
           if n < 0 then processed <- processed + abs n
@@ -655,7 +658,7 @@ object(self)
         with Doc.Empty -> initial_state | Invalid_argument _ -> assert false in
       loop tip [] in
     Coq.bind fill_queue process_queue
-  
+
   method join_document =
    let next = function
      | Good _ ->
diff --git a/ide/coq_commands.mli b/ide/coq_commands.mli
new file mode 100644
index 000000000..53026be38
--- /dev/null
+++ b/ide/coq_commands.mli
@@ -0,0 +1,11 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+val tactics : string list list
+val commands : string list list
+val state_preserving : string list
diff --git a/ide/coq_lex.mli b/ide/coq_lex.mli
new file mode 100644
index 000000000..417e0a76f
--- /dev/null
+++ b/ide/coq_lex.mli
@@ -0,0 +1,11 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+val delimit_sentences : (int -> GText.tag -> unit) -> string -> unit
+
+exception Unterminated
diff --git a/ide/coq_lex.mll b/ide/coq_lex.mll
index 8bfd937e3..fcc242e07 100644
--- a/ide/coq_lex.mll
+++ b/ide/coq_lex.mll
@@ -17,7 +17,13 @@
 
 let space = [' ' '\n' '\r' '\t' '\012'] (* '\012' is form-feed *)
 
-let undotted_sep = '{' | '}' | '-'+ | '+'+ | '*'+
+let number = [ '0'-'9' ]+
+
+let string = "\"" _+ "\""
+
+let undotted_sep = (number space* ':' space*)? '{' | '}' | '-'+ | '+'+ | '*'+
+
+let vernac_control = "Fail" | "Time" | "Redirect" space+ string | "Timeout" space+ number
 
 let dot_sep = '.' (space | eof)
 
@@ -65,7 +71,7 @@ and sentence initial stamp = parse
       stamp (utf8_lexeme_start lexbuf) Tags.Script.sentence;
       sentence true stamp lexbuf
     }
-  | undotted_sep {
+  | (vernac_control space+)* undotted_sep {
       (* Separators like { or } and bullets * - + are only active
 	 at the start of a sentence *)
       if initial then stamp (utf8_lexeme_start lexbuf + String.length (Lexing.lexeme lexbuf) - 1) Tags.Script.sentence;
diff --git a/ide/coqide.ml b/ide/coqide.ml
index 7b65c9fec..4de9a5288 100644
--- a/ide/coqide.ml
+++ b/ide/coqide.ml
@@ -439,7 +439,9 @@ let compile sn =
   match sn.fileops#filename with
     |None -> flash_info "Active buffer has no name"
     |Some f ->
-      let cmd = cmd_coqc#get ^ " -I " ^ (Filename.quote (Filename.dirname f))
+      let args = Coq.get_arguments sn.coqtop in
+      let cmd = cmd_coqc#get 
+	^ " " ^ String.concat " " args
 	^ " " ^ (Filename.quote f) ^ " 2>&1"
       in
       let buf = Buffer.create 1024 in
@@ -1219,9 +1221,14 @@ let build_ui () =
   (* Emacs/PG mode *)
   NanoPG.init w notebook all_menus;
 
-  (* Reset on tab switch *)
-  let _ = notebook#connect#switch_page ~callback:(fun _ ->
-    if reset_on_tab_switch#get then Nav.restart ())
+  (* On tab switch, reset, update location *)
+  let _ = notebook#connect#switch_page ~callback:(fun n ->
+    let _ = if reset_on_tab_switch#get then Nav.restart () in
+    try
+      let session = notebook#get_nth_term n in
+      let ins = session.buffer#get_iter_at_mark `INSERT in
+      Ideutils.display_location ins
+    with _ -> ())
   in
 
   (* Vertical Separator between Scripts and Goals *)
@@ -1323,25 +1330,6 @@ let main files =
   Minilib.log "End of Coqide.main"
 
 
-(** {2 Geoproof } *)
-
-(** This function check every tenth of second if GeoProof has send
-    something on his private clipboard *)
-
-let check_for_geoproof_input () =
-  let cb_Dr = GData.clipboard (Gdk.Atom.intern "_GeoProof") in
-  let handler () = match cb_Dr#text with
-    |None -> true
-    |Some "Ack" -> true
-    |Some s ->
-      on_current_term (fun sn -> sn.buffer#insert (s ^ "\n"));
-      (* cb_Dr#clear does not work so i use : *)
-      cb_Dr#set_text "Ack";
-      true
-  in
-  ignore (GMain.Timeout.add ~ms:100 ~callback:handler)
-
-
 (** {2 Argument parsing } *)
 
 (** By default, the coqtop we try to launch is exactly the current coqide
@@ -1372,7 +1360,7 @@ let read_coqide_args argv =
       Backtrace.record_backtrace true;
       filter_coqtop coqtop project_files ("-debug"::out) args
     |"-coqtop-flags" :: flags :: args->
-      Flags.ideslave_coqtop_flags := Some flags;
+      Coq.ideslave_coqtop_flags := Some flags;
       filter_coqtop coqtop project_files out args
     |arg::args when out = [] && Minilib.is_prefix_of "-psn_" arg ->
       (* argument added by MacOS during .app launch *)
diff --git a/ide/coqide.mli b/ide/coqide.mli
index 39b4d9ae2..42dab9ec5 100644
--- a/ide/coqide.mli
+++ b/ide/coqide.mli
@@ -40,5 +40,3 @@ val set_signal_handlers : unit -> unit
 (** Emergency saving of opened files as "foo.v.crashcoqide",
     and exit (if the integer isn't 127). *)
 val crash_save : int -> unit
-
-val check_for_geoproof_input : unit -> unit
diff --git a/ide/coqide_main.ml4 b/ide/coqide_main.ml4
index 73a30b18f..6e330c62b 100644
--- a/ide/coqide_main.ml4
+++ b/ide/coqide_main.ml4
@@ -55,6 +55,8 @@ let os_specific_init () = ()
 
 (** Win32 *)
 
+IFDEF WIN32 THEN
+
 (* On win32, we add the directory of coqide to the PATH at launch-time
    (this used to be done in a .bat script). *)
 
@@ -86,7 +88,6 @@ let reroute_stdout_stderr () =
 
 (* We also provide specific kill and interrupt functions. *)
 
-IFDEF WIN32 THEN
 external win32_kill : int -> unit = "win32_kill"
 external win32_interrupt : int -> unit = "win32_interrupt"
 let () =
@@ -142,7 +143,6 @@ let () =
   Coq.check_connection args;
   Coqide.sup_args := args;
   Coqide.main files;
-  if !Coq_config.with_geoproof then Coqide.check_for_geoproof_input ();
   os_specific_init ();
   try
     GMain.main ();
diff --git a/ide/coqide_main.mli b/ide/coqide_main.mli
new file mode 100644
index 000000000..e1555ba2e
--- /dev/null
+++ b/ide/coqide_main.mli
@@ -0,0 +1,10 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(* This empty file avoids a race condition that occurs when compiling a .ml file
+   that does not have a corresponding .mli file *)
diff --git a/ide/coqide_ui.mli b/ide/coqide_ui.mli
new file mode 100644
index 000000000..9f6fa5635
--- /dev/null
+++ b/ide/coqide_ui.mli
@@ -0,0 +1,10 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+val init : unit -> unit
+val ui_m : GAction.ui_manager
diff --git a/ide/gtk_parsing.ml b/ide/gtk_parsing.ml
index f0575e325..7c0a7495a 100644
--- a/ide/gtk_parsing.ml
+++ b/ide/gtk_parsing.ml
@@ -7,11 +7,7 @@
 (************************************************************************)
 
 let underscore = Glib.Utf8.to_unichar "_" ~pos:(ref 0)
-let arobase = Glib.Utf8.to_unichar "@" ~pos:(ref 0)
 let prime = Glib.Utf8.to_unichar "'" ~pos:(ref 0)
-let bn = Glib.Utf8.to_unichar "\n" ~pos:(ref 0)
-let space = Glib.Utf8.to_unichar " " ~pos:(ref 0)
-let tab = Glib.Utf8.to_unichar "\t" ~pos:(ref 0)
 
 
 (* TODO: avoid num and prime at the head of a word *)
@@ -30,17 +26,6 @@ let ends_word (it:GText.iter) =
        not (is_word_char c)
   )
 
-
-let inside_word (it:GText.iter) =
-  let c = it#char in
-    not (starts_word it) &&
-      not (ends_word it) &&
-      is_word_char c
-
-
-let is_on_word_limit (it:GText.iter) = inside_word it || ends_word it
-
-
 let find_word_start (it:GText.iter) =
   let rec step_to_start it =
     Minilib.log "Find word start";
@@ -72,100 +57,6 @@ let get_word_around (it:GText.iter) =
   let stop =  find_word_end it in
     start,stop
 
-
-let rec complete_backward w (it:GText.iter) =
-  Minilib.log "Complete backward...";
-  match it#backward_search w with
-    | None -> (Minilib.log "backward_search failed";None)
-    | Some (start,stop) ->
-	Minilib.log ("complete_backward got a match:"^(string_of_int start#offset)^(string_of_int stop#offset));
-	if starts_word start then
-	  let ne = find_word_end stop in
-	    if ne#compare stop = 0
-	    then complete_backward w start
-	    else Some (start,stop,ne)
-	else complete_backward w start
-
-
-let rec complete_forward w (it:GText.iter) =
-  Minilib.log "Complete forward...";
-  match it#forward_search w with
-    | None -> None
-    | Some (start,stop) ->
-	if starts_word start then
-	  let ne = find_word_end stop in
-	    if ne#compare stop = 0 then
-	      complete_forward w stop
-	    else Some (stop,stop,ne)
-	else complete_forward w stop
-
-
-let find_comment_end (start:GText.iter) =
-  let rec find_nested_comment (search_start:GText.iter) (search_end:GText.iter) (comment_end:GText.iter) =
-    match (search_start#forward_search ~limit:search_end "(*"),(comment_end#forward_search "*)") with
-      | None,_ -> comment_end
-      | Some _, None -> raise Not_found
-      | Some (_,next_search_start),Some (next_search_end,next_comment_end) ->
-          find_nested_comment next_search_start next_search_end next_comment_end
-  in
-    match start#forward_search "*)" with
-      | None -> raise Not_found
-      | Some (search_end,comment_end) -> find_nested_comment start search_end comment_end
-
-
-let rec find_string_end (start:GText.iter) =
-  let dblquote = int_of_char '"' in
-  let rec escaped_dblquote c =
-    (c#char = dblquote) && not (escaped_dblquote c#backward_char)
-  in
-    match start#forward_search "\"" with
-      | None -> raise Not_found
-      | Some (stop,next_start) ->
-          if escaped_dblquote stop#backward_char
-          then find_string_end next_start
-          else next_start
-
-
-let rec find_next_sentence (from:GText.iter) =
-  match (from#forward_search ".") with
-    | None -> raise Not_found
-    | Some (non_vernac_search_end,next_sentence) ->
-        match from#forward_search ~limit:non_vernac_search_end "(*",from#forward_search ~limit:non_vernac_search_end "\"" with
-          | None,None ->
-              if Glib.Unichar.isspace next_sentence#char || next_sentence#compare next_sentence#forward_char == 0
-              then next_sentence else find_next_sentence next_sentence
-          | None,Some (_,string_search_start) -> find_next_sentence (find_string_end string_search_start)
-          | Some (_,comment_search_start),None -> find_next_sentence (find_comment_end comment_search_start)
-          | Some (_,comment_search_start),Some (_,string_search_start) ->
-              find_next_sentence (
-                if comment_search_start#compare string_search_start < 0
-                then find_comment_end comment_search_start
-                else find_string_end string_search_start)
-
-
-let find_nearest_forward (cursor:GText.iter) targets =
-  let fold_targets acc target =
-    match cursor#forward_search target,acc with
-      | Some (t_start,_),Some nearest when (t_start#compare nearest < 0) -> Some t_start
-      | Some (t_start,_),None -> Some t_start
-      | _ -> acc
-  in
-    match List.fold_left fold_targets None targets with
-      | None -> raise Not_found
-      | Some nearest -> nearest
-
-
-let find_nearest_backward (cursor:GText.iter) targets =
-  let fold_targets acc target =
-    match cursor#backward_search target,acc with
-      | Some (t_start,_),Some nearest when (t_start#compare nearest > 0) -> Some t_start
-      | Some (t_start,_),None -> Some t_start
-      | _ -> acc
-  in
-    match List.fold_left fold_targets None targets with
-      | None -> raise Not_found
-      | Some nearest -> nearest
-
 (** On double-click on a view, select the whole word. This is a workaround for
     a deficient word handling in TextView. *)
 let fix_double_click self =
diff --git a/ide/gtk_parsing.mli b/ide/gtk_parsing.mli
new file mode 100644
index 000000000..b54f731b3
--- /dev/null
+++ b/ide/gtk_parsing.mli
@@ -0,0 +1,26 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+val fix_double_click :
+  < buffer : < get_iter : [> `INSERT ] -> GText.iter;
+               move_mark : [> `INSERT | `SEL_BOUND ] ->
+                 where:GText.iter -> unit;
+               .. >;
+    event : < connect :
+                < button_press :
+                    callback:([> `TWO_BUTTON_PRESS ] Gdk.event ->
+                              bool) ->
+                    'a;
+                  .. >;
+              .. >;
+    .. > ->
+  unit
+val starts_word : GText.iter -> bool
+val ends_word : GText.iter -> bool
+val find_word_start : GText.iter -> GText.iter
+val find_word_end : GText.iter -> GText.iter
diff --git a/ide/ide_slave.ml b/ide/ide_slave.ml
index 67391f556..fe86df084 100644
--- a/ide/ide_slave.ml
+++ b/ide/ide_slave.ml
@@ -1,5 +1,4 @@
 (************************************************************************)
-
 (*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
 (* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
 (*   \VV/  **************************************************************)
@@ -14,7 +13,6 @@ open Util
 open Pp
 open Printer
 
-module RelDecl = Context.Rel.Declaration
 module NamedDecl = Context.Named.Declaration
 module CompactedDecl = Context.Compacted.Declaration
 
@@ -56,7 +54,7 @@ let coqide_known_option table = List.mem table [
   ["Printing";"Universes"];
   ["Printing";"Unfocused"]]
 
-let is_known_option cmd = match cmd with
+let is_known_option cmd = match Vernacprop.under_control cmd with
   | VernacSetOption (o,BoolValue true)
   | VernacUnsetOption o -> coqide_known_option o
   | _ -> false
@@ -71,16 +69,20 @@ let ide_cmd_checks ~id (loc,ast) =
   if is_known_option ast then
     warn "Set this option from the IDE menu instead";
   if is_navigation_vernac ast || is_undo ast then
-    warn "Use IDE navigation instead";
-  if is_query ast then
-    warn "Query commands should not be inserted in scripts"
+    warn "Use IDE navigation instead"
 
 (** Interpretation (cf. [Ide_intf.interp]) *)
 
+let ide_doc = ref None
+let get_doc () = Option.get !ide_doc
+let set_doc doc = ide_doc := Some doc
+
 let add ((s,eid),(sid,verbose)) =
+  let doc = get_doc () in
   let pa = Pcoq.Gram.parsable (Stream.of_string s) in
-  let loc_ast = Stm.parse_sentence sid pa in
-  let newid, rc = Stm.add ~ontop:sid verbose loc_ast in
+  let loc_ast = Stm.parse_sentence ~doc sid pa in
+  let doc, newid, rc = Stm.add ~doc ~ontop:sid verbose loc_ast in
+  set_doc doc;
   let rc = match rc with `NewTip -> CSig.Inl () | `Unfocus id -> CSig.Inr id in
   ide_cmd_checks ~id:newid loc_ast;
   (* TODO: the "" parameter is a leftover of the times the protocol
@@ -95,9 +97,10 @@ let add ((s,eid),(sid,verbose)) =
   newid, (rc, "")
 
 let edit_at id =
-  match Stm.edit_at id with
-  | `NewTip -> CSig.Inl ()
-  | `Focus { Stm.start; stop; tip} -> CSig.Inr (start, (stop, tip))
+  let doc = get_doc () in
+  match Stm.edit_at ~doc id with
+  | doc, `NewTip -> set_doc doc; CSig.Inl ()
+  | doc, `Focus { Stm.start; stop; tip} -> set_doc doc; CSig.Inr (start, (stop, tip))
 
 (* TODO: the "" parameter is a leftover of the times the protocol
  * used to include stderr/stdout output.
@@ -110,12 +113,14 @@ let edit_at id =
  *)
 let query (route, (s,id)) =
   let pa = Pcoq.Gram.parsable (Stream.of_string s) in
-  Stm.query ~at:id ~route pa
+  let doc = get_doc () in
+  Stm.query ~at:id ~doc ~route pa
 
 let annotate phrase =
+  let doc = get_doc () in
   let (loc, ast) =
     let pa = Pcoq.Gram.parsable (Stream.of_string phrase) in
-    Stm.parse_sentence (Stm.get_current_state ()) pa
+    Stm.parse_sentence ~doc (Stm.get_current_state ~doc) pa
   in
   (* XXX: Width should be a parameter of annotate... *)
   Richpp.richpp_of_pp 78 (Ppvernac.pr_vernac ast)
@@ -197,7 +202,8 @@ let export_pre_goals pgs =
   }
 
 let goals () =
-  Stm.finish ();
+  let doc = get_doc () in
+  set_doc @@ Stm.finish ~doc;
   try
     let pfts = Proof_global.give_me_the_proof () in
     Some (export_pre_goals (Proof.map_structured_proof pfts process_goal))
@@ -205,9 +211,10 @@ let goals () =
 
 let evars () =
   try
-    Stm.finish ();
+    let doc = get_doc () in
+    set_doc @@ Stm.finish ~doc;
     let pfts = Proof_global.give_me_the_proof () in
-    let { Evd.it = all_goals ; sigma = sigma } = Proof.V82.subgoals pfts in
+    let all_goals, _, _, _, sigma = Proof.proof pfts in
     let exl = Evar.Map.bindings (Evd.undefined_map sigma) in
     let map_evar ev = { Interface.evar_info = string_of_ppcmds (pr_evar sigma ev); } in
     let el = List.map map_evar exl in
@@ -217,7 +224,7 @@ let evars () =
 let hints () =
   try
     let pfts = Proof_global.give_me_the_proof () in
-    let { Evd.it = all_goals ; sigma = sigma } = Proof.V82.subgoals pfts in
+    let all_goals, _, _, _, sigma = Proof.proof pfts in
     match all_goals with
     | [] -> None
     | g :: _ ->
@@ -231,12 +238,17 @@ let hints () =
 
 (** Other API calls *)
 
+let wait () =
+  let doc = get_doc () in
+  set_doc (Stm.wait ~doc)
+
 let status force =
   (** We remove the initial part of the current [DirPath.t]
       (usually Top in an interactive session, cf "coqtop -top"),
       and display the other parts (opened sections and modules) *)
-  Stm.finish ();
-  if force then Stm.join ();
+  set_doc (Stm.finish ~doc:(get_doc ()));
+  if force then
+    set_doc (Stm.join ~doc:(get_doc ()));
   let path =
     let l = Names.DirPath.repr (Lib.cwd ()) in
     List.rev_map Names.Id.to_string l
@@ -253,7 +265,7 @@ let status force =
     Interface.status_path = path;
     Interface.status_proofname = proof;
     Interface.status_allproofs = allproofs;
-    Interface.status_proofnum = Stm.current_proof_depth ();
+    Interface.status_proofnum = Stm.current_proof_depth ~doc:(get_doc ());
   }
 
 let export_coq_object t = {
@@ -357,22 +369,16 @@ let init =
   fun file ->
    if !initialized then anomaly (str "Already initialized.")
    else begin
-     let init_sid = Stm.get_current_state () in
+     let init_sid = Stm.get_current_state ~doc:(get_doc ()) in
      initialized := true;
      match file with
      | None -> init_sid
      | Some file ->
-         let dir = Filename.dirname file in
-         let open Loadpath in let open CUnix in
-         let initial_id, _ =
-           if not (is_in_load_paths (physical_path_of_string dir)) then begin
-             let pa = Pcoq.Gram.parsable (Stream.of_string (Printf.sprintf "Add LoadPath \"%s\". " dir)) in
-             let loc_ast = Stm.parse_sentence init_sid pa in
-             Stm.add false ~ontop:init_sid loc_ast
-           end else init_sid, `NewTip in
+         let doc, initial_id, _ =
+           get_doc (), init_sid, `NewTip in
          if Filename.check_suffix file ".v" then
            Stm.set_compilation_hints file;
-         Stm.finish ();
+         set_doc (Stm.finish ~doc);
          initial_id
    end
 
@@ -414,6 +420,7 @@ let eval_call c =
     Interface.quit = (fun () -> quit := true);
     Interface.init = interruptible init;
     Interface.about = interruptible about;
+    Interface.wait = interruptible wait;
     Interface.interp = interruptible interp;
     Interface.handle_exn = handle_exn;
     Interface.stop_worker = Stm.stop_worker;
@@ -447,9 +454,13 @@ let slave_feeder fmt xml_oc msg =
 let msg_format = ref (fun () ->
     let margin = Option.default 72 (Topfmt.get_margin ()) in
     Xmlprotocol.Richpp margin
-)
+  )
 
-let loop () =
+(* The loop ignores the command line arguments as the current model delegates
+   its handing to the toplevel container. *)
+let loop _args ~state =
+  let open Vernac.State in
+  set_doc state.doc;
   init_signal_handler ();
   catch_break := false;
   let in_ch, out_ch = Spawned.get_channels ()                        in
@@ -496,10 +507,10 @@ let rec parse = function
   | x :: rest -> x :: parse rest
   | [] -> []
 
-let () = Coqtop.toploop_init := (fun args ->
-        let args = parse args in
+let () = Coqtop.toploop_init := (fun coq_args extra_args ->
+        let args = parse extra_args in
         Flags.quiet := true;
-        CoqworkmgrApi.(init Flags.High);
+        CoqworkmgrApi.(init High);
         args)
 
 let () = Coqtop.toploop_run := loop
diff --git a/ide/ide_slave.mli b/ide/ide_slave.mli
new file mode 100644
index 000000000..e1555ba2e
--- /dev/null
+++ b/ide/ide_slave.mli
@@ -0,0 +1,10 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(* This empty file avoids a race condition that occurs when compiling a .ml file
+   that does not have a corresponding .mli file *)
diff --git a/ide/ideutils.ml b/ide/ideutils.ml
index 83e5da950..9c5b06a0d 100644
--- a/ide/ideutils.ml
+++ b/ide/ideutils.ml
@@ -69,6 +69,12 @@ let insert_xml ?(mark = `INSERT) ?(tags = []) (buf : #GText.buffer_skel) msg =
 
 let set_location = ref  (function s -> failwith "not ready")
 
+let display_location ins =
+  let line = ins#line + 1 in
+  let off = ins#line_offset + 1 in
+  let msg = Printf.sprintf "Line: %5d Char: %3d" line off in
+  !set_location msg
+
 (** A utf8 char is either a single byte (ascii char, 0xxxxxxx)
     or multi-byte (with a leading byte 11xxxxxx and extra bytes 10xxxxxx) *)
 
@@ -372,8 +378,7 @@ let read_file name buf =
 let io_read_all chan =
   Buffer.clear read_buffer;
   let read_once () =
-    (* XXX: Glib.Io must be converted to bytes / -safe-string upstream *)
-    let len = Glib.Io.read_chars ~buf:(Bytes.unsafe_to_string read_string) ~pos:0 ~len:maxread chan in
+    let len = Glib.Io.read_chars ~buf:read_string ~pos:0 ~len:maxread chan in
     Buffer.add_subbytes read_buffer read_string 0 len
   in
   begin
@@ -466,4 +471,3 @@ let browse_keyword prerr text =
     let u = Lazy.force url_for_keyword text in
     browse prerr (doc_url() ^ u)
   with Not_found -> prerr ("No documentation found for \""^text^"\".\n")
-
diff --git a/ide/ideutils.mli b/ide/ideutils.mli
index f06a48aeb..99ff763e2 100644
--- a/ide/ideutils.mli
+++ b/ide/ideutils.mli
@@ -56,6 +56,7 @@ val insert_xml : ?mark:GText.mark -> ?tags:GText.tag list ->
   #GText.buffer_skel -> Richpp.richpp -> unit
 
 val set_location : (string -> unit) ref
+val display_location : GText.iter -> unit
 
 (* In win32, when a command-line is to be executed via cmd.exe
    (i.e. Sys.command, Unix.open_process, ...), it cannot contain several
@@ -95,4 +96,3 @@ val io_read_all : Glib.Io.channel -> string
 
 val run_command :
   (string -> unit) -> (Unix.process_status -> unit) -> string -> unit
-
diff --git a/ide/interface.mli b/ide/interface.mli
index 1939a8427..a5d98946f 100644
--- a/ide/interface.mli
+++ b/ide/interface.mli
@@ -229,6 +229,9 @@ type print_ast_rty = Xml_datatype.xml
 type annotate_sty = string
 type annotate_rty = Xml_datatype.xml
 
+type wait_sty = unit
+type wait_rty = unit
+
 type handler = {
   add         : add_sty         -> add_rty;
   edit_at     : edit_at_sty     -> edit_at_rty;
@@ -248,6 +251,8 @@ type handler = {
   handle_exn  : handle_exn_sty  -> handle_exn_rty;
   init        : init_sty        -> init_rty;
   quit        : quit_sty        -> quit_rty;
+  (* for internal use (fake_id) only, do not use *)
+  wait        : wait_sty        -> wait_rty;
   (* Retrocompatibility stuff *)
   interp      : interp_sty      -> interp_rty;
 }
diff --git a/ide/macos_prehook.mli b/ide/macos_prehook.mli
new file mode 100644
index 000000000..e1555ba2e
--- /dev/null
+++ b/ide/macos_prehook.mli
@@ -0,0 +1,10 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(* This empty file avoids a race condition that occurs when compiling a .ml file
+   that does not have a corresponding .mli file *)
diff --git a/ide/minilib.ml b/ide/minilib.ml
index 2b278fac6..572222c06 100644
--- a/ide/minilib.ml
+++ b/ide/minilib.ml
@@ -20,7 +20,7 @@ type level = [
   | `FATAL ]
 
 (** Some excerpt of Util and similar files to avoid loading the whole
-    module and its dependencies (and hence Compat and Camlp4) *)
+    module and its dependencies (and hence Compat and Camlp5) *)
 
 let debug = ref false
 
diff --git a/ide/minilib.mli b/ide/minilib.mli
index c96e59b22..4f5fbe7db 100644
--- a/ide/minilib.mli
+++ b/ide/minilib.mli
@@ -7,7 +7,7 @@
 (***********************************************************************)
 
 (** Some excerpts of Util and similar files to avoid depending on them
-    and hence on Compat and Camlp4 *)
+    and hence on Compat and Camlp5 *)
 
 val print_list : (Format.formatter -> 'a -> unit) -> Format.formatter -> 'a list -> unit
 
diff --git a/ide/nanoPG.mli b/ide/nanoPG.mli
new file mode 100644
index 000000000..3ad8435b5
--- /dev/null
+++ b/ide/nanoPG.mli
@@ -0,0 +1,11 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+val get_documentation : unit -> string
+val init : GWindow.window -> Session.session Wg_Notebook.typed_notebook ->
+           GAction.action_group list -> unit
diff --git a/ide/session.ml b/ide/session.ml
index 0a09cc9f5..8dada8ff2 100644
--- a/ide/session.ml
+++ b/ide/session.ml
@@ -209,10 +209,7 @@ let set_buffer_handlers
   let mark_set_cb it m =
     debug_edit_zone ();
     let ins = get_insert () in
-    let line = ins#line + 1 in
-    let off = ins#line_offset + 1 in
-    let msg = Printf.sprintf "Line: %5d Char: %3d" line off in
-    let () = !Ideutils.set_location msg in
+    let () = Ideutils.display_location ins in
     match GtkText.Mark.get_name m with
     | Some "insert" -> ()
     | Some s -> Minilib.log (s^" moved")
diff --git a/ide/tags.ml b/ide/tags.ml
index 08ca47a84..402027179 100644
--- a/ide/tags.ml
+++ b/ide/tags.ml
@@ -15,33 +15,22 @@ let make_tag (tt:GText.tag_table) ~name prop =
 
 module Script =
 struct
+  (* More recently defined tags have highest priority in case of overlapping *)
   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 = make_tag table ~name:"error" [`UNDERLINE `SINGLE]
   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" []
-  let incomplete = make_tag table ~name:"incomplete" [
-          `BACKGROUND_STIPPLE_SET true;
-  ]
+  let incomplete = make_tag table ~name:"incomplete" [`BACKGROUND_STIPPLE_SET true]
   let unjustified = make_tag table ~name:"unjustified" [`BACKGROUND "gold"]
-  let found = make_tag table ~name:"found" [`BACKGROUND "blue"; `FOREGROUND "white"]
-  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 :: found :: sentence :: ephemere
-
-  let edit_zone =
-    let t = make_tag table ~name:"edit_zone" [`UNDERLINE `SINGLE] in
-    t#set_priority (List.length all);
-    t
-  let all = edit_zone :: all
-  
+  let comment = make_tag table ~name:"comment" []
+  let sentence = make_tag table ~name:"sentence" []
+  let edit_zone = make_tag table ~name:"edit_zone" [`UNDERLINE `SINGLE] (* for debugging *)
+  let all = edit_zone :: comment :: sentence :: ephemere
 end
 module Proof =
 struct
diff --git a/ide/tags.mli b/ide/tags.mli
index 265dfe46e..15a35185d 100644
--- a/ide/tags.mli
+++ b/ide/tags.mli
@@ -17,7 +17,6 @@ sig
   val processed : GText.tag
   val incomplete : GText.tag
   val unjustified : GText.tag
-  val found : GText.tag
   val sentence : GText.tag
   val tooltip : GText.tag
   val edit_zone : GText.tag (* for debugging *)
diff --git a/ide/utf8_convert.mli b/ide/utf8_convert.mli
new file mode 100644
index 000000000..06a131a68
--- /dev/null
+++ b/ide/utf8_convert.mli
@@ -0,0 +1,9 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+val f : string -> string
diff --git a/ide/wg_Find.ml b/ide/wg_Find.ml
index a62ff2de5..cb182465a 100644
--- a/ide/wg_Find.ml
+++ b/ide/wg_Find.ml
@@ -84,8 +84,10 @@ class finder name (view : GText.view) =
     method private backward_search starti =
       let text = view#buffer#start_iter#get_text ~stop:starti in
       let regexp = self#regex in
-      try
-        let i = Str.search_backward regexp text (String.length text - 1) in
+      let offs = (String.length text - 1) in
+      if offs < 0 then None
+      else try
+        let i = Str.search_backward regexp text offs in
         let j = Str.match_end () in
         Some(view#buffer#start_iter#forward_chars (b2c text i),
              view#buffer#start_iter#forward_chars (b2c text j))
@@ -101,24 +103,33 @@ class finder name (view : GText.view) =
       with Not_found -> None
 
     method replace_all () =
-      let rec replace_at (iter : GText.iter) =
+      let rec replace_at (iter : GText.iter) ct tot =
         let found = self#forward_search iter in
         match found with
-        | None -> ()
+        | None ->
+           let tot_str = if Int.equal ct tot then "" else " of " ^ string_of_int tot in
+           let occ_str = CString.plural tot "occurrence" in
+           let _ = Ideutils.flash_info ("Replaced " ^ string_of_int ct ^ tot_str ^ " " ^ occ_str) in
+           ()
         | Some (start, stop) ->
           let text = iter#get_text ~stop:view#buffer#end_iter in
           let start_mark = view#buffer#create_mark start in
           let stop_mark = view#buffer#create_mark ~left_gravity:false stop in
+          let mod_save = view#buffer#modified in
+          let _ = view#buffer#set_modified false in
           let _ = view#buffer#delete_interactive ~start ~stop () in
           let iter = view#buffer#get_iter_at_mark (`MARK start_mark) in
-          let _ = view#buffer#insert_interactive ~iter (self#replacement text)in
+          let _ = view#buffer#insert_interactive ~iter (self#replacement text) in
+          let edited = view#buffer#modified in
+          let _ = view#buffer#set_modified (edited || mod_save) in
           let next = view#buffer#get_iter_at_mark (`MARK stop_mark) in
           let () = view#buffer#delete_mark (`MARK start_mark) in
           let () = view#buffer#delete_mark (`MARK stop_mark) in
-          replace_at next
+          let next_ct = if edited then ct + 1 else ct in
+          replace_at next next_ct (tot + 1)
       in
       let () = view#buffer#begin_user_action () in
-      let () = replace_at view#buffer#start_iter in
+      let () = replace_at view#buffer#start_iter 0 0 in
       view#buffer#end_user_action ()
 
     method private set_not_found () =
@@ -130,22 +141,52 @@ class finder name (view : GText.view) =
     method private set_normal () =
       find_entry#misc#modify_base [`NORMAL, `NAME "white"]
 
-    method private find_from backward (starti : GText.iter) =
+    method private find_from backward ?(wrapped=false) (starti : GText.iter) =
       let found =
         if backward then self#backward_search starti
         else self#forward_search starti in
       match found with
       | None ->
         if not backward && not (starti#equal view#buffer#start_iter) then
-          self#find_from backward view#buffer#start_iter
+          self#find_from backward ~wrapped:true view#buffer#start_iter
         else if backward && not (starti#equal view#buffer#end_iter) then
-          self#find_from backward view#buffer#end_iter
+          self#find_from backward ~wrapped:true view#buffer#end_iter
         else
+          let _ = Ideutils.flash_info "String not found" in
           self#set_not_found ()
       | Some (start, stop) ->
+        let text = view#buffer#start_iter#get_text ~stop:view#buffer#end_iter in
+        let rec find_all offs accum =
+          if offs > String.length text then
+            List.rev accum
+          else try
+            let i = Str.search_forward self#regex text offs in
+            let j = Str.match_end () in
+            find_all (j + 1) (i :: accum)
+          with Not_found -> List.rev accum
+        in
+        let occurs = find_all 0 [] in
+        let num_occurs = List.length occurs in
+        (* assoc table of offset, occurrence index pairs *)
+        let occur_tbl = List.mapi (fun ndx occ -> (occ,ndx+1)) occurs in
         let _ = view#buffer#select_range start stop in
         let scroll = `MARK (view#buffer#create_mark stop) in
         let _ = view#scroll_to_mark ~use_align:false scroll in
+        let _ =
+          try
+            let occ_ndx = List.assoc start#offset occur_tbl in
+            let occ_str = CString.plural num_occurs "occurrence" in
+            let wrap_str = if wrapped then
+                             if backward then " (wrapped backwards)"
+                             else " (wrapped)"
+                           else ""
+            in
+            Ideutils.flash_info
+              (string_of_int occ_ndx ^ " of " ^ string_of_int num_occurs ^
+                 " " ^ occ_str ^ wrap_str)
+          with Not_found ->
+            CErrors.anomaly (Pp.str "Occurrence of Find string not in table")
+        in
         self#set_found ()
 
     method find_forward () =
diff --git a/ide/xmlprotocol.ml b/ide/xmlprotocol.ml
index 4b521a968..aaa24a2a9 100644
--- a/ide/xmlprotocol.ml
+++ b/ide/xmlprotocol.ml
@@ -531,6 +531,7 @@ let set_options_sty_t : set_options_sty val_t =
   list_t (pair_t (list_t string_t) option_value_t)
 let mkcases_sty_t : mkcases_sty val_t = string_t
 let quit_sty_t : quit_sty val_t = unit_t
+let wait_sty_t : wait_sty val_t = unit_t
 let about_sty_t : about_sty val_t = unit_t
 let init_sty_t : init_sty val_t = option_t string_t
 let interp_sty_t : interp_sty val_t = pair_t (pair_t bool_t bool_t) string_t
@@ -555,6 +556,7 @@ let get_options_rty_t : get_options_rty val_t =
 let set_options_rty_t : set_options_rty val_t = unit_t
 let mkcases_rty_t : mkcases_rty val_t = list_t (list_t string_t)
 let quit_rty_t : quit_rty val_t = unit_t
+let wait_rty_t : wait_rty val_t = unit_t
 let about_rty_t : about_rty val_t = coq_info_t
 let init_rty_t : init_rty val_t = state_id_t
 let interp_rty_t : interp_rty val_t = pair_t state_id_t (union_t string_t string_t)
@@ -576,6 +578,7 @@ let calls = [|
   "SetOptions", ($)set_options_sty_t, ($)set_options_rty_t;
   "MkCases",    ($)mkcases_sty_t,     ($)mkcases_rty_t;
   "Quit",       ($)quit_sty_t,        ($)quit_rty_t;
+  "Wait",       ($)wait_sty_t,        ($)wait_rty_t;
   "About",      ($)about_sty_t,       ($)about_rty_t;
   "Init",       ($)init_sty_t,        ($)init_rty_t;
   "Interp",     ($)interp_sty_t,      ($)interp_rty_t;
@@ -600,6 +603,8 @@ type 'a call =
   | About      : about_sty -> about_rty call
   | Init       : init_sty -> init_rty call
   | StopWorker : stop_worker_sty -> stop_worker_rty call
+  (* internal use (fake_ide) only, do not use *)
+  | Wait       : wait_sty -> wait_rty call
   (* retrocompatibility *)
   | Interp     : interp_sty -> interp_rty call
   | PrintAst   : print_ast_sty -> print_ast_rty call
@@ -618,12 +623,13 @@ let id_of_call : type a. a call -> int = function
   | SetOptions _ -> 9
   | MkCases _    -> 10
   | Quit _       -> 11
-  | About _      -> 12
-  | Init _       -> 13
-  | Interp _     -> 14
-  | StopWorker _ -> 15
-  | PrintAst _   -> 16
-  | Annotate _   -> 17
+  | Wait _       -> 12
+  | About _      -> 13
+  | Init _       -> 14
+  | Interp _     -> 15
+  | StopWorker _ -> 16
+  | PrintAst _   -> 17
+  | Annotate _   -> 18
 
 let str_of_call c = pi1 calls.(id_of_call c)
 
@@ -643,6 +649,7 @@ let mkcases x     : mkcases_rty call     = MkCases x
 let search x      : search_rty call      = Search x
 let quit x        : quit_rty call        = Quit x
 let init x        : init_rty call        = Init x
+let wait x        : wait_rty call        = Wait x
 let interp x      : interp_rty call      = Interp x
 let stop_worker x : stop_worker_rty call = StopWorker x
 let print_ast   x : print_ast_rty call   = PrintAst x
@@ -664,6 +671,7 @@ let abstract_eval_call : type a. _ -> a call -> a value = fun handler c ->
     | SetOptions x -> mkGood (handler.set_options x)
     | MkCases x    -> mkGood (handler.mkcases x)
     | Quit x       -> mkGood (handler.quit x)
+    | Wait x       -> mkGood (handler.wait x)
     | About x      -> mkGood (handler.about x)
     | Init x       -> mkGood (handler.init x)
     | Interp x     -> mkGood (handler.interp x)
@@ -688,6 +696,7 @@ let of_answer : type a. a call -> a value -> xml = function
   | SetOptions _ -> of_value (of_value_type set_options_rty_t)
   | MkCases _    -> of_value (of_value_type mkcases_rty_t    )
   | Quit _       -> of_value (of_value_type quit_rty_t       )
+  | Wait _       -> of_value (of_value_type wait_rty_t       )
   | About _      -> of_value (of_value_type about_rty_t      )
   | Init _       -> of_value (of_value_type init_rty_t       )
   | Interp _     -> of_value (of_value_type interp_rty_t     )
@@ -711,6 +720,7 @@ let to_answer : type a. a call -> xml -> a value = function
   | SetOptions _ -> to_value (to_value_type set_options_rty_t)
   | MkCases _    -> to_value (to_value_type mkcases_rty_t    )
   | Quit _       -> to_value (to_value_type quit_rty_t       )
+  | Wait _       -> to_value (to_value_type wait_rty_t       )
   | About _      -> to_value (to_value_type about_rty_t      )
   | Init _       -> to_value (to_value_type init_rty_t       )
   | Interp _     -> to_value (to_value_type interp_rty_t     )
@@ -733,6 +743,7 @@ let of_call : type a. a call -> xml = fun q ->
   | SetOptions x -> mkCall (of_value_type set_options_sty_t x)
   | MkCases x    -> mkCall (of_value_type mkcases_sty_t     x)
   | Quit x       -> mkCall (of_value_type quit_sty_t        x)
+  | Wait x       -> mkCall (of_value_type wait_sty_t        x)
   | About x      -> mkCall (of_value_type about_sty_t       x)
   | Init x       -> mkCall (of_value_type init_sty_t        x)
   | Interp x     -> mkCall (of_value_type interp_sty_t      x)
@@ -756,6 +767,7 @@ let to_call : xml -> unknown_call =
     | "SetOptions" -> Unknown (SetOptions (mkCallArg set_options_sty_t a))
     | "MkCases"    -> Unknown (MkCases    (mkCallArg mkcases_sty_t     a))
     | "Quit"       -> Unknown (Quit       (mkCallArg quit_sty_t        a))
+    | "Wait"       -> Unknown (Wait       (mkCallArg wait_sty_t        a))
     | "About"      -> Unknown (About      (mkCallArg about_sty_t       a))
     | "Init"       -> Unknown (Init       (mkCallArg init_sty_t        a))
     | "Interp"     -> Unknown (Interp     (mkCallArg interp_sty_t      a))
@@ -786,6 +798,7 @@ let pr_full_value : type a. a call -> a value -> string = fun call value -> matc
   | SetOptions _ -> pr_value_gen (print set_options_rty_t) value
   | MkCases _    -> pr_value_gen (print mkcases_rty_t    ) value
   | Quit _       -> pr_value_gen (print quit_rty_t       ) value
+  | Wait _       -> pr_value_gen (print wait_rty_t       ) value
   | About _      -> pr_value_gen (print about_rty_t      ) value
   | Init _       -> pr_value_gen (print init_rty_t       ) value
   | Interp _     -> pr_value_gen (print interp_rty_t     ) value
@@ -807,6 +820,7 @@ let pr_call : type a. a call -> string = fun call ->
     | SetOptions x -> return set_options_sty_t x
     | MkCases x    -> return mkcases_sty_t x
     | Quit x       -> return quit_sty_t x
+    | Wait x       -> return wait_sty_t x
     | About x      -> return about_sty_t x
     | Init x       -> return init_sty_t x
     | Interp x     -> return interp_sty_t x
@@ -925,7 +939,7 @@ let of_edit_or_state_id 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 obj, id = of_edit_or_state_id msg.span_id in
   let route = string_of_int msg.route in
   Element ("feedback", obj @ ["route",route], [id;content])
 
@@ -933,8 +947,9 @@ let of_feedback msg_fmt =
   msg_format := msg_fmt; of_feedback
 
 let to_feedback xml = match xml with
-  | Element ("feedback", ["object","state";"route",route], [id;content]) -> { 
-      id = to_stateid id;
+  | Element ("feedback", ["object","state";"route",route], [id;content]) -> {
+      doc_id = 0;
+      span_id = to_stateid id;
       route = int_of_string route;
       contents = to_feedback_content content }
   | x -> raise (Marshal_error("feedback",x))
diff --git a/ide/xmlprotocol.mli b/ide/xmlprotocol.mli
index d1c678b90..22117e35c 100644
--- a/ide/xmlprotocol.mli
+++ b/ide/xmlprotocol.mli
@@ -29,6 +29,8 @@ val set_options : set_options_sty -> set_options_rty call
 val quit        : quit_sty        -> quit_rty call
 val init        : init_sty        -> init_rty call
 val stop_worker : stop_worker_sty -> stop_worker_rty call
+(* internal use (fake_ide) only, do not use *)
+val wait        : wait_sty        -> wait_rty call
 (* retrocompatibility *)
 val interp      : interp_sty      -> interp_rty call
 val print_ast   : print_ast_sty   -> print_ast_rty call
diff --git a/install.sh b/install.sh
index f8589a3c7..4f60080a1 100755
--- a/install.sh
+++ b/install.sh
@@ -4,13 +4,13 @@ dest="$1"
 shift
 
 for f; do
-  bn=`basename $f`
-  dn=`dirname $f`
+  bn=$(basename "$f")
+  dn=$(dirname "$f")
   install -d "$dest/$dn"
   case $bn in
-      *.cmxs|*.py) install -m 755 $f "$dest/$dn/$bn"
+      *.cmxs|*.py) install -m 755 "$f" "$dest/$dn/$bn"
 	      ;;
-      *) install -m 644 $f "$dest/$dn/$bn"
+      *) install -m 644 "$f" "$dest/$dn/$bn"
 	 ;;
   esac
 done
diff --git a/interp/constrexpr_ops.ml b/interp/constrexpr_ops.ml
index 2d0a19b9a..d05e7d909 100644
--- a/interp/constrexpr_ops.ml
+++ b/interp/constrexpr_ops.ml
@@ -9,6 +9,7 @@
 open Pp
 open Util
 open Names
+open Nameops
 open Libnames
 open Constrexpr
 open Misctypes
@@ -60,34 +61,34 @@ let explicitation_eq ex1 ex2 = match ex1, ex2 with
   Id.equal id1 id2
 | _ -> false
 
-let eq_located f (_, x) (_, y) = f x y
+let eq_ast f { CAst.v = x } { CAst.v = y } = f x y
 
 let rec cases_pattern_expr_eq p1 p2 =
   if CAst.(p1.v == p2.v) then true
   else match CAst.(p1.v, p2.v) with
   | CPatAlias(a1,i1), CPatAlias(a2,i2) ->
-      Id.equal i1 i2 && cases_pattern_expr_eq a1 a2
+      eq_ast Name.equal i1 i2 && cases_pattern_expr_eq a1 a2
   | CPatCstr(c1,a1,b1), CPatCstr(c2,a2,b2) ->
       eq_reference c1 c2 &&
       Option.equal (List.equal cases_pattern_expr_eq) a1 a2 &&
       List.equal cases_pattern_expr_eq b1 b2
   | CPatAtom(r1), CPatAtom(r2) ->
-      Option.equal eq_reference r1 r2
+    Option.equal eq_reference r1 r2
   | CPatOr a1, CPatOr a2 ->
-      List.equal cases_pattern_expr_eq a1 a2
+    List.equal cases_pattern_expr_eq a1 a2
   | CPatNotation (n1, s1, l1), CPatNotation (n2, s2, l2) ->
     String.equal n1 n2 &&
     cases_pattern_notation_substitution_eq s1 s2 &&
     List.equal cases_pattern_expr_eq l1 l2
   | CPatPrim i1, CPatPrim i2 ->
-      prim_token_eq i1 i2
+    prim_token_eq i1 i2
   | CPatRecord l1, CPatRecord l2 ->
-      let equal (r1, e1) (r2, e2) =
-        eq_reference r1 r2 && cases_pattern_expr_eq e1 e2
-      in
-      List.equal equal l1 l2
+    let equal (r1, e1) (r2, e2) =
+      eq_reference r1 r2 && cases_pattern_expr_eq e1 e2
+    in
+    List.equal equal l1 l2
   | CPatDelimiters(s1,e1), CPatDelimiters(s2,e2) ->
-      String.equal s1 s2 && cases_pattern_expr_eq e1 e2
+    String.equal s1 s2 && cases_pattern_expr_eq e1 e2
   | _ -> false
 
 and cases_pattern_notation_substitution_eq (s1, n1) (s2, n2) =
@@ -103,156 +104,417 @@ let eq_universes u1 u2 =
 let rec constr_expr_eq e1 e2 =
   if CAst.(e1.v == e2.v) then true
   else match CAst.(e1.v, e2.v) with
-  | CRef (r1,u1), CRef (r2,u2) -> eq_reference r1 r2 && eq_universes u1 u2
-  | CFix(id1,fl1), CFix(id2,fl2) ->
-      eq_located Id.equal id1 id2 &&
+    | CRef (r1,u1), CRef (r2,u2) -> eq_reference r1 r2 && eq_universes u1 u2
+    | CFix(id1,fl1), CFix(id2,fl2) ->
+      eq_ast Id.equal id1 id2 &&
       List.equal fix_expr_eq fl1 fl2
-  | CCoFix(id1,fl1), CCoFix(id2,fl2) ->
-      eq_located Id.equal id1 id2 &&
+    | CCoFix(id1,fl1), CCoFix(id2,fl2) ->
+      eq_ast Id.equal id1 id2 &&
       List.equal cofix_expr_eq fl1 fl2
-  | CProdN(bl1,a1), CProdN(bl2,a2) ->
-      List.equal binder_expr_eq bl1 bl2 &&
+    | CProdN(bl1,a1), CProdN(bl2,a2) ->
+      List.equal local_binder_eq bl1 bl2 &&
       constr_expr_eq a1 a2
-  | CLambdaN(bl1,a1), CLambdaN(bl2,a2) ->
-      List.equal binder_expr_eq bl1 bl2 &&
+    | CLambdaN(bl1,a1), CLambdaN(bl2,a2) ->
+      List.equal local_binder_eq bl1 bl2 &&
       constr_expr_eq a1 a2
-  | CLetIn((_,na1),a1,t1,b1), CLetIn((_,na2),a2,t2,b2) ->
-      Name.equal na1 na2 &&
+    | CLetIn(na1,a1,t1,b1), CLetIn(na2,a2,t2,b2) ->
+      eq_ast Name.equal na1 na2 &&
       constr_expr_eq a1 a2 &&
       Option.equal constr_expr_eq t1 t2 &&
       constr_expr_eq b1 b2
-  | CAppExpl((proj1,r1,_),al1), CAppExpl((proj2,r2,_),al2) ->
+    | CAppExpl((proj1,r1,_),al1), CAppExpl((proj2,r2,_),al2) ->
       Option.equal Int.equal proj1 proj2 &&
       eq_reference r1 r2 &&
       List.equal constr_expr_eq al1 al2
-  | CApp((proj1,e1),al1), CApp((proj2,e2),al2) ->
+    | CApp((proj1,e1),al1), CApp((proj2,e2),al2) ->
       Option.equal Int.equal proj1 proj2 &&
       constr_expr_eq e1 e2 &&
       List.equal args_eq al1 al2
-  | CRecord l1, CRecord l2 ->
-    let field_eq (r1, e1) (r2, e2) =
-      eq_reference r1 r2 && constr_expr_eq e1 e2
-    in
-    List.equal field_eq l1 l2
-  | CCases(_,r1,a1,brl1), CCases(_,r2,a2,brl2) ->
+    | CRecord l1, CRecord l2 ->
+      let field_eq (r1, e1) (r2, e2) =
+        eq_reference r1 r2 && constr_expr_eq e1 e2
+      in
+      List.equal field_eq l1 l2
+    | CCases(_,r1,a1,brl1), CCases(_,r2,a2,brl2) ->
       (** Don't care about the case_style *)
       Option.equal constr_expr_eq r1 r2 &&
       List.equal case_expr_eq a1 a2 &&
       List.equal branch_expr_eq brl1 brl2
-  | CLetTuple (n1, (m1, e1), t1, b1), CLetTuple (n2, (m2, e2), t2, b2) ->
-    List.equal (eq_located Name.equal) n1 n2 &&
-    Option.equal (eq_located Name.equal) m1 m2 &&
-    Option.equal constr_expr_eq e1 e2 &&
-    constr_expr_eq t1 t2 &&
-    constr_expr_eq b1 b2
-  | CIf (e1, (n1, r1), t1, f1), CIf (e2, (n2, r2), t2, f2) ->
-    constr_expr_eq e1 e2 &&
-    Option.equal (eq_located Name.equal) n1 n2 &&
-    Option.equal constr_expr_eq r1 r2 &&
-    constr_expr_eq t1 t2 &&
-    constr_expr_eq f1 f2
-  | CHole _, CHole _ -> true
-  | CPatVar i1, CPatVar i2 ->
-    Id.equal i1 i2
-  | CEvar (id1, c1), CEvar (id2, c2) ->
-    Id.equal id1 id2 && List.equal instance_eq c1 c2
-  | CSort s1, CSort s2 ->
-    Miscops.glob_sort_eq s1 s2
-  | CCast(a1,(CastConv b1|CastVM b1)), CCast(a2,(CastConv b2|CastVM b2)) ->
-      constr_expr_eq a1 a2 &&
+    | CLetTuple (n1, (m1, e1), t1, b1), CLetTuple (n2, (m2, e2), t2, b2) ->
+      List.equal (eq_ast Name.equal) n1 n2 &&
+      Option.equal (eq_ast Name.equal) m1 m2 &&
+      Option.equal constr_expr_eq e1 e2 &&
+      constr_expr_eq t1 t2 &&
       constr_expr_eq b1 b2
-  | CCast(a1,CastCoerce), CCast(a2, CastCoerce) ->
-      constr_expr_eq a1 a2
-  | CNotation(n1, s1), CNotation(n2, s2) ->
+    | CIf (e1, (n1, r1), t1, f1), CIf (e2, (n2, r2), t2, f2) ->
+      constr_expr_eq e1 e2 &&
+      Option.equal (eq_ast Name.equal) n1 n2 &&
+      Option.equal constr_expr_eq r1 r2 &&
+      constr_expr_eq t1 t2 &&
+      constr_expr_eq f1 f2
+    | CHole _, CHole _ -> true
+    | CPatVar i1, CPatVar i2 ->
+      Id.equal i1 i2
+    | CEvar (id1, c1), CEvar (id2, c2) ->
+      Id.equal id1 id2 && List.equal instance_eq c1 c2
+    | CSort s1, CSort s2 ->
+      Miscops.glob_sort_eq s1 s2
+  | CCast(t1,c1), CCast(t2,c2) ->
+    constr_expr_eq t1 t2 && cast_expr_eq c1 c2
+    | CNotation(n1, s1), CNotation(n2, s2) ->
       String.equal n1 n2 &&
       constr_notation_substitution_eq s1 s2
-  | CPrim i1, CPrim i2 ->
-    prim_token_eq i1 i2
-  | CGeneralization (bk1, ak1, e1), CGeneralization (bk2, ak2, e2) ->
-    binding_kind_eq bk1 bk2 &&
-    Option.equal abstraction_kind_eq ak1 ak2 &&
-    constr_expr_eq e1 e2
-  | CDelimiters(s1,e1), CDelimiters(s2,e2) ->
-    String.equal s1 s2 &&
-    constr_expr_eq e1 e2
-  | _ -> false
+    | CPrim i1, CPrim i2 ->
+      prim_token_eq i1 i2
+    | CGeneralization (bk1, ak1, e1), CGeneralization (bk2, ak2, e2) ->
+      binding_kind_eq bk1 bk2 &&
+      Option.equal abstraction_kind_eq ak1 ak2 &&
+      constr_expr_eq e1 e2
+    | CDelimiters(s1,e1), CDelimiters(s2,e2) ->
+      String.equal s1 s2 &&
+      constr_expr_eq e1 e2
+    | CProj(p1,c1), CProj(p2,c2) ->
+      eq_reference p1 p2 && constr_expr_eq c1 c2
+  | (CRef _ | CFix _ | CCoFix _ | CProdN _ | CLambdaN _ | CLetIn _ | CAppExpl _
+     | CApp _ | CRecord _ | CCases _ | CLetTuple _ | CIf _ | CHole _
+     | CPatVar _ | CEvar _ | CSort _ | CCast _ | CNotation _ | CPrim _
+     | CGeneralization _ | CDelimiters _ | CProj _), _ -> false
 
 and args_eq (a1,e1) (a2,e2) =
-  Option.equal (eq_located explicitation_eq) e1 e2 &&
+  Option.equal (eq_ast explicitation_eq) e1 e2 &&
   constr_expr_eq a1 a2
 
 and case_expr_eq (e1, n1, p1) (e2, n2, p2) =
   constr_expr_eq e1 e2 &&
-  Option.equal (eq_located Name.equal) n1 n2 &&
+  Option.equal (eq_ast Name.equal) n1 n2 &&
   Option.equal cases_pattern_expr_eq p1 p2
 
-and branch_expr_eq (_, (p1, e1)) (_, (p2, e2)) =
-  List.equal (eq_located (List.equal cases_pattern_expr_eq)) p1 p2 &&
+and branch_expr_eq {CAst.v=(p1, e1)} {CAst.v=(p2, e2)} =
+  List.equal (List.equal cases_pattern_expr_eq) p1 p2 &&
   constr_expr_eq e1 e2
 
-and binder_expr_eq ((n1, _, e1) : binder_expr) (n2, _, e2) =
-  (** Don't care about the [binder_kind] *)
-  List.equal (eq_located Name.equal) n1 n2 && constr_expr_eq e1 e2
-
 and fix_expr_eq (id1,(j1, r1),bl1,a1,b1) (id2,(j2, r2),bl2,a2,b2) =
-  (eq_located Id.equal id1 id2) &&
-  Option.equal (eq_located Id.equal) j1 j2 &&
+  (eq_ast Id.equal id1 id2) &&
+  Option.equal (eq_ast Id.equal) j1 j2 &&
   recursion_order_expr_eq r1 r2 &&
   List.equal local_binder_eq bl1 bl2 &&
   constr_expr_eq a1 a2 &&
   constr_expr_eq b1 b2
 
 and cofix_expr_eq (id1,bl1,a1,b1) (id2,bl2,a2,b2) =
-  (eq_located Id.equal id1 id2) &&
+  (eq_ast Id.equal id1 id2) &&
   List.equal local_binder_eq bl1 bl2 &&
   constr_expr_eq a1 a2 &&
   constr_expr_eq b1 b2
 
 and recursion_order_expr_eq r1 r2 = match r1, r2 with
-| CStructRec, CStructRec -> true
-| CWfRec e1, CWfRec e2 -> constr_expr_eq e1 e2
-| CMeasureRec (e1, o1), CMeasureRec (e2, o2) ->
-  constr_expr_eq e1 e2 && Option.equal constr_expr_eq o1 o2
-| _ -> false
+  | CStructRec, CStructRec -> true
+  | CWfRec e1, CWfRec e2 -> constr_expr_eq e1 e2
+  | CMeasureRec (e1, o1), CMeasureRec (e2, o2) ->
+    constr_expr_eq e1 e2 && Option.equal constr_expr_eq o1 o2
+  | _ -> false
 
 and local_binder_eq l1 l2 = match l1, l2 with
-| CLocalDef (n1, e1, t1), CLocalDef (n2, e2, t2) ->
-  eq_located Name.equal n1 n2 && constr_expr_eq e1 e2 && Option.equal constr_expr_eq t1 t2
-| CLocalAssum (n1, _, e1), CLocalAssum (n2, _, e2) ->
-  (** Don't care about the [binder_kind] *)
-  List.equal (eq_located Name.equal) n1 n2 && constr_expr_eq e1 e2
-| _ -> false
+  | CLocalDef (n1, e1, t1), CLocalDef (n2, e2, t2) ->
+    eq_ast Name.equal n1 n2 && constr_expr_eq e1 e2 && Option.equal constr_expr_eq t1 t2
+  | CLocalAssum (n1, _, e1), CLocalAssum (n2, _, e2) ->
+    (** Don't care about the [binder_kind] *)
+    List.equal (eq_ast Name.equal) n1 n2 && constr_expr_eq e1 e2
+  | _ -> false
 
-and constr_notation_substitution_eq (e1, el1, bl1) (e2, el2, bl2) =
+and constr_notation_substitution_eq (e1, el1, b1, bl1) (e2, el2, b2, bl2) =
   List.equal constr_expr_eq e1 e2 &&
   List.equal (List.equal constr_expr_eq) el1 el2 &&
+  List.equal cases_pattern_expr_eq b1 b2 &&
   List.equal (List.equal local_binder_eq) bl1 bl2
 
 and instance_eq (x1,c1) (x2,c2) =
   Id.equal x1 x2 && constr_expr_eq c1 c2
 
+and cast_expr_eq c1 c2 = match c1, c2 with
+| CastConv t1, CastConv t2
+| CastVM t1, CastVM t2
+| CastNative t1, CastNative t2 -> constr_expr_eq t1 t2
+| CastCoerce, CastCoerce -> true
+| CastConv _, _
+| CastVM _, _
+| CastNative _, _
+| CastCoerce, _ -> false
+
 let constr_loc c = CAst.(c.loc)
 let cases_pattern_expr_loc cp = CAst.(cp.loc)
 
-let local_binder_loc = function
-  | CLocalAssum ((loc,_)::_,_,t)
-  | CLocalDef ((loc,_),t,None) -> Loc.merge_opt loc (constr_loc t)
-  | CLocalDef ((loc,_),b,Some t) -> Loc.merge_opt loc (Loc.merge_opt (constr_loc b) (constr_loc t))
+let local_binder_loc = let open CAst in function
+  | CLocalAssum ({ loc } ::_,_,t)
+  | CLocalDef ( { loc },t,None) -> Loc.merge_opt loc (constr_loc t)
+  | CLocalDef ( { loc },b,Some t) -> Loc.merge_opt loc (Loc.merge_opt (constr_loc b) (constr_loc t))
   | CLocalAssum ([],_,_) -> assert false
-  | CLocalPattern (loc,_) -> loc
+  | CLocalPattern { loc } -> loc
 
 let local_binders_loc bll = match bll with
   | []     -> None
   | h :: l -> Loc.merge_opt (local_binder_loc h) (local_binder_loc (List.last bll))
 
+(** Folds and maps *)
+
+let is_constructor id =
+  try Globnames.isConstructRef
+        (Smartlocate.global_of_extended_global
+           (Nametab.locate_extended (qualid_of_ident id)))
+  with Not_found -> false
+
+let rec cases_pattern_fold_names f a pt = match CAst.(pt.v) with
+  | CPatRecord l ->
+    List.fold_left (fun acc (r, cp) -> cases_pattern_fold_names f acc cp) a l
+  | CPatAlias (pat,{CAst.v=na}) -> Name.fold_right f na (cases_pattern_fold_names f a pat)
+  | CPatOr (patl) ->
+    List.fold_left (cases_pattern_fold_names f) a patl
+  | CPatCstr (_,patl1,patl2) ->
+    List.fold_left (cases_pattern_fold_names f)
+      (Option.fold_left (List.fold_left (cases_pattern_fold_names f)) a patl1) patl2
+  | CPatNotation (_,(patl,patll),patl') ->
+    List.fold_left (cases_pattern_fold_names f)
+      (List.fold_left (cases_pattern_fold_names f) a (patl@List.flatten patll)) patl'
+  | CPatDelimiters (_,pat) -> cases_pattern_fold_names f a pat
+  | CPatAtom (Some (Ident (_,id))) when not (is_constructor id) -> f id a
+  | CPatPrim _ | CPatAtom _ -> a
+  | CPatCast ({CAst.loc},_) ->
+    CErrors.user_err ?loc ~hdr:"cases_pattern_fold_names"
+      (Pp.strbrk "Casts are not supported here.")
+
+let ids_of_pattern =
+  cases_pattern_fold_names Id.Set.add Id.Set.empty
+
+let ids_of_pattern_list =
+  List.fold_left
+    (List.fold_left (cases_pattern_fold_names Id.Set.add))
+    Id.Set.empty
+
+let ids_of_cases_indtype p =
+  cases_pattern_fold_names Id.Set.add Id.Set.empty p
+
+let ids_of_cases_tomatch tms =
+  List.fold_right
+    (fun (_, ona, indnal) l ->
+       Option.fold_right (fun t ids -> cases_pattern_fold_names Id.Set.add ids t)
+         indnal
+         (Option.fold_right (CAst.with_val (Name.fold_right Id.Set.add)) ona l))
+    tms Id.Set.empty
+
+let rec fold_local_binders g f n acc b = let open CAst in function
+  | CLocalAssum (nal,bk,t)::l ->
+    let nal = List.(map (fun {v} -> v) nal) in
+    let n' = List.fold_right (Name.fold_right g) nal n in
+    f n (fold_local_binders g f n' acc b l) t
+  | CLocalDef ( { v = na },c,t)::l ->
+    Option.fold_left (f n) (f n (fold_local_binders g f (Name.fold_right g na n) acc b l) c) t
+  | CLocalPattern { v = 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
+
+let fold_constr_expr_with_binders g f n acc = CAst.with_val (function
+    | CAppExpl ((_,_,_),l) -> List.fold_left (f n) acc l
+    | CApp ((_,t),l) -> List.fold_left (f n) (f n acc t) (List.map fst l)
+    | CProdN (l,b) | CLambdaN (l,b) -> fold_local_binders g f n acc b l
+    | CLetIn (na,a,t,b) ->
+      f (Name.fold_right g (na.CAst.v) n) (Option.fold_left (f n) (f n acc a) t) b
+    | CCast (a,(CastConv b|CastVM b|CastNative b)) -> f n (f n acc a) b
+    | CCast (a,CastCoerce) -> f n acc a
+    | CNotation (_,(l,ll,bl,bll)) ->
+      (* The following is an approximation: we don't know exactly if
+         an ident is binding nor to which subterms bindings apply *)
+      let acc = List.fold_left (f n) acc (l@List.flatten ll) in
+      List.fold_left (fun acc bl -> fold_local_binders g f n acc (CAst.make @@ CHole (None,IntroAnonymous,None)) bl) acc bll
+    | CGeneralization (_,_,c) -> f n acc c
+    | CDelimiters (_,a) -> f n acc a
+    | CHole _ | CEvar _ | CPatVar _ | CSort _ | CPrim _ | CRef _ ->
+      acc
+    | CRecord l -> List.fold_left (fun acc (id, c) -> f n acc c) acc l
+    | CCases (sty,rtnpo,al,bl) ->
+      let ids = ids_of_cases_tomatch al in
+      let acc = Option.fold_left (f (Id.Set.fold g ids n)) acc rtnpo in
+      let acc = List.fold_left (f n) acc (List.map (fun (fst,_,_) -> fst) al) in
+      List.fold_right (fun {CAst.v=(patl,rhs)} acc ->
+          let ids = ids_of_pattern_list patl in
+          f (Id.Set.fold g ids n) acc rhs) bl acc
+    | CLetTuple (nal,(ona,po),b,c) ->
+      let n' = List.fold_right (CAst.with_val (Name.fold_right g)) nal n in
+      f (Option.fold_right (CAst.with_val (Name.fold_right g)) ona n') (f n acc b) c
+    | CIf (c,(ona,po),b1,b2) ->
+      let acc = f n (f n (f n acc b1) b2) c in
+      Option.fold_left
+        (f (Option.fold_right (CAst.with_val (Name.fold_right g)) ona n)) acc po
+    | CFix (_,l) ->
+      let n' = List.fold_right (fun ( { CAst.v = id },_,_,_,_) -> g id) l n in
+      List.fold_right (fun (_,(_,o),lb,t,c) acc ->
+          fold_local_binders g f n'
+            (fold_local_binders g f n acc t lb) c lb) l acc
+    | CCoFix (_,_) ->
+      Feedback.msg_warning (strbrk "Capture check in multiple binders not done"); acc
+    | CProj (_,c) ->
+        f n acc c
+  )
+
+let free_vars_of_constr_expr c =
+  let rec aux bdvars l = function
+    | { CAst.v = CRef (Ident (_,id),_) } -> if Id.List.mem id bdvars then l else Id.Set.add id l
+    | c -> fold_constr_expr_with_binders (fun a l -> a::l) aux bdvars l c
+  in aux [] Id.Set.empty c
+
+let occur_var_constr_expr id c = Id.Set.mem id (free_vars_of_constr_expr c)
+
+(* Used in correctness and interface *)
+let map_binder g e nal = List.fold_right (CAst.with_val (Name.fold_right g)) nal e
+
+let map_local_binders f g e bl =
+  (* TODO: avoid variable capture in [t] by some [na] in [List.tl nal] *)
+  let open CAst in
+  let h (e,bl) = function
+      CLocalAssum(nal,k,ty) ->
+      (map_binder g e nal, CLocalAssum(nal,k,f e ty)::bl)
+    | CLocalDef( { loc ; v = na } as cna ,c,ty) ->
+      (Name.fold_right g na e, CLocalDef(cna,f e c,Option.map (f e) ty)::bl)
+    | CLocalPattern { loc; v = pat,t } ->
+      let ids = ids_of_pattern pat in
+      (Id.Set.fold g ids e, CLocalPattern (make ?loc (pat,Option.map (f e) t))::bl) in
+  let (e,rbl) = List.fold_left h (e,[]) bl in
+  (e, List.rev rbl)
+
+let map_constr_expr_with_binders g f e = CAst.map (function
+    | CAppExpl (r,l) -> CAppExpl (r,List.map (f e) l)
+    | CApp ((p,a),l) ->
+      CApp ((p,f e a),List.map (fun (a,i) -> (f e a,i)) l)
+    | CProdN (bl,b) ->
+      let (e,bl) = map_local_binders f g e bl in CProdN (bl,f e b)
+    | CLambdaN (bl,b) ->
+      let (e,bl) = map_local_binders f g e bl in CLambdaN (bl,f e b)
+    | CLetIn (na,a,t,b) ->
+      CLetIn (na,f e a,Option.map (f e) t,f (Name.fold_right g (na.CAst.v) e) b)
+    | CCast (a,c) -> CCast (f e a, Miscops.map_cast_type (f e) c)
+    | CNotation (n,(l,ll,bl,bll)) ->
+      (* This is an approximation because we don't know what binds what *)
+      CNotation (n,(List.map (f e) l,List.map (List.map (f e)) ll, bl,
+                    List.map (fun bl -> snd (map_local_binders f g e bl)) bll))
+    | CGeneralization (b,a,c) -> CGeneralization (b,a,f e c)
+    | CDelimiters (s,a) -> CDelimiters (s,f e a)
+    | CHole _ | CEvar _ | CPatVar _ | CSort _
+    | CPrim _ | CRef _ as x -> x
+    | CRecord l -> CRecord (List.map (fun (id, c) -> (id, f e c)) l)
+    | CCases (sty,rtnpo,a,bl) ->
+      let bl = List.map (fun {CAst.v=(patl,rhs);loc} ->
+          let ids = ids_of_pattern_list patl in
+          CAst.make ?loc (patl,f (Id.Set.fold g ids e) rhs)) bl in
+      let ids = ids_of_cases_tomatch a in
+      let po = Option.map (f (Id.Set.fold g ids e)) rtnpo in
+      CCases (sty, po, List.map (fun (tm,x,y) -> f e tm,x,y) a,bl)
+    | CLetTuple (nal,(ona,po),b,c) ->
+      let e' = List.fold_right (CAst.with_val (Name.fold_right g)) nal e in
+      let e'' = Option.fold_right (CAst.with_val (Name.fold_right g)) ona e in
+      CLetTuple (nal,(ona,Option.map (f e'') po),f e b,f e' c)
+    | CIf (c,(ona,po),b1,b2) ->
+      let e' = Option.fold_right (CAst.with_val (Name.fold_right g)) ona e in
+      CIf (f e c,(ona,Option.map (f e') po),f e b1,f e b2)
+    | CFix (id,dl) ->
+      CFix (id,List.map (fun (id,n,bl,t,d) ->
+          let (e',bl') = map_local_binders f g e bl in
+          let t' = f e' t in
+          (* Note: fix names should be inserted before the arguments... *)
+          let e'' = List.fold_left (fun e ({ CAst.v = id },_,_,_,_) -> g id e) e' dl in
+          let d' = f e'' d in
+          (id,n,bl',t',d')) dl)
+    | CCoFix (id,dl) ->
+      CCoFix (id,List.map (fun (id,bl,t,d) ->
+          let (e',bl') = map_local_binders f g e bl in
+          let t' = f e' t in
+          let e'' = List.fold_left (fun e ({ CAst.v = id },_,_,_) -> g id e) e' dl in
+          let d' = f e'' d in
+          (id,bl',t',d')) dl)
+    | CProj (p,c) ->
+      CProj (p, f e c)
+  )
+
+(* Used in constrintern *)
+let rec replace_vars_constr_expr l = function
+  | { CAst.loc; v = CRef (Ident (loc_id,id),us) } as x ->
+    (try CAst.make ?loc @@ CRef (Ident (loc_id,Id.Map.find id l),us) with Not_found -> x)
+  | c -> map_constr_expr_with_binders Id.Map.remove
+           replace_vars_constr_expr l c
+
+(* Returns the ranges of locs of the notation that are not occupied by args  *)
+(* and which are then occupied by proper symbols of the notation (or spaces) *)
+
+let locs_of_notation ?loc locs ntn =
+  let unloc loc = Option.cata Loc.unloc (0,0) loc in
+  let (bl, el) = unloc loc        in
+  let locs =  List.map unloc locs in
+  let rec aux pos = function
+    | [] -> if Int.equal pos el then [] else [(pos,el)]
+    | (ba,ea)::l -> if Int.equal pos ba then aux ea l else (pos,ba)::aux ea l
+  in aux bl (List.sort (fun l1 l2 -> fst l1 - fst l2) locs)
+
+let ntn_loc ?loc (args,argslist,binders,binderslist) =
+  locs_of_notation ?loc
+    (List.map constr_loc (args@List.flatten argslist)@
+     List.map cases_pattern_expr_loc binders@
+     List.map local_binders_loc binderslist)
+
+let patntn_loc ?loc (args,argslist) =
+  locs_of_notation ?loc
+    (List.map cases_pattern_expr_loc (args@List.flatten argslist))
+
+let error_invalid_pattern_notation ?loc () =
+  CErrors.user_err ?loc  (str "Invalid notation for pattern.")
+
+(* Interpret the index of a recursion order annotation *)
+let split_at_annot bl na =
+  let open CAst in
+  let names = List.map (fun { v } -> v) (names_of_local_assums bl) in
+  match na with
+  | None ->
+    begin match names with
+      | [] -> CErrors.user_err (Pp.str "A fixpoint needs at least one parameter.")
+      | _ -> ([], bl)
+    end
+  | Some { loc; v = id } ->
+    let rec aux acc = function
+      | CLocalAssum (bls, k, t) as x :: rest ->
+        let test { CAst.v = na } = match na with
+          | Name id' -> Id.equal id id'
+          | Anonymous -> false
+        in
+        let l, r = List.split_when test bls in
+        begin match r with
+          | [] -> aux (x :: acc) rest
+          | _ ->
+            let ans = match l with
+              | [] -> acc
+              | _ -> CLocalAssum (l, k, t) :: acc
+            in
+            (List.rev ans, CLocalAssum (r, k, t) :: rest)
+        end
+      | CLocalDef ({ CAst.v = na },_,_) as x :: rest ->
+        if Name.equal (Name id) na then
+          CErrors.user_err ?loc
+            (Id.print id ++ str" must be a proper parameter and not a local definition.")
+        else
+          aux (x :: acc) rest
+      | CLocalPattern _ :: rest ->
+        Loc.raise ?loc (Stream.Error "pattern with quote not allowed after fix")
+      | [] ->
+        CErrors.user_err ?loc
+          (str "No parameter named " ++ Id.print id ++ str".")
+    in aux [] bl
+
 (** Pseudo-constructors *)
 
 let mkIdentC id   = CAst.make @@ CRef (Ident (Loc.tag id),None)
 let mkRefC r      = CAst.make @@ CRef (r,None)
 let mkCastC (a,k) = CAst.make @@ CCast (a,k)
-let mkLambdaC (idl,bk,a,b) = CAst.make @@ CLambdaN ([idl,bk,a],b)
+let mkLambdaC (idl,bk,a,b) = CAst.make @@ CLambdaN ([CLocalAssum (idl,bk,a)],b)
 let mkLetInC  (id,a,t,b)   = CAst.make @@ CLetIn (id,a,t,b)
-let mkProdC   (idl,bk,a,b) = CAst.make @@ CProdN ([idl,bk,a],b)
+let mkProdC   (idl,bk,a,b) = CAst.make @@ CProdN ([CLocalAssum (idl,bk,a)],b)
 
 let mkAppC (f,l) =
   let l = List.map (fun x -> (x,None)) l in
@@ -260,73 +522,83 @@ let mkAppC (f,l) =
   | CApp (g,l') -> CAst.make @@ CApp (g, l' @ l)
   | _           -> CAst.make @@ CApp ((None, f), l)
 
-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_binders ?loc mkC bl c =
-  let rec loop ?loc bl c =
-    match bl with
-    | [] -> ([], c)
-    | b :: bl ->
-        match b with
-        | CLocalDef ((loc1,_) as n, oty, b) ->
-            let env, c = loop ?loc:(Loc.merge_opt loc1 loc) bl c in
-            let env = add_name_in_env env n in
-            (env, CAst.make ?loc @@ CLetIn (n,oty,b,c))
-        | CLocalAssum ((loc1,_)::_ as nl, bk, t) ->
-            let env, c = loop ?loc:(Loc.merge_opt loc1 loc) bl c in
-            let env = List.fold_left add_name_in_env env nl in
-            (env, mkC ?loc (nl,bk,t) c)
-        | CLocalAssum ([],_,_) -> loop ?loc bl c
-        | CLocalPattern (loc1, (p, ty)) ->
-            let env, c = loop ?loc:(Loc.merge_opt loc1 loc) bl c in
-            let ni = Hook.get fresh_var env c in
-            let id = (loc1, Name ni) in
-            let ty = match ty with
-                 | Some ty -> ty
-                 | None -> CAst.make ?loc:loc1 @@ CHole (None, IntroAnonymous, None)
-            in
-            let e = CAst.make @@ CRef (Libnames.Ident (loc1, ni), None) in
-            let c = CAst.make ?loc @@
-              CCases
-                (LetPatternStyle, None, [(e,None,None)],
-                 [(Loc.tag ?loc:loc1 ([(loc1,[p])], c))])
-            in
-            (ni :: env, mkC ?loc ([id],Default Explicit,ty) c)
-  in
-  let (_, c) = loop ?loc bl c in
-  c
-
 let mkCProdN ?loc bll c =
-  let mk ?loc b c = CAst.make ?loc @@ CProdN ([b],c) in
-  expand_binders ?loc mk bll c
+  CAst.make ?loc @@ CProdN (bll,c)
 
 let mkCLambdaN ?loc bll c =
-  let mk ?loc b c = CAst.make ?loc @@ CLambdaN ([b],c) in
-  expand_binders ?loc mk bll c
-
-(* Deprecated *)
-let abstract_constr_expr c bl = mkCLambdaN ?loc:(local_binders_loc bl) bl c
-let prod_constr_expr c bl =  mkCProdN ?loc:(local_binders_loc bl) bl c
+  CAst.make ?loc @@ CLambdaN (bll,c)
 
 let coerce_reference_to_id = function
   | Ident (_,id) -> id
   | Qualid (loc,_) ->
-      CErrors.user_err ?loc ~hdr:"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
-  | { CAst.v = CRef (Ident (loc,id),_); _ } -> (loc,id)
+  | { CAst.v = CRef (Ident (loc,id),None) } -> CAst.make ?loc id
   | { CAst.loc; _ } -> CErrors.user_err ?loc
-       ~hdr:"coerce_to_id"
-         (str "This expression should be a simple identifier.")
+                         ~hdr:"coerce_to_id"
+                         (str "This expression should be a simple identifier.")
 
 let coerce_to_name = function
-  | { CAst.v = CRef (Ident (loc,id),_) } -> (loc,Name id)
-  | { CAst.loc; CAst.v = CHole (_,_,_) } -> (loc,Anonymous)
+  | { CAst.v = CRef (Ident (loc,id),None) } -> CAst.make ?loc @@ Name id
+  | { CAst.loc; CAst.v = CHole (None,Misctypes.IntroAnonymous,None) } -> CAst.make ?loc Anonymous
   | { CAst.loc; _ } -> CErrors.user_err ?loc ~hdr:"coerce_to_name"
                          (str "This expression should be a name.")
+
+let mkCPatOr ?loc = function
+  | [pat] -> pat
+  | disjpat -> CAst.make ?loc @@ (CPatOr disjpat)
+
+let mkAppPattern ?loc p lp =
+  let open CAst in
+  make ?loc @@ (match p.v with
+  | CPatAtom (Some r) -> CPatCstr (r, None, lp)
+  | CPatCstr (r, None, l2) ->
+     CErrors.user_err ?loc:p.loc ~hdr:"compound_pattern"
+                      (Pp.str "Nested applications not supported.")
+  | CPatCstr (r, l1, l2) -> CPatCstr (r, l1 , l2@lp)
+  | CPatNotation (n, s, l) -> CPatNotation (n , s, l@lp)
+  | _ -> CErrors.user_err
+           ?loc:p.loc ~hdr:"compound_pattern"
+           (Pp.str "Such pattern cannot have arguments."))
+
+let rec coerce_to_cases_pattern_expr c = CAst.map_with_loc (fun ?loc -> function
+  | CRef (r,None) ->
+     CPatAtom (Some r)
+  | CHole (None,Misctypes.IntroAnonymous,None) ->
+     CPatAtom None
+  | CLetIn ({CAst.loc;v=Name id},b,None,{ CAst.v = CRef (Ident (_,id'),None) }) when Id.equal id id' ->
+      CPatAlias (coerce_to_cases_pattern_expr b, CAst.(make ?loc @@ Name id))
+  | CApp ((None,p),args) when List.for_all (fun (_,e) -> e=None) args ->
+     (mkAppPattern (coerce_to_cases_pattern_expr p) (List.map (fun (a,_) -> coerce_to_cases_pattern_expr a) args)).CAst.v
+  | CAppExpl ((None,r,i),args) ->
+     CPatCstr (r,Some (List.map coerce_to_cases_pattern_expr args),[])
+  | CNotation (ntn,(c,cl,[],[])) ->
+     CPatNotation (ntn,(List.map coerce_to_cases_pattern_expr c,
+                        List.map (List.map coerce_to_cases_pattern_expr) cl),[])
+  | CPrim p ->
+     CPatPrim p
+  | CRecord l ->
+     CPatRecord (List.map (fun (r,p) -> (r,coerce_to_cases_pattern_expr p)) l)
+  | CDelimiters (s,p) ->
+     CPatDelimiters (s,coerce_to_cases_pattern_expr p)
+  | CCast (p,CastConv t) ->
+     CPatCast (coerce_to_cases_pattern_expr p,t)
+  | _ ->
+     CErrors.user_err ?loc ~hdr:"coerce_to_cases_pattern_expr"
+                      (str "This expression should be coercible to a pattern.")) c
+
+let asymmetric_patterns = ref (false)
+let _ = Goptions.declare_bool_option {
+  Goptions.optdepr = false;
+  Goptions.optname = "no parameters in constructors";
+  Goptions.optkey = ["Asymmetric";"Patterns"];
+  Goptions.optread = (fun () -> !asymmetric_patterns);
+  Goptions.optwrite = (fun a -> asymmetric_patterns:=a);
+}
+
+(************************************************************************)
+(* Deprecated *)
+let abstract_constr_expr c bl = mkCLambdaN ?loc:(local_binders_loc bl) bl c
+let prod_constr_expr c bl =  mkCProdN ?loc:(local_binders_loc bl) bl c
diff --git a/interp/constrexpr_ops.mli b/interp/constrexpr_ops.mli
index 7bd275e51..50c818d3c 100644
--- a/interp/constrexpr_ops.mli
+++ b/interp/constrexpr_ops.mli
@@ -6,7 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Loc
 open Names
 open Libnames
 open Misctypes
@@ -44,9 +43,9 @@ val mkIdentC : Id.t -> constr_expr
 val mkRefC : reference -> constr_expr
 val mkAppC : constr_expr * constr_expr list -> constr_expr
 val mkCastC : constr_expr * constr_expr cast_type -> constr_expr
-val mkLambdaC : Name.t located list * binder_kind * constr_expr * constr_expr -> constr_expr
-val mkLetInC : Name.t located * constr_expr * constr_expr option * constr_expr -> constr_expr
-val mkProdC : Name.t located list * binder_kind * constr_expr * constr_expr -> constr_expr
+val mkLambdaC : lname list * binder_kind * constr_expr * constr_expr -> constr_expr
+val mkLetInC : lname * constr_expr * constr_expr option * constr_expr -> constr_expr
+val mkProdC : lname list * binder_kind * constr_expr * constr_expr -> constr_expr
 
 val mkCLambdaN : ?loc:Loc.t -> local_binder_expr list -> constr_expr -> constr_expr
 (** Same as [abstract_constr_expr], with location *)
@@ -54,32 +53,72 @@ val mkCLambdaN : ?loc:Loc.t -> local_binder_expr list -> constr_expr -> constr_e
 val mkCProdN : ?loc:Loc.t -> local_binder_expr list -> constr_expr -> constr_expr
 (** Same as [prod_constr_expr], with location *)
 
+val mkCPatOr : ?loc:Loc.t -> cases_pattern_expr list -> cases_pattern_expr
+
+val mkAppPattern : ?loc:Loc.t -> cases_pattern_expr -> cases_pattern_expr list -> cases_pattern_expr
+(** Apply a list of pattern arguments to a pattern *)
+
 (** @deprecated variant of mkCLambdaN *)
 val abstract_constr_expr : constr_expr -> local_binder_expr list -> constr_expr
+[@@ocaml.deprecated "deprecated variant of mkCLambdaN"]
 
 (** @deprecated variant of mkCProdN *)
 val prod_constr_expr : constr_expr -> local_binder_expr list -> constr_expr
-
-val fresh_var_hook : (Names.Id.t list -> Constrexpr.constr_expr -> Names.Id.t) Hook.t
+[@@ocaml.deprecated "deprecated variant of mkCProdN"]
 
 (** {6 Destructors}*)
 
 val coerce_reference_to_id : reference -> Id.t
 (** FIXME: nothing to do here *)
 
-val coerce_to_id : constr_expr -> Id.t located
+val coerce_to_id : constr_expr -> lident
 (** Destruct terms of the form [CRef (Ident _)]. *)
 
-val coerce_to_name : constr_expr -> Name.t located
+val coerce_to_name : constr_expr -> lname
 (** Destruct terms of the form [CRef (Ident _)] or [CHole _]. *)
 
+val coerce_to_cases_pattern_expr : constr_expr -> cases_pattern_expr
+
 (** {6 Binder manipulation} *)
 
 val default_binder_kind : binder_kind
 
-val names_of_local_binders : local_binder_expr list -> Name.t located list
+val names_of_local_binders : local_binder_expr list -> lname list
 (** Retrieve a list of binding names from a list of binders. *)
 
-val names_of_local_assums : local_binder_expr list -> Name.t located list
+val names_of_local_assums : local_binder_expr list -> lname list
 (** Same as [names_of_local_binder_exprs], but does not take the [let] bindings into
     account. *)
+
+(** {6 Folds and maps} *)
+
+(** Used in typeclasses *)
+val fold_constr_expr_with_binders : (Id.t -> 'a -> 'a) ->
+   ('a -> 'b -> constr_expr -> 'b) -> 'a -> 'b -> constr_expr -> 'b
+
+(** Used in correctness and interface; absence of var capture not guaranteed
+   in pattern-matching clauses and in binders of the form [x,y:T(x)] *)
+
+val map_constr_expr_with_binders :
+  (Id.t -> 'a -> 'a) -> ('a -> constr_expr -> constr_expr) ->
+      'a -> constr_expr -> constr_expr
+
+val replace_vars_constr_expr :
+  Id.t Id.Map.t -> constr_expr -> constr_expr
+
+(** Specific function for interning "in indtype" syntax of "match" *)
+val ids_of_cases_indtype : cases_pattern_expr -> Id.Set.t
+
+val free_vars_of_constr_expr : constr_expr -> Id.Set.t
+val occur_var_constr_expr : Id.t -> constr_expr -> bool
+
+val split_at_annot : local_binder_expr list -> lident option -> local_binder_expr list * local_binder_expr list
+
+val ntn_loc : ?loc:Loc.t -> constr_notation_substitution -> string -> (int * int) list
+val patntn_loc : ?loc:Loc.t -> cases_pattern_notation_substitution -> string -> (int * int) list
+
+(** For cases pattern parsing errors *)
+val error_invalid_pattern_notation : ?loc:Loc.t -> unit -> 'a
+
+(** Placeholder for global option, should be moved to a parameter *)
+val asymmetric_patterns : bool ref
diff --git a/interp/constrextern.ml b/interp/constrextern.ml
index e85415bed..dec86ba81 100644
--- a/interp/constrextern.ml
+++ b/interp/constrextern.ml
@@ -12,7 +12,7 @@ open CErrors
 open Util
 open Names
 open Nameops
-open Term
+open Constr
 open Termops
 open Libnames
 open Globnames
@@ -21,7 +21,6 @@ open CAst
 open Constrexpr
 open Constrexpr_ops
 open Notation_ops
-open Topconstr
 open Glob_term
 open Glob_ops
 open Pattern
@@ -185,18 +184,8 @@ let with_universes f = Flags.with_option print_universes f
 let with_meta_as_hole f = Flags.with_option print_meta_as_hole f
 let without_symbols f = Flags.with_option print_no_symbol f
 
-(* XXX: Where to put this in the library? Util maybe? *)
-let protect_ref r nf f x =
-  let old_ref = !r in
-  r := nf !r;
-  try let res = f x in r := old_ref; res
-  with reraise ->
-    let reraise = Backtrace.add_backtrace reraise in
-    r := old_ref;
-    Exninfo.iraise reraise
-
 let without_specific_symbols l =
-  protect_ref inactive_notations_table
+  Flags.with_modified_ref inactive_notations_table
     (fun tbl -> IRuleSet.(union (of_list l) tbl))
 
 (**********************************************************************)
@@ -268,7 +257,7 @@ let insert_pat_delimiters ?loc p = function
 
 let insert_pat_alias ?loc p = function
   | Anonymous -> p
-  | Name id -> CAst.make ?loc @@ CPatAlias (p,id)
+  | Name _ as na -> CAst.make ?loc @@ CPatAlias (p,(CAst.make ?loc na))
 
 (**********************************************************************)
 (* conversion of references                                           *)
@@ -298,7 +287,7 @@ let add_patt_for_params ind l =
 
 let add_cpatt_for_params ind l =
   if !Flags.in_debugger then l else
-    Util.List.addn  (Inductiveops.inductive_nparamdecls ind) (CAst.make @@ PatVar Anonymous) l
+    Util.List.addn  (Inductiveops.inductive_nparamdecls ind) (DAst.make @@ PatVar Anonymous) l
 
 let drop_implicits_in_patt cst nb_expl args =
   let impl_st = (implicits_of_global cst) in
@@ -334,34 +323,35 @@ let is_zero s =
     Int.equal (String.length s) i || (s.[i] == '0' && aux (i+1))
   in aux 0
 
-let make_notation_gen loc ntn mknot mkprim destprim l =
+let make_notation_gen loc ntn mknot mkprim destprim l bl =
   match ntn,List.map destprim l with
     (* Special case to avoid writing "- 3" for e.g. (Z.opp 3) *)
     | "- _", [Some (Numeral (p,true))] when not (is_zero p) ->
-        mknot (loc,ntn,([mknot (loc,"( _ )",l)]))
+        assert (bl=[]);
+        mknot (loc,ntn,([mknot (loc,"( _ )",l,[])]),[])
     | _ ->
 	match decompose_notation_key ntn, l with
 	| [Terminal "-"; Terminal x], [] when is_number x ->
 	   mkprim (loc, Numeral (x,false))
 	| [Terminal x], [] when is_number x ->
 	   mkprim (loc, Numeral (x,true))
-	| _ -> mknot (loc,ntn,l)
+        | _ -> mknot (loc,ntn,l,bl)
 
-let make_notation loc ntn (terms,termlists,binders as subst) =
-  if not (List.is_empty termlists) || not (List.is_empty binders) then
+let make_notation loc ntn (terms,termlists,binders,binderlists as subst) =
+  if not (List.is_empty termlists) || not (List.is_empty binderlists) then
     CAst.make ?loc @@ CNotation (ntn,subst)
   else
     make_notation_gen loc ntn
-      (fun (loc,ntn,l) -> CAst.make ?loc @@ CNotation (ntn,(l,[],[])))
+      (fun (loc,ntn,l,bl) -> CAst.make ?loc @@ CNotation (ntn,(l,[],bl,[])))
       (fun (loc,p) -> CAst.make ?loc @@ CPrim p)
-      destPrim terms
+      destPrim terms binders
 
 let make_pat_notation ?loc ntn (terms,termlists as subst) args =
   if not (List.is_empty termlists) then (CAst.make ?loc @@ CPatNotation (ntn,subst,args)) else
   make_notation_gen loc ntn
-    (fun (loc,ntn,l) -> CAst.make ?loc @@ CPatNotation (ntn,(l,[]),args))
+    (fun (loc,ntn,l,_) -> CAst.make ?loc @@ CPatNotation (ntn,(l,[]),args))
     (fun (loc,p)     -> CAst.make ?loc @@ CPatPrim p)
-    destPatPrim terms
+    destPatPrim terms []
 
 let mkPat ?loc qid l = CAst.make ?loc @@
   (* Normally irrelevant test with v8 syntax, but let's do it anyway *)
@@ -376,6 +366,10 @@ let pattern_printable_in_both_syntax (ind,_ as c) =
       (List.for_all is_status_implicit params)&&(List.for_all (fun x -> not (is_status_implicit x)) args)
   ) impl_st
 
+let lift f c =
+  let loc = c.CAst.loc in
+  CAst.make ?loc (f ?loc (DAst.get c))
+
  (* Better to use extern_glob_constr composed with injection/retraction ?? *)
 let rec extern_cases_pattern_in_scope (scopes:local_scopes) vars pat =
   try
@@ -390,9 +384,9 @@ let rec extern_cases_pattern_in_scope (scopes:local_scopes) vars pat =
     try
       if !Flags.in_debugger || !Flags.raw_print || !print_no_symbol then raise No_match;
       extern_notation_pattern scopes vars pat
-	(uninterp_cases_pattern_notations pat)
+        (uninterp_cases_pattern_notations scopes pat)
     with No_match ->
-      CAst.map_with_loc (fun ?loc -> function
+      lift (fun ?loc -> function
 	| PatVar (Name id) -> CPatAtom (Some (Ident (loc,id)))
 	| PatVar (Anonymous) -> CPatAtom None
 	| PatCstr(cstrsp,args,na) ->
@@ -420,7 +414,7 @@ let rec extern_cases_pattern_in_scope (scopes:local_scopes) vars pat =
 	    with
 		Not_found | No_match | Exit ->
                   let c = extern_reference ?loc Id.Set.empty (ConstructRef cstrsp) in
-		  if !Topconstr.asymmetric_patterns then
+                  if !asymmetric_patterns then
 		    if pattern_printable_in_both_syntax cstrsp
 		    then CPatCstr (c, None, args)
 		    else CPatCstr (c, Some (add_patt_for_params (fst cstrsp) args), [])
@@ -452,7 +446,7 @@ and apply_notation_to_pattern ?loc gr ((subst,substlist),(nb_to_drop,more_args))
 		List.map (extern_cases_pattern_in_scope subscope vars) c)
 		substlist in
 	    let l2 = List.map (extern_cases_pattern_in_scope allscopes vars) more_args in
-	    let l2' = if !Topconstr.asymmetric_patterns || not (List.is_empty ll) then l2
+            let l2' = if !asymmetric_patterns || not (List.is_empty ll) then l2
 	      else
 		match drop_implicits_in_patt gr nb_to_drop l2 with
 		  |Some true_args -> true_args
@@ -468,7 +462,7 @@ and apply_notation_to_pattern ?loc gr ((subst,substlist),(nb_to_drop,more_args))
           extern_cases_pattern_in_scope (scopt,scl@scopes) vars c)
           subst in
       let l2 = List.map (extern_cases_pattern_in_scope allscopes vars) more_args in
-      let l2' = if !Topconstr.asymmetric_patterns then l2
+      let l2' = if !asymmetric_patterns then l2
 	else
 	  match drop_implicits_in_patt gr (nb_to_drop + List.length l1) l2 with
 	    |Some true_args -> true_args
@@ -482,7 +476,7 @@ and extern_notation_pattern (tmp_scope,scopes as allscopes) vars t = function
     try
       if is_inactive_rule keyrule then raise No_match;
       let loc = t.loc in
-      match t.v with
+      match DAst.get t with
 	| PatCstr (cstr,_,na) ->
 	  let p = apply_notation_to_pattern ?loc (ConstructRef cstr)
 	    (match_notation_constr_cases_pattern t pat) allscopes vars keyrule in
@@ -521,7 +515,7 @@ let extern_ind_pattern_in_scope (scopes:local_scopes) vars ind args =
       try
 	if !Flags.raw_print || !print_no_symbol then raise No_match;
 	extern_notation_ind_pattern scopes vars ind args
-	  (uninterp_ind_pattern_notations ind)
+          (uninterp_ind_pattern_notations scopes ind)
     with No_match ->
       let c = extern_reference vars (IndRef ind) in
       let args = List.map (extern_cases_pattern_in_scope scopes vars) args in
@@ -540,6 +534,10 @@ let occur_name na aty =
     | Name id -> occur_var_constr_expr id aty
     | Anonymous -> false
 
+let is_gvar id c = match DAst.get c with
+| GVar id' -> Id.equal id id'
+| _ -> false
+
 let is_projection nargs = function
   | Some r when not !Flags.in_debugger && not !Flags.raw_print && !print_projections ->
     (try
@@ -576,7 +574,7 @@ let explicitize inctx impl (cf,f) args =
 	   is_significant_implicit (Lazy.force a))
 	in
         if visible then
-	  (Lazy.force a,Some (Loc.tag @@ ExplByName (name_of_implicit imp))) :: tail
+          (Lazy.force a,Some (make @@ ExplByName (name_of_implicit imp))) :: tail
 	else
 	  tail
     | a::args, _::impl -> (Lazy.force a,None) :: exprec (q+1) (args,impl)
@@ -645,8 +643,12 @@ 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
-  | {loc; v = GApp ({ v = GRef (r,_) },args)} -> Some (loc, r, 0, args)
+let match_coercion_app c = match DAst.get c with
+  | GApp (r, args) ->
+    begin match DAst.get r with
+    | GRef (r,_) -> Some (c.CAst.loc, r, 0, args)
+    | _ -> None
+    end
   | _ -> None
 
 let rec remove_coercions inctx c =
@@ -668,14 +670,20 @@ let rec remove_coercions inctx c =
 		 been confused with ordinary application or would have need
                  a surrounding context and the coercion to funclass would
                  have been made explicit to match *)
-	      if List.is_empty l then a' else CAst.make ?loc @@ GApp (a',l)
+	      if List.is_empty l then a' else DAst.make ?loc @@ GApp (a',l)
 	  | _ -> c
       with Not_found -> c)
   | _ -> c
 
-let rec flatten_application = function
-  | {loc; v = GApp ({ v = GApp(a,l')},l)} -> flatten_application (CAst.make ?loc @@ GApp (a,l'@l))
-  | a -> a
+let rec flatten_application c = match DAst.get c with
+  | GApp (f, l) ->
+    begin match DAst.get f with
+    | GApp(a,l') ->
+      let loc = c.CAst.loc in
+      flatten_application (DAst.make ?loc @@ GApp (a,l'@l))
+    | _ -> c
+    end
+  | a -> c
 
 (**********************************************************************)
 (* mapping glob_constr to numerals (in presence of coercions, choose the *)
@@ -702,10 +710,12 @@ let extern_optimal_prim_token scopes r r' =
 
 let extended_glob_local_binder_of_decl loc = function
   | (p,bk,None,t) -> GLocalAssum (p,bk,t)
-  | (p,bk,Some x, { v = GHole ( _, Misctypes.IntroAnonymous, None) } ) -> GLocalDef (p,bk,x,None)
-  | (p,bk,Some x,t) -> GLocalDef (p,bk,x,Some t)
+  | (p,bk,Some x, t) ->
+    match DAst.get t with
+    | GHole (_, Misctypes.IntroAnonymous, None) -> GLocalDef (p,bk,x,None)
+    | _ -> GLocalDef (p,bk,x,Some t)
 
-let extended_glob_local_binder_of_decl ?loc u = CAst.make ?loc (extended_glob_local_binder_of_decl loc u)
+let extended_glob_local_binder_of_decl ?loc u = DAst.make ?loc (extended_glob_local_binder_of_decl loc u)
 
 (**********************************************************************)
 (* mapping glob_constr to constr_expr                                    *)
@@ -729,8 +739,8 @@ let rec extern inctx scopes vars r =
   try
     let r'' = flatten_application r' in
     if !Flags.raw_print || !print_no_symbol then raise No_match;
-    extern_notation scopes vars r'' (uninterp_notations r'')
-  with No_match -> CAst.map_with_loc (fun ?loc -> function
+    extern_notation scopes vars r'' (uninterp_notations scopes r'')
+  with No_match -> lift (fun ?loc -> function
   | GRef (ref,us) ->
       extern_global (select_stronger_impargs (implicits_of_global ref))
         (extern_reference ?loc vars ref) (extern_universes us)
@@ -749,8 +759,9 @@ let rec extern inctx scopes vars r =
          | Evar_kinds.FirstOrderPatVar n -> CEvar (n,[]))
 
   | GApp (f,args) ->
-      (match f with
-	 | {loc = rloc; v = GRef (ref,us) } ->
+      (match DAst.get f with
+	 | GRef (ref,us) ->
+            let rloc = f.CAst.loc in
 	     let subscopes = find_arguments_scope ref in
 	     let args = fill_arg_scopes args subscopes (snd scopes) in
 	     begin
@@ -805,19 +816,17 @@ let rec extern inctx scopes vars r =
              (List.map (fun c -> lazy (sub_extern true scopes vars c)) args))
 
   | GLetIn (na,b,t,c) ->
-      CLetIn ((loc,na),sub_extern false scopes vars b,
+      CLetIn (make ?loc na,sub_extern false scopes vars b,
               Option.map (extern_typ scopes vars) t,
               extern inctx scopes (add_vname vars na) c)
 
   | GProd (na,bk,t,c) ->
       let t = extern_typ scopes vars t in
-      let (idl,c) = factorize_prod scopes (add_vname vars na) na bk t c in
-      CProdN ([(Loc.tag na)::idl,Default bk,t],c)
+      factorize_prod scopes (add_vname vars na) na bk t c
 
   | GLambda (na,bk,t,c) ->
       let t = extern_typ scopes vars t in
-      let (idl,c) = factorize_lambda inctx scopes (add_vname vars na) na bk t c in
-      CLambdaN ([(Loc.tag na)::idl,Default bk,t],c)
+      factorize_lambda inctx scopes (add_vname vars na) na bk t c
 
   | GCases (sty,rtntypopt,tml,eqns) ->
     let vars' =
@@ -825,40 +834,40 @@ let rec extern inctx scopes vars r =
 	(cases_predicate_names tml) vars in
     let rtntypopt' = Option.map (extern_typ scopes vars') rtntypopt in
     let tml = List.map (fun (tm,(na,x)) ->
-                 let na' = match na,tm with
-                   | Anonymous, { v = GVar id } ->
+                 let na' = match na, DAst.get tm with
+                   | Anonymous, GVar id ->
                       begin match rtntypopt with
                             | None -> None
                             | Some ntn ->
                                if occur_glob_constr id ntn then
-                                 Some (Loc.tag Anonymous)
+                                 Some (CAst.make Anonymous)
                                else None
                       end
                    | Anonymous, _ -> None
-                   | Name id, { v = GVar id' } when Id.equal id id' -> None
-                   | Name _, _ -> Some (Loc.tag na) in
+                   | Name id, GVar id' when Id.equal id id' -> None
+                   | Name _, _ -> Some (CAst.make na) in
                  (sub_extern false scopes vars tm,
                   na',
                   Option.map (fun (loc,(ind,nal)) ->
-                              let args = List.map (fun x -> CAst.make @@ PatVar x) nal in
+                              let args = List.map (fun x -> DAst.make @@ PatVar x) nal in
                               let fullargs = add_cpatt_for_params ind args in
                               extern_ind_pattern_in_scope scopes vars ind fullargs
                              ) x))
                 tml
     in
-    let eqns = List.map (extern_eqn inctx scopes vars) eqns in
+    let eqns = List.map (extern_eqn inctx scopes vars) (factorize_eqns eqns) in
     CCases (sty,rtntypopt',tml,eqns)
 
   | GLetTuple (nal,(na,typopt),tm,b) ->
-      CLetTuple (List.map (fun na -> (Loc.tag na)) nal,
-        (Option.map (fun _ -> (Loc.tag na)) typopt,
+    CLetTuple (List.map CAst.make nal,
+        (Option.map (fun _ -> (make na)) typopt,
          Option.map (extern_typ scopes (add_vname vars na)) typopt),
         sub_extern false scopes vars tm,
         extern inctx scopes (List.fold_left add_vname vars nal) b)
 
   | GIf (c,(na,typopt),b1,b2) ->
       CIf (sub_extern false scopes vars c,
-        (Option.map (fun _ -> (Loc.tag na)) typopt,
+        (Option.map (fun _ -> (CAst.make na)) typopt,
          Option.map (extern_typ scopes (add_vname vars na)) typopt),
         sub_extern inctx scopes vars b1, sub_extern inctx scopes vars b2)
 
@@ -876,13 +885,13 @@ let rec extern inctx scopes vars r =
 		 let n =
 		   match fst nv.(i) with
 		     | None -> None
-		     | Some x -> Some (Loc.tag @@ Name.get_id (List.nth assums x))
+                     | Some x -> Some (CAst.make @@ Name.get_id (List.nth assums x))
 		 in
 		 let ro = extern_recursion_order scopes vars (snd nv.(i)) in
-		 ((Loc.tag fi), (n, ro), bl, extern_typ scopes vars0 ty,
+                 ((CAst.make fi), (n, ro), bl, extern_typ scopes vars0 ty,
                   extern false scopes vars1 def)) idv
 	     in
-	     CFix ((loc,idv.(n)),Array.to_list listdecl)
+             CFix (CAst.(make ?loc idv.(n)), Array.to_list listdecl)
 	 | GCoFix n ->
 	     let listdecl =
                Array.mapi (fun i fi ->
@@ -890,10 +899,10 @@ let rec extern inctx scopes vars r =
                  let (_,ids,bl) = extern_local_binder scopes vars bl in
                  let vars0 = List.fold_right (Name.fold_right Id.Set.add) ids vars in
                  let vars1 = List.fold_right (Name.fold_right Id.Set.add) ids vars' in
-		 ((Loc.tag fi),bl,extern_typ scopes vars0 tyv.(i),
+                 ((CAst.make fi),bl,extern_typ scopes vars0 tyv.(i),
                   sub_extern false scopes vars1 bv.(i))) idv
 	     in
-	     CCoFix ((loc,idv.(n)),Array.to_list listdecl))
+             CCoFix (CAst.(make ?loc idv.(n)),Array.to_list listdecl))
 
   | GSort s -> CSort (extern_glob_sort s)
 
@@ -902,6 +911,9 @@ let rec extern inctx scopes vars r =
   | GCast (c, c') ->
       CCast (sub_extern true scopes vars c,
 	     Miscops.map_cast_type (extern_typ scopes vars) c')
+  | GProj (p, c) ->
+    let pr = extern_reference ?loc Id.Set.empty (ConstRef (Projection.constant p)) in
+    CProj (pr, sub_extern inctx scopes vars c)
   ) r'
 
 and extern_typ (_,scopes) =
@@ -910,35 +922,73 @@ and extern_typ (_,scopes) =
 and sub_extern inctx (_,scopes) = extern inctx (None,scopes)
 
 and factorize_prod scopes vars na bk aty c =
-  let c = extern_typ scopes vars c in
-  match na, c with
-  | Name id, { CAst.loc ; v = CProdN ([nal,Default bk',ty],c) }
-      when binding_kind_eq bk bk' && constr_expr_eq aty ty
-      && not (occur_var_constr_expr id ty) (* avoid na in ty escapes scope *) ->
-      nal,c
-  | _ ->
-      [],c
+  let store, get = set_temporary_memory () in
+  match na, DAst.get c with
+  | Name id, GCases (LetPatternStyle, None, [(e,(Anonymous,None))],(_::_ as eqns))
+         when is_gvar id e && List.length (store (factorize_eqns eqns)) = 1 ->
+    (match get () with
+     | [(_,(ids,disj_of_patl,b))] ->
+      let disjpat = List.map (function [pat] -> pat | _ -> assert false) disj_of_patl in
+      let disjpat = if occur_glob_constr id b then List.map (set_pat_alias id) disjpat else disjpat in
+      let b = extern_typ scopes vars b in
+      let p = mkCPatOr (List.map (extern_cases_pattern_in_scope scopes vars) disjpat) in
+      let binder = CLocalPattern (make ?loc:c.loc (p,None)) in
+      (match b.v with
+      | CProdN (bl,b) -> CProdN (binder::bl,b)
+      | _ -> CProdN ([binder],b))
+     | _ -> assert false)
+  | _, _ ->
+      let c = extern_typ scopes vars c in
+      match na, c.v with
+      | Name id, CProdN (CLocalAssum(nal,Default bk',ty)::bl,b)
+           when binding_kind_eq bk bk' && constr_expr_eq aty ty
+                && not (occur_var_constr_expr id ty) (* avoid na in ty escapes scope *) ->
+         CProdN (CLocalAssum(make na::nal,Default bk,aty)::bl,b)
+      | _, CProdN (bl,b) ->
+         CProdN (CLocalAssum([make na],Default bk,aty)::bl,b)
+      | _, _ ->
+         CProdN ([CLocalAssum([make na],Default bk,aty)],c)
 
 and factorize_lambda inctx scopes vars na bk aty c =
-  let c = sub_extern inctx scopes vars c in
-  match c with
-  | { CAst.loc; v = CLambdaN ([nal,Default bk',ty],c) }
-      when binding_kind_eq bk bk' && constr_expr_eq aty ty
-      && not (occur_name na ty) (* avoid na in ty escapes scope *) ->
-      nal,c
-  | _ ->
-      [],c
+  let store, get = set_temporary_memory () in
+  match na, DAst.get c with
+  | Name id, GCases (LetPatternStyle, None, [(e,(Anonymous,None))],(_::_ as eqns))
+         when is_gvar id e && List.length (store (factorize_eqns eqns)) = 1 ->
+    (match get () with
+     | [(_,(ids,disj_of_patl,b))] ->
+      let disjpat = List.map (function [pat] -> pat | _ -> assert false) disj_of_patl in
+      let disjpat = if occur_glob_constr id b then List.map (set_pat_alias id) disjpat else disjpat in
+      let b = sub_extern inctx scopes vars b in
+      let p = mkCPatOr (List.map (extern_cases_pattern_in_scope scopes vars) disjpat) in
+      let binder = CLocalPattern (make ?loc:c.loc (p,None)) in
+      (match b.v with
+      | CLambdaN (bl,b) -> CLambdaN (binder::bl,b)
+      | _ -> CLambdaN ([binder],b))
+     | _ -> assert false)
+  | _, _ ->
+      let c = sub_extern inctx scopes vars c in
+      match c.v with
+      | CLambdaN (CLocalAssum(nal,Default bk',ty)::bl,b)
+           when binding_kind_eq bk bk' && constr_expr_eq aty ty
+                && not (occur_name na ty) (* avoid na in ty escapes scope *) ->
+         CLambdaN (CLocalAssum(make na::nal,Default bk,aty)::bl,b)
+      | CLambdaN (bl,b) ->
+         CLambdaN (CLocalAssum([make na],Default bk,aty)::bl,b)
+      | _ ->
+         CLambdaN ([CLocalAssum([make na],Default bk,aty)],c)
 
 and extern_local_binder scopes vars = function
     [] -> ([],[],[])
-  | { v = GLocalDef (na,bk,bd,ty)}::l ->
+  | b :: l ->
+    match DAst.get b with
+    | GLocalDef (na,bk,bd,ty) ->
       let (assums,ids,l) =
         extern_local_binder scopes (Name.fold_right Id.Set.add na vars) l in
       (assums,na::ids,
-       CLocalDef((Loc.tag na), extern false scopes vars bd,
+       CLocalDef(CAst.make na, extern false scopes vars bd,
                    Option.map (extern false scopes vars) ty) :: l)
 
-  | { v = GLocalAssum (na,bk,ty)}::l ->
+    | GLocalAssum (na,bk,ty) ->
       let ty = extern_typ scopes vars ty in
       (match extern_local_binder scopes (Name.fold_right Id.Set.add na vars) l with
           (assums,ids,CLocalAssum(nal,k,ty')::l)
@@ -946,21 +996,21 @@ and extern_local_binder scopes vars = function
               match na with Name id -> not (occur_var_constr_expr id ty')
                 | _ -> true ->
               (na::assums,na::ids,
-               CLocalAssum((Loc.tag na)::nal,k,ty')::l)
+               CLocalAssum(CAst.make na::nal,k,ty')::l)
         | (assums,ids,l) ->
             (na::assums,na::ids,
-             CLocalAssum([(Loc.tag na)],Default bk,ty) :: l))
+             CLocalAssum([CAst.make na],Default bk,ty) :: l))
 
-  | { v = GLocalPattern ((p,_),_,bk,ty)}::l ->
+    | GLocalPattern ((p,_),_,bk,ty) ->
       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 p = mkCPatOr (List.map (extern_cases_pattern vars) p) in
       let (assums,ids,l) = extern_local_binder scopes vars l in
-      (assums,ids, CLocalPattern(Loc.tag @@ (p,ty)) :: l)
+      (assums,ids, CLocalPattern(CAst.make @@ (p,ty)) :: l)
 
-and extern_eqn inctx scopes vars (loc,(ids,pl,c)) =
-  Loc.tag ?loc ([loc,List.map (extern_cases_pattern_in_scope scopes vars) pl],
-   extern inctx scopes vars c)
+and extern_eqn inctx scopes vars (loc,(ids,pll,c)) =
+  let pll = List.map (List.map (extern_cases_pattern_in_scope scopes vars)) pll in
+  make ?loc (pll,extern inctx scopes vars c)
 
 and extern_notation (tmp_scope,scopes as allscopes) vars t = function
   | [] -> raise No_match
@@ -969,12 +1019,12 @@ and extern_notation (tmp_scope,scopes as allscopes) vars t = function
       try
         if is_inactive_rule keyrule then raise No_match;
 	(* Adjusts to the number of arguments expected by the notation *)
-	let (t,args,argsscopes,argsimpls) = match t.v ,n with
+	let (t,args,argsscopes,argsimpls) = match DAst.get t ,n with
 	  | GApp (f,args), Some n
 	      when List.length args >= n ->
 	      let args1, args2 = List.chop n args in
               let subscopes, impls =
-                match f.v with
+                match DAst.get f with
                 | GRef (ref,us) ->
 	          let subscopes =
 		    try List.skipn n (find_arguments_scope ref)
@@ -987,19 +1037,23 @@ and extern_notation (tmp_scope,scopes as allscopes) vars t = function
                   subscopes,impls
                 | _ ->
                   [], [] in
-	      (if Int.equal n 0 then f else CAst.make @@ GApp (f,args1)),
+	      (if Int.equal n 0 then f else DAst.make @@ GApp (f,args1)),
 	      args2, subscopes, impls
-	  | GApp ({ v = GRef (ref,us) } as f, args), None ->
+	  | GApp (f, args), None ->
+            begin match DAst.get f with
+            | GRef (ref,us) ->
 	      let subscopes = find_arguments_scope ref in
 	      let impls =
 		  select_impargs_size
 		    (List.length args) (implicits_of_global ref) in
 	      f, args, subscopes, impls
-	  | GRef (ref,us), Some 0 -> CAst.make @@ GApp (t,[]), [], [], []
+            | _ -> t, [], [], []
+            end
+	  | GRef (ref,us), Some 0 -> DAst.make @@ GApp (t,[]), [], [], []
           | _, None -> t, [], [], []
           | _ -> raise No_match in
 	(* Try matching ... *)
-	let terms,termlists,binders =
+        let terms,termlists,binders,binderlists =
           match_notation_constr !print_universes t pat in
 	(* Try availability of interpretation ... *)
         let e =
@@ -1020,11 +1074,15 @@ and extern_notation (tmp_scope,scopes as allscopes) vars t = function
 		    List.map (fun (c,(scopt,scl)) ->
 		      List.map (extern true (scopt,scl@scopes') vars) c)
                       termlists in
-		  let bll =
-		    List.map (fun (bl,(scopt,scl)) ->
-		      pi3 (extern_local_binder (scopt,scl@scopes') vars bl))
+                  let bl =
+                    List.map (fun (bl,(scopt,scl)) ->
+                      mkCPatOr (List.map (extern_cases_pattern_in_scope (scopt,scl@scopes') vars) bl))
                       binders in
-	          insert_delimiters (make_notation loc ntn (l,ll,bll)) key)
+                  let bll =
+                    List.map (fun (bl,(scopt,scl)) ->
+		      pi3 (extern_local_binder (scopt,scl@scopes') vars bl))
+                      binderlists in
+                  insert_delimiters (make_notation loc ntn (l,ll,bl,bll)) key)
           | SynDefRule kn ->
 	      let l =
 		List.map (fun (c,(scopt,scl)) ->
@@ -1064,8 +1122,8 @@ let extern_constr_gen lax goal_concl_style scopt env sigma t =
   (* Not "goal_concl_style" means do alpha-conversion avoiding only *)
   (* those goal/section/rel variables that occurs in the subterm under *)
   (* consideration; see namegen.ml for further details *)
-  let avoid = if goal_concl_style then ids_of_context env else [] in
-  let r = Detyping.detype ~lax:lax goal_concl_style avoid env sigma t in
+  let avoid = if goal_concl_style then vars_of_env env else Id.Set.empty in
+  let r = Detyping.detype Detyping.Later ~lax:lax goal_concl_style avoid env sigma t in
   let vars = vars_of_env env in
   extern false (scopt,[]) vars r
 
@@ -1076,14 +1134,14 @@ let extern_constr ?(lax=false) goal_concl_style env sigma t =
   extern_constr_gen lax goal_concl_style None env sigma t
 
 let extern_type goal_concl_style env sigma t =
-  let avoid = if goal_concl_style then ids_of_context env else [] in
-  let r = Detyping.detype goal_concl_style avoid env sigma t in
+  let avoid = if goal_concl_style then vars_of_env env else Id.Set.empty in
+  let r = Detyping.detype Detyping.Later goal_concl_style avoid env sigma t in
   extern_glob_type (vars_of_env env) r
 
 let extern_sort sigma s = extern_glob_sort (detype_sort sigma s)
 
 let extern_closed_glob ?lax goal_concl_style env sigma t =
-  let avoid = if goal_concl_style then ids_of_context env else [] in
+  let avoid = if goal_concl_style then vars_of_env env else Id.Set.empty in
   let r =
     Detyping.detype_closed_glob ?lax goal_concl_style avoid env sigma t
   in
@@ -1095,9 +1153,13 @@ let extern_closed_glob ?lax goal_concl_style env sigma t =
 
 let any_any_branch =
   (* | _ => _ *)
-  Loc.tag ([],[CAst.make @@ PatVar Anonymous], CAst.make @@ GHole (Evar_kinds.InternalHole,Misctypes.IntroAnonymous,None))
+  Loc.tag ([],[DAst.make @@ PatVar Anonymous], DAst.make @@ GHole (Evar_kinds.InternalHole,Misctypes.IntroAnonymous,None))
+
+let compute_displayed_name_in_pattern sigma avoid na c =
+  let open Namegen in
+  compute_displayed_name_in_gen (fun _ -> Patternops.noccurn_pattern) sigma avoid na c
 
-let rec glob_of_pat env sigma pat = CAst.make @@ match pat with
+let rec glob_of_pat avoid env sigma pat = DAst.make @@ match pat with
   | PRef ref -> GRef (ref,None)
   | PVar id  -> GVar id
   | PEvar (evk,l) ->
@@ -1107,7 +1169,7 @@ let rec glob_of_pat env sigma pat = CAst.make @@ match pat with
       | None -> Id.of_string "__"
       | Some id -> id
       in
-      GEvar (id,List.map (on_snd (glob_of_pat env sigma)) l)
+      GEvar (id,List.map (on_snd (glob_of_pat avoid env sigma)) l)
   | PRel n ->
       let id = try match lookup_name_of_rel n env with
 	| Name id   -> id
@@ -1117,31 +1179,37 @@ let rec glob_of_pat env sigma pat = CAst.make @@ match pat with
       GVar id
   | PMeta None -> GHole (Evar_kinds.InternalHole, Misctypes.IntroAnonymous,None)
   | PMeta (Some n) -> GPatVar (Evar_kinds.FirstOrderPatVar n)
-  | PProj (p,c) -> GApp (CAst.make @@ GRef (ConstRef (Projection.constant p),None),
-			 [glob_of_pat env sigma c])
+  | PProj (p,c) -> GApp (DAst.make @@ GRef (ConstRef (Projection.constant p),None),
+			 [glob_of_pat avoid env sigma c])
   | PApp (f,args) ->
-      GApp (glob_of_pat env sigma f,Array.map_to_list (glob_of_pat env sigma) args)
+      GApp (glob_of_pat avoid env sigma f,Array.map_to_list (glob_of_pat avoid env sigma) args)
   | PSoApp (n,args) ->
-      GApp (CAst.make @@ GPatVar (Evar_kinds.SecondOrderPatVar n),
-        List.map (glob_of_pat env sigma) args)
+      GApp (DAst.make @@ GPatVar (Evar_kinds.SecondOrderPatVar n),
+        List.map (glob_of_pat avoid env sigma) args)
   | PProd (na,t,c) ->
-      GProd (na,Explicit,glob_of_pat env sigma t,glob_of_pat (na::env) sigma c)
+      let na',avoid' = compute_displayed_name_in_pattern sigma avoid na c in
+      let env' = Termops.add_name na' env in
+      GProd (na',Explicit,glob_of_pat avoid env sigma t,glob_of_pat avoid' env' sigma c)
   | PLetIn (na,b,t,c) ->
-      GLetIn (na,glob_of_pat env sigma b, Option.map (glob_of_pat env sigma) t,
-              glob_of_pat (na::env) sigma c)
+      let na',avoid' = Namegen.compute_displayed_let_name_in sigma Namegen.RenamingForGoal avoid na c in
+      let env' = Termops.add_name na' env in
+      GLetIn (na',glob_of_pat avoid env sigma b, Option.map (glob_of_pat avoid env sigma) t,
+              glob_of_pat avoid' env' sigma c)
   | PLambda (na,t,c) ->
-      GLambda (na,Explicit,glob_of_pat env sigma t, glob_of_pat (na::env) sigma c)
+      let na',avoid' = compute_displayed_name_in_pattern sigma avoid na c in
+      let env' = Termops.add_name na' env in
+      GLambda (na',Explicit,glob_of_pat avoid env sigma t, glob_of_pat avoid' env' sigma c)
   | PIf (c,b1,b2) ->
-      GIf (glob_of_pat env sigma c, (Anonymous,None),
-           glob_of_pat env sigma b1, glob_of_pat env sigma b2)
+      GIf (glob_of_pat avoid env sigma c, (Anonymous,None),
+           glob_of_pat avoid env sigma b1, glob_of_pat avoid env sigma b2)
   | PCase ({cip_style=LetStyle; cip_ind_tags=None},PMeta None,tm,[(0,n,b)]) ->
-      let nal,b = it_destRLambda_or_LetIn_names n (glob_of_pat env sigma b) in
-      GLetTuple (nal,(Anonymous,None),glob_of_pat env sigma tm,b)
+      let nal,b = it_destRLambda_or_LetIn_names n (glob_of_pat avoid env sigma b) in
+      GLetTuple (nal,(Anonymous,None),glob_of_pat avoid env sigma tm,b)
   | PCase (info,p,tm,bl) ->
       let mat = match bl, info.cip_ind with
 	| [], _ -> []
 	| _, Some ind ->
-	  let bl' = List.map (fun (i,n,c) -> (i,n,glob_of_pat env sigma c)) bl in
+	  let bl' = List.map (fun (i,n,c) -> (i,n,glob_of_pat avoid env sigma c)) bl in
 	  simple_cases_matrix_of_branches ind bl'
 	| _, None -> anomaly (Pp.str "PCase with some branches but unknown inductive.")
       in
@@ -1150,19 +1218,19 @@ let rec glob_of_pat env sigma pat = CAst.make @@ match pat with
       let indnames,rtn = match p, info.cip_ind, info.cip_ind_tags with
 	| PMeta None, _, _ -> (Anonymous,None),None
 	| _, Some ind, Some nargs ->
-	  return_type_of_predicate ind nargs (glob_of_pat env sigma p)
+	  return_type_of_predicate ind nargs (glob_of_pat avoid env sigma p)
 	| _ -> anomaly (Pp.str "PCase with non-trivial predicate but unknown inductive.")
       in
-      GCases (RegularStyle,rtn,[glob_of_pat env sigma tm,indnames],mat)
-  | PFix f -> (Detyping.detype_names false [] env (Global.env()) sigma (EConstr.of_constr (mkFix f))).v (** FIXME bad env *)
-  | PCoFix c -> (Detyping.detype_names false [] env (Global.env()) sigma (EConstr.of_constr (mkCoFix c))).v
+      GCases (RegularStyle,rtn,[glob_of_pat avoid env sigma tm,indnames],mat)
+  | PFix f -> DAst.get (Detyping.detype_names false avoid env (Global.env()) sigma (EConstr.of_constr (mkFix f))) (** FIXME bad env *)
+  | PCoFix c -> DAst.get (Detyping.detype_names false avoid env (Global.env()) sigma (EConstr.of_constr (mkCoFix c)))
   | PSort s -> GSort s
 
 let extern_constr_pattern env sigma pat =
-  extern true (None,[]) Id.Set.empty (glob_of_pat env sigma pat)
+  extern true (None,[]) Id.Set.empty (glob_of_pat Id.Set.empty 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 a = detype_rel_context Detyping.Later where Id.Set.empty (names_of_rel_context env,env) sigma sign in
   let vars = vars_of_env env in
   let a = List.map (extended_glob_local_binder_of_decl) a in
   pi3 (extern_local_binder (None,[]) vars a)
diff --git a/interp/constrextern.mli b/interp/constrextern.mli
index ffa891c50..51b06580e 100644
--- a/interp/constrextern.mli
+++ b/interp/constrextern.mli
@@ -7,7 +7,6 @@
 (************************************************************************)
 
 open Names
-open Term
 open Termops
 open EConstr
 open Environ
@@ -19,13 +18,14 @@ open Constrexpr
 open Notation_term
 open Notation
 open Misctypes
+open Ltac_pretype
 
 (** Translation of pattern, cases pattern, glob_constr and term into syntax
    trees for printing *)
 
-val extern_cases_pattern : Id.Set.t -> cases_pattern -> cases_pattern_expr
-val extern_glob_constr : Id.Set.t -> glob_constr -> constr_expr
-val extern_glob_type : Id.Set.t -> glob_constr -> constr_expr
+val extern_cases_pattern : Id.Set.t -> 'a cases_pattern_g -> cases_pattern_expr
+val extern_glob_constr : Id.Set.t -> 'a glob_constr_g -> constr_expr
+val extern_glob_type : Id.Set.t -> 'a glob_constr_g -> constr_expr
 val extern_constr_pattern : names_context -> Evd.evar_map ->
   constr_pattern -> constr_expr
 val extern_closed_glob : ?lax:bool -> bool -> env -> Evd.evar_map -> closed_glob_constr -> constr_expr
@@ -40,7 +40,7 @@ val extern_constr : ?lax:bool -> bool -> env -> Evd.evar_map -> constr -> constr
 val extern_constr_in_scope : bool -> scope_name -> env -> Evd.evar_map -> constr -> constr_expr
 val extern_reference : ?loc:Loc.t -> Id.Set.t -> global_reference -> reference
 val extern_type : bool -> env -> Evd.evar_map -> types -> constr_expr
-val extern_sort : Evd.evar_map -> sorts -> glob_sort
+val extern_sort : Evd.evar_map -> Sorts.t -> glob_sort
 val extern_rel_context : constr option -> env -> Evd.evar_map ->
   rel_context -> local_binder_expr list
 
@@ -60,6 +60,19 @@ val set_extern_reference :
 val get_extern_reference :
   unit -> (?loc:Loc.t -> Id.Set.t -> global_reference -> reference)
 
+(** WARNING: The following functions are evil due to
+    side-effects. Think of the following case as used in the printer:
+
+    without_specific_symbols [SynDefRule kn] (pr_glob_constr_env env) c
+
+    vs
+
+    without_specific_symbols [SynDefRule kn] pr_glob_constr_env env c
+
+    which one is wrong? We should turn this kind of state into an
+    explicit argument.
+*)
+
 (** This forces printing universe names of Type\{.\} *)
 val with_universes : ('a -> 'b) -> 'a -> 'b
 
diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index e465677cd..d03aa3552 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -9,13 +9,13 @@
 open Pp
 open CErrors
 open Util
+open CAst
 open Names
 open Nameops
 open Namegen
 open Libnames
 open Globnames
 open Impargs
-open CAst
 open Glob_term
 open Glob_ops
 open Patternops
@@ -25,7 +25,6 @@ open Constrexpr
 open Constrexpr_ops
 open Notation_term
 open Notation_ops
-open Topconstr
 open Nametab
 open Notation
 open Inductiveops
@@ -123,7 +122,7 @@ type internalization_error =
 exception InternalizationError of internalization_error Loc.located
 
 let explain_variable_capture id id' =
-  pr_id id ++ str " is dependent in the type of " ++ pr_id id' ++
+  Id.print id ++ str " is dependent in the type of " ++ Id.print id' ++
   strbrk ": cannot interpret both of them with the same type"
 
 let explain_illegal_metavariable =
@@ -133,12 +132,12 @@ let explain_not_a_constructor ref =
   str "Unknown constructor: " ++ pr_reference ref
 
 let explain_unbound_fix_name is_cofix id =
-  str "The name" ++ spc () ++ pr_id id ++
+  str "The name" ++ spc () ++ Id.print id ++
   spc () ++ str "is not bound in the corresponding" ++ spc () ++
   str (if is_cofix then "co" else "") ++ str "fixpoint definition"
 
 let explain_non_linear_pattern id =
-  str "The variable " ++ pr_id id ++ str " is bound several times in pattern"
+  str "The variable " ++ Id.print id ++ str " is bound several times in pattern"
 
 let explain_bad_patterns_number n1 n2 =
   str "Expecting " ++ int n1 ++ str (String.plural n1 " pattern") ++
@@ -164,7 +163,7 @@ let error_parameter_not_implicit ?loc =
     "they must be replaced by '_'.")
 
 let error_ldots_var ?loc =
-  user_err ?loc  (str "Special token " ++ pr_id ldots_var ++
+  user_err ?loc  (str "Special token " ++ Id.print ldots_var ++
     str " is for use in the Notation command.")
 
 (**********************************************************************)
@@ -215,20 +214,20 @@ let expand_notation_string ntn n =
 
 (* This contracts the special case of "{ _ }" for sumbool, sumor notations *)
 (* Remark: expansion of squash at definition is done in metasyntax.ml *)
-let contract_notation ntn (l,ll,bll) =
+let contract_curly_brackets ntn (l,ll,bl,bll) =
   let ntn' = ref ntn in
   let rec contract_squash n = function
     | [] -> []
-    | { CAst.v = CNotation ("{ _ }",([a],[],[])) } :: l ->
+    | { CAst.v = CNotation ("{ _ }",([a],[],[],[])) } :: l ->
         ntn' := expand_notation_string !ntn' n;
         contract_squash n (a::l)
     | a :: l ->
         a::contract_squash (n+1) l in
   let l = contract_squash 0 l in
   (* side effect; don't inline *)
-  !ntn',(l,ll,bll)
+  !ntn',(l,ll,bl,bll)
 
-let contract_pat_notation ntn (l,ll) =
+let contract_curly_brackets_pat ntn (l,ll) =
   let ntn' = ref ntn in
   let rec contract_squash n = function
     | [] -> []
@@ -264,38 +263,33 @@ let pr_scope_stack = function
 
 let error_inconsistent_scope ?loc id scopes1 scopes2 =
   user_err ?loc ~hdr:"set_var_scope"
-   (pr_id id ++ str " is here used in " ++
+   (Id.print 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 
-   (pr_id id ++
+   (Id.print id ++
     str " is expected to occur in binding position in the right-hand side.")
 
-let set_var_scope ?loc id istermvar env ntnvars =
+let set_var_scope ?loc id istermvar (tmp_scope,subscopes as scopes) ntnvars =
   try
-    let isonlybinding,idscopes,typ = Id.Map.find id ntnvars in
-    if istermvar then isonlybinding := false;
+    let used_as_binder,idscopes,typ = Id.Map.find id ntnvars in
+    if not istermvar then used_as_binder := true;
     let () = if istermvar then
       (* scopes have no effect on the interpretation of identifiers *)
       begin match !idscopes with
-      | None -> idscopes := Some (env.tmp_scope, env.scopes)
-      | 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
+      | None -> idscopes := Some scopes
+      | Some (tmp_scope', subscopes') ->
+        let s' = make_current_scope tmp_scope' subscopes' in
+        let s = make_current_scope tmp_scope subscopes in
+        if not (List.equal String.equal s' s) then error_inconsistent_scope ?loc id s' s
       end
     in
     match typ with
-    | NtnInternTypeBinder ->
+    | Notation_term.NtnInternTypeOnlyBinder ->
 	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:
-	   if not istermvar then error_expect_constr_notation_type loc id *)
-	()
-    | NtnInternTypeIdent -> ()
+    | Notation_term.NtnInternTypeAny -> ()
   with Not_found ->
     (* Not in a notation *)
     ()
@@ -304,15 +298,11 @@ let set_type_scope env = {env with tmp_scope = Notation.current_type_scope_name
 
 let reset_tmp_scope env = {env with tmp_scope = None}
 
-let rec it_mkGProd ?loc env body =
-  match env with
-      (loc2, (na, bk, t)) :: tl -> it_mkGProd ?loc:loc2 tl (CAst.make ?loc:(Loc.merge_opt loc loc2) @@ GProd (na, bk, t, body))
-    | [] -> body
+let set_env_scopes env (scopt,subscopes) =
+  {env with tmp_scope = scopt; scopes = subscopes @ env.scopes}
 
-let rec it_mkGLambda ?loc env body =
-  match env with
-      (loc2, (na, bk, t)) :: tl -> it_mkGLambda ?loc:loc2 tl (CAst.make ?loc:(Loc.merge_opt loc loc2) @@ GLambda (na, bk, t, body))
-    | [] -> body
+let mkGProd ?loc (na,bk,t) body = DAst.make ?loc @@ GProd (na, bk, t, body)
+let mkGLambda ?loc (na,bk,t) body = DAst.make ?loc @@ GLambda (na, bk, t, body)
 
 (**********************************************************************)
 (* Utilities for binders                                              *)
@@ -323,15 +313,15 @@ let build_impls = function
   |Explicit -> fun _ -> None
 
 let impls_type_list ?(args = []) =
-  let rec aux acc = function
-    | { v = GProd (na,bk,_,c) } -> aux ((build_impls bk na)::acc) c
+  let rec aux acc c = match DAst.get c with
+    | GProd (na,bk,_,c) -> aux ((build_impls bk na)::acc) c
     | _ -> (Variable,[],List.append args (List.rev acc),[])
   in aux []
 
 let impls_term_list ?(args = []) =
-  let rec aux acc = function
-    | { v = GLambda (na,bk,_,c) } -> aux ((build_impls bk na)::acc) c
-    | { v = GRec (fix_kind, nas, args, tys, bds) } ->
+  let rec aux acc c = match DAst.get c with
+    | GLambda (na,bk,_,c) -> aux ((build_impls bk na)::acc) c
+    | GRec (fix_kind, nas, args, tys, bds) ->
        let nb = match fix_kind with |GFix (_, n) -> n | GCoFix n -> n in
        let acc' = List.fold_left (fun a (na, bk, _, _) -> (build_impls bk na)::a) acc args.(nb) in
 	 aux acc' bds.(nb)
@@ -339,22 +329,22 @@ let impls_term_list ?(args = []) =
   in aux []
 
 (* Check if in binder "(x1 x2 .. xn : t)", none of x1 .. xn-1 occurs in t *)
-let rec check_capture ty = function
-  | (loc,Name id)::(_,Name id')::_ when occur_glob_constr id ty ->
+let rec check_capture ty = let open CAst in function
+  | { loc; v = Name id } :: { v = Name id' } :: _ when occur_glob_constr id ty ->
       raise (InternalizationError (loc,VariableCapture (id,id')))
   | _::nal ->
       check_capture ty nal
   | [] ->
       ()
 
-let locate_if_hole ?loc na = function
-  | { v = GHole (_,naming,arg) } ->
+let locate_if_hole ?loc na c = match DAst.get c with
+  | GHole (_,naming,arg) ->
       (try match na with
 	| Name id -> glob_constr_of_notation_constr ?loc
 	               (Reserve.find_reserved_type id)
 	| Anonymous -> raise Not_found
-      with Not_found -> CAst.make ?loc @@ GHole (Evar_kinds.BinderType na, naming, arg))
-  | x -> x
+      with Not_found -> DAst.make ?loc @@ GHole (Evar_kinds.BinderType na, naming, arg))
+  | _ -> c
 
 let reset_hidden_inductive_implicit_test env =
   { env with impls = Id.Map.map (function
@@ -366,27 +356,28 @@ let check_hidden_implicit_parameters ?loc id impls =
     | (Inductive (indparams,check),_,_,_) when check -> Id.List.mem id indparams
     | _ -> false) impls
   then
-    user_err ?loc (pr_id id ++ strbrk " is already used as name of " ++
+    user_err ?loc (Id.print id ++ strbrk " is already used as name of " ++
       strbrk "a parameter of the inductive type; bound variables in " ++
       strbrk "the type of a constructor shall use a different name.")
 
 let push_name_env ?(global_level=false) ntnvars implargs env =
+  let open CAst in
   function
-  | loc,Anonymous ->
+  | { loc; v = Anonymous } ->
       if global_level then
 	user_err ?loc (str "Anonymous variables not allowed");
       env
-  | loc,Name id ->
+  | { loc; v = Name id } ->
       check_hidden_implicit_parameters ?loc id env.impls ;
       if Id.Map.is_empty ntnvars && Id.equal id ldots_var
         then error_ldots_var ?loc;
-      set_var_scope ?loc id false env ntnvars;
-      if global_level then Dumpglob.dump_definition (loc,id) true "var"
+      set_var_scope ?loc id false (env.tmp_scope,env.scopes) ntnvars;
+      if global_level then Dumpglob.dump_definition CAst.(make ?loc id) true "var"
       else Dumpglob.dump_binding ?loc id;
       {env with ids = Id.Set.add id env.ids; impls = Id.Map.add id implargs env.impls}
 
-let intern_generalized_binder ?(global_level=false) intern_type lvar
-    env (loc, na) b b' t ty =
+let intern_generalized_binder ?(global_level=false) intern_type ntnvars
+    env {loc;v=na} b b' t ty =
   let ids = (match na with Anonymous -> fun x -> x | Name na -> Id.Set.add na) env.ids in
   let ty, ids' =
     if t then ty, ids else
@@ -396,11 +387,11 @@ let intern_generalized_binder ?(global_level=false) intern_type lvar
   let ty' = intern_type {env with ids = ids; unb = true} ty in
   let fvs = Implicit_quantifiers.generalizable_vars_of_glob_constr ~bound:ids ~allowed:ids' ty' in
   let env' = List.fold_left
-    (fun env (l, x) -> push_name_env ~global_level lvar (Variable,[],[],[])(*?*) env (l, Name x))
+    (fun env {loc;v=x} -> push_name_env ~global_level ntnvars (Variable,[],[],[])(*?*) env (make ?loc @@ Name x))
     env fvs in
   let bl = List.map
-    (fun (loc, id) ->
-      (loc, (Name id, b, CAst.make ?loc @@ GHole (Evar_kinds.BinderType (Name id), Misctypes.IntroAnonymous, None))))
+    CAst.(map (fun id ->
+      (Name id, b, DAst.make ?loc @@ GHole (Evar_kinds.BinderType (Name id), Misctypes.IntroAnonymous, None))))
     fvs
   in
   let na = match na with
@@ -415,9 +406,9 @@ let intern_generalized_binder ?(global_level=false) intern_type lvar
 	    in Implicit_quantifiers.make_fresh ids' (Global.env ()) id
 	  in Name name
     | _ -> na
-  in (push_name_env ~global_level lvar (impls_type_list ty')(*?*) env' (loc,na)), (loc,(na,b',ty')) :: List.rev bl
+  in (push_name_env ~global_level ntnvars (impls_type_list ty')(*?*) env' (make ?loc na)), (make ?loc (na,b',ty')) :: List.rev bl
 
-let intern_assumption intern lvar env nal bk ty =
+let intern_assumption intern ntnvars env nal bk ty =
   let intern_type env = intern (set_type_scope env) in
   match bk with
   | Default k ->
@@ -425,19 +416,19 @@ let intern_assumption intern lvar env nal bk ty =
       check_capture ty nal;
       let impls = impls_type_list ty in
       List.fold_left
-	(fun (env, bl) (loc, na as locna) ->
-          (push_name_env lvar impls env locna,
-           (Loc.tag ?loc (na,k,locate_if_hole ?loc na ty))::bl))
+        (fun (env, bl) ({loc;v=na} as locna) ->
+          (push_name_env ntnvars impls env locna,
+           (make ?loc (na,k,locate_if_hole ?loc na ty))::bl))
 	(env, []) nal
   | Generalized (b,b',t) ->
-     let env, b = intern_generalized_binder intern_type lvar env (List.hd nal) b b' t ty in
+     let env, b = intern_generalized_binder intern_type ntnvars env (List.hd nal) b b' t ty in
      env, b
 
-let glob_local_binder_of_extended = CAst.with_loc_val (fun ?loc -> function
+let glob_local_binder_of_extended = DAst.with_loc_val (fun ?loc -> function
   | GLocalAssum (na,bk,t) -> (na,bk,None,t)
   | GLocalDef (na,bk,c,Some t) -> (na,bk,Some c,t)
   | GLocalDef (na,bk,c,None) ->
-      let t = CAst.make ?loc @@ GHole(Evar_kinds.BinderType na,Misctypes.IntroAnonymous,None) in
+      let t = DAst.make ?loc @@ GHole(Evar_kinds.BinderType na,Misctypes.IntroAnonymous,None) in
       (na,bk,Some c,t)
   | GLocalPattern (_,_,_,_) ->
       Loc.raise ?loc (Stream.Error "pattern with quote not allowed here.")
@@ -445,40 +436,48 @@ let glob_local_binder_of_extended = CAst.with_loc_val (fun ?loc -> function
 
 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
+let intern_letin_binder intern ntnvars env (({loc;v=na} as locna),def,ty) =
+  let term = intern env def in
+  let ty = Option.map (intern env) ty in
+  (push_name_env ntnvars (impls_term_list term) env locna,
+   (na,Explicit,term,ty))
+
+let intern_cases_pattern_as_binder ?loc ntnvars env p =
+  let il,disjpat =
+    let (il, subst_disjpat) = !intern_cases_pattern_fwd ntnvars (None,env.scopes) p in
+    let substl,disjpat = List.split subst_disjpat in
+    if not (List.for_all (fun subst -> Id.Map.equal Id.equal subst Id.Map.empty) substl) then
+      user_err ?loc (str "Unsupported nested \"as\" clause.");
+    il,disjpat
+  in
+  let env = List.fold_right (fun {loc;v=id} env -> push_name_env ntnvars (Variable,[],[],[]) env (make ?loc @@ Name id)) il env in
+  let na = alias_of_pat (List.hd disjpat) in
+  let ienv = Name.fold_right Id.Set.remove na env.ids in
+  let id = Namegen.next_name_away_with_default "pat" na ienv in
+  let na = make ?loc @@ Name id in
+  env,((disjpat,il),id),na
+
+let intern_local_binder_aux ?(global_level=false) intern ntnvars (env,bl) = function
   | CLocalAssum(nal,bk,ty) ->
-      let env, bl' = intern_assumption intern lvar env nal bk ty in
-      let bl' = List.map (fun (loc,(na,c,t)) -> CAst.make ?loc @@ GLocalAssum (na,c,t)) bl' in
+      let env, bl' = intern_assumption intern ntnvars env nal bk ty in
+      let bl' = List.map (fun {loc;v=(na,c,t)} -> DAst.make ?loc @@ GLocalAssum (na,c,t)) bl' in
       env, bl' @ bl
-  | CLocalDef((loc,na as locna),def,ty) ->
-     let term = intern env def in
-     let ty = Option.map (intern env) ty in
-      (push_name_env lvar (impls_term_list term) env locna,
-       (CAst.make ?loc @@ GLocalDef (na,Explicit,term,ty)) :: bl)
-  | CLocalPattern (loc,(p,ty)) ->
+  | CLocalDef( {loc; v=na} as locna,def,ty) ->
+     let env,(na,bk,def,ty) = intern_letin_binder intern ntnvars env (locna,def,ty) in
+     env, (DAst.make ?loc @@ GLocalDef (na,bk,def,ty)) :: bl
+  | CLocalPattern {loc;v=(p,ty)} ->
       let tyc =
         match ty with
         | Some ty -> ty
         | None -> CAst.make ?loc @@ CHole(None,Misctypes.IntroAnonymous,None)
       in
-      let il,cp =
-        match !intern_cases_pattern_fwd (None,env.scopes) p with
-        | (il, [(subst,cp)]) ->
-           if not (Id.Map.equal Id.equal subst Id.Map.empty) then
-             user_err ?loc (str "Unsupported nested \"as\" clause.");
-           il,cp
-        | _ -> assert false
-      in
-      let env = {env with ids = List.fold_right Id.Set.add il env.ids} in
-      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 env, ((disjpat,il),id),na = intern_cases_pattern_as_binder ?loc ntnvars env p in
       let bk = Default Explicit in
-      let _, bl' = intern_assumption intern lvar env [na] bk tyc in
-      let _,(_,bk,t) = List.hd bl' in
-      (env, (CAst.make ?loc @@ GLocalPattern((cp,il),id,bk,t)) :: bl)
+      let _, bl' = intern_assumption intern ntnvars env [na] bk tyc in
+      let {v=(_,bk,t)} = List.hd bl' in
+      (env, (DAst.make ?loc @@ GLocalPattern((disjpat,List.map (fun x -> x.v) il),id,bk,t)) :: bl)
 
-let intern_generalization intern env lvar loc bk ak c =
+let intern_generalization intern env ntnvars loc bk ak c =
   let c = intern {env with unb = true} c in
   let fvs = Implicit_quantifiers.generalizable_vars_of_glob_constr ~bound:env.ids c in
   let env', c' =
@@ -498,19 +497,35 @@ let intern_generalization intern env lvar loc bk ak c =
           | None -> false
       in
 	if pi then
-	  (fun (loc', id) acc ->
-            CAst.make ?loc:(Loc.merge_opt loc' loc) @@
-	    GProd (Name id, bk, CAst.make ?loc:loc' @@ GHole (Evar_kinds.BinderType (Name id), Misctypes.IntroAnonymous, None), acc))
+          (fun {loc=loc';v=id} acc ->
+            DAst.make ?loc:(Loc.merge_opt loc' loc) @@
+	    GProd (Name id, bk, DAst.make ?loc:loc' @@ GHole (Evar_kinds.BinderType (Name id), Misctypes.IntroAnonymous, None), acc))
 	else
-	  (fun (loc', id) acc ->
-            CAst.make ?loc:(Loc.merge_opt loc' loc) @@
-	    GLambda (Name id, bk, CAst.make ?loc:loc' @@ GHole (Evar_kinds.BinderType (Name id), Misctypes.IntroAnonymous, None), acc))
+          (fun {loc=loc';v=id} acc ->
+            DAst.make ?loc:(Loc.merge_opt loc' loc) @@
+	    GLambda (Name id, bk, DAst.make ?loc:loc' @@ GHole (Evar_kinds.BinderType (Name id), Misctypes.IntroAnonymous, None), acc))
     in
-      List.fold_right (fun (loc, id as lid) (env, acc) ->
-	let env' = push_name_env lvar (Variable,[],[],[]) env (loc, Name id) in
+      List.fold_right (fun ({loc;v=id} as lid) (env, acc) ->
+        let env' = push_name_env ntnvars (Variable,[],[],[]) env CAst.(make @@ Name id) in
 	  (env', abs lid acc)) fvs (env,c)
   in c'
 
+let rec expand_binders ?loc mk bl c =
+  match bl with
+  | [] -> c
+  | b :: bl ->
+     match DAst.get b with
+     | GLocalDef (n, bk, b, oty) ->
+        expand_binders ?loc mk bl (DAst.make ?loc @@ GLetIn (n, b, oty, c))
+     | GLocalAssum (n, bk, t) ->
+        expand_binders ?loc mk bl (mk ?loc (n,bk,t) c)
+     | GLocalPattern ((disjpat,ids), id, bk, ty) ->
+        let tm = DAst.make ?loc (GVar id) in
+        (* Distribute the disjunctive patterns over the shared right-hand side *)
+        let eqnl = List.map (fun pat -> (loc,(ids,[pat],c))) disjpat in
+        let c = DAst.make ?loc @@ GCases (Misctypes.LetPatternStyle, None, [tm,(Anonymous,None)], eqnl) in
+        expand_binders ?loc mk bl (mk ?loc (Name id,Explicit,ty) c)
+
 (**********************************************************************)
 (* Syntax extensions                                                  *)
 
@@ -518,7 +533,7 @@ let option_mem_assoc id = function
   | Some (id',c) -> Id.equal id id'
   | None -> false
 
-let find_fresh_name renaming (terms,termlists,binders) avoid id =
+let find_fresh_name renaming (terms,termlists,binders,binderlists) avoid id =
   let fold1 _ (c, _) accu = Id.Set.union (free_vars_of_constr_expr c) accu in
   let fold2 _ (l, _) accu =
     let fold accu c = Id.Set.union (free_vars_of_constr_expr c) accu in
@@ -531,13 +546,53 @@ let find_fresh_name renaming (terms,termlists,binders) avoid id =
   (* TODO binders *)
   next_ident_away_from id (fun id -> Id.Set.mem id fvs3)
 
-let traverse_binder (terms,_,_ as subst) avoid (renaming,env) = function
- | Anonymous -> (renaming,env),Anonymous
+let is_var store pat =
+  match DAst.get pat with
+  | PatVar na -> store na; true
+  | _ -> false
+
+let out_var pat =
+  match pat.CAst.v with
+  | CPatAtom (Some (Ident (_,id))) -> Name id
+  | CPatAtom None -> Anonymous
+  | _ -> assert false
+
+let term_of_name = function
+  | Name id -> DAst.make (GVar id)
+  | Anonymous ->
+       let st = Evar_kinds.Define (not (Program.get_proofs_transparency ())) in
+       DAst.make (GHole (Evar_kinds.QuestionMark (st,Anonymous), Misctypes.IntroAnonymous, None))
+
+let traverse_binder intern_pat ntnvars (terms,_,binders,_ as subst) avoid (renaming,env) = function
+ | Anonymous -> (renaming,env), None, Anonymous
  | Name id ->
+  let store,get = set_temporary_memory () in
   try
-    (* Binders bound in the notation are considered first-order objects *)
-    let _,na = coerce_to_name (fst (Id.Map.find id terms)) in
-    (renaming,{env with ids = Name.fold_right Id.Set.add na env.ids}), na
+    (* We instantiate binder name with patterns which may be parsed as terms *)
+    let pat = coerce_to_cases_pattern_expr (fst (Id.Map.find id terms)) in
+    let env,((disjpat,ids),id),na = intern_pat ntnvars env pat in
+    let pat, na = match disjpat with
+    | [pat] when is_var store pat -> let na = get () in None, na
+    | _ -> Some ((List.map (fun x -> x.v) ids,disjpat),id), na.v in
+    (renaming,env), pat, na
+  with Not_found ->
+  try
+    (* Trying to associate a pattern *)
+    let pat,(onlyident,scopes) = Id.Map.find id binders in
+    let env = set_env_scopes env scopes in
+    if onlyident then
+      (* Do not try to interpret a variable as a constructor *)
+      let na = out_var pat in
+      let env = push_name_env ntnvars (Variable,[],[],[]) env (make ?loc:pat.loc na) in
+      (renaming,env), None, na
+    else
+      (* Interpret as a pattern *)
+      let env,((disjpat,ids),id),na = intern_pat ntnvars env pat in
+      let pat, na =
+        match disjpat with
+        | [pat] when is_var store pat -> let na = get () in None, na
+        | _ -> Some ((List.map (fun x -> x.v) ids,disjpat),id), na.v in
+      (renaming,env), pat, na
   with Not_found ->
     (* Binders not bound in the notation do not capture variables *)
     (* outside the notation (i.e. in the substitution) *)
@@ -545,90 +600,101 @@ let traverse_binder (terms,_,_ as subst) avoid (renaming,env) = function
     let renaming' =
       if Id.equal id id' then renaming else Id.Map.add id id' renaming
     in
-    (renaming',env), Name id'
-
-type letin_param_r =
-  | LPLetIn of Name.t * glob_constr * glob_constr option
-  | LPCases of (cases_pattern * Id.t list) * Id.t
-(* Unused thus fatal warning *)
-(* and letin_param = letin_param_r Loc.located *)
-
-let make_letins =
-  List.fold_right
-    (fun a c ->
-     match a with
-     | loc, LPLetIn (na,b,t) ->
-       CAst.make ?loc @@ GLetIn(na,b,t,c)
-     | loc, LPCases ((cp,il),id) ->
-         let tt = (CAst.make ?loc @@ GVar id, (Name id,None)) in
-         CAst.make ?loc @@ GCases(Misctypes.LetPatternStyle,None,[tt],[(loc,(il,[cp],c))]))
-
-let rec subordinate_letins 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; v = GLocalDef (na,_,b,t) }::l ->
-      subordinate_letins ((Loc.tag ?loc @@ LPLetIn (na,b,t))::letins) l
-  | { loc; v = GLocalAssum (na,bk,t)}::l ->
-      let letins',rest = subordinate_letins [] l in
-      letins',((loc,(na,bk,t)),letins)::rest
-  | { loc; v = GLocalPattern (u,id,bk,t)} :: l ->
-      subordinate_letins ((Loc.tag ?loc @@ LPCases (u,id))::letins)
-                          ([CAst.make ?loc @@ GLocalAssum (Name id,bk,t)] @ l)
-  | [] ->
-      letins,[]
+    (renaming',env), None, Name id'
+
+type binder_action =
+| AddLetIn of Misctypes.lname * constr_expr * constr_expr option
+| AddTermIter of (constr_expr * subscopes) Names.Id.Map.t
+| AddPreBinderIter of Id.t * local_binder_expr (* A binder to be internalized *)
+| AddBinderIter of Id.t * extended_glob_local_binder (* A binder already internalized - used for generalized binders *)
+
+let dmap_with_loc f n =
+  CAst.map_with_loc (fun ?loc c -> f ?loc (DAst.get_thunk c)) n
+
+let error_cannot_coerce_wildcard_term ?loc () =
+  user_err ?loc Pp.(str "Cannot turn \"_\" into a term.")
+
+let error_cannot_coerce_disjunctive_pattern_term ?loc () =
+  user_err ?loc Pp.(str "Cannot turn a disjunctive pattern into a term.")
 
 let terms_of_binders bl =
-  let rec term_of_pat pt = CAst.map_with_loc (fun ?loc -> function
+  let rec term_of_pat pt = dmap_with_loc (fun ?loc -> function
     | PatVar (Name id)   -> CRef (Ident (loc,id), None)
-    | PatVar (Anonymous) -> user_err Pp.(str "Cannot turn \"_\" into a term.")
+    | PatVar (Anonymous) -> error_cannot_coerce_wildcard_term ?loc ()
     | PatCstr (c,l,_) ->
        let r = Qualid (loc,qualid_of_path (path_of_global (ConstructRef c))) in
        let hole = CAst.make ?loc @@ CHole (None,Misctypes.IntroAnonymous,None) in
        let params = List.make (Inductiveops.inductive_nparams (fst c)) hole in
        CAppExpl ((None,r,None),params @ List.map term_of_pat l)) pt in
-  let rec extract_variables = function
-    | {loc; v = GLocalAssum (Name id,_,_)}::l -> (CAst.make ?loc @@ CRef (Ident (loc,id), None)) :: extract_variables l
-    | {loc; v = GLocalDef (Name id,_,_,_)}::l -> extract_variables l
-    | {loc; v = GLocalDef (Anonymous,_,_,_)}::l
-    | {loc; v = GLocalAssum (Anonymous,_,_)}::l -> user_err Pp.(str "Cannot turn \"_\" into a term.")
-    | {loc; v = GLocalPattern ((u,_),_,_,_)}::l -> term_of_pat u :: extract_variables l
+  let rec extract_variables l = match l with
+    | bnd :: l ->
+      let loc = bnd.CAst.loc in
+      begin match DAst.get bnd with
+      | GLocalAssum (Name id,_,_) -> (CAst.make ?loc @@ CRef (Ident (loc,id), None)) :: extract_variables l
+      | GLocalDef (Name id,_,_,_) -> extract_variables l
+      | GLocalDef (Anonymous,_,_,_)
+      | GLocalAssum (Anonymous,_,_) -> user_err Pp.(str "Cannot turn \"_\" into a term.")
+      | GLocalPattern (([u],_),_,_,_) -> term_of_pat u :: extract_variables l
+      | GLocalPattern ((_,_),_,_,_) -> error_cannot_coerce_disjunctive_pattern_term ?loc ()
+      end
     | [] -> [] in
   extract_variables bl
 
-let instantiate_notation_constr loc intern ntnvars subst infos c =
-  let (terms,termlists,binders) = subst in
+let flatten_generalized_binders_if_any y l =
+  match List.rev l with
+  | [] -> assert false
+  | a::l -> a, List.map (fun a -> AddBinderIter (y,a)) l (* if l not empty, this means we had a generalized binder *)
+
+let flatten_binders bl =
+  let dispatch = function
+    | CLocalAssum (nal,bk,t) -> List.map (fun na -> CLocalAssum ([na],bk,t)) nal
+    | a -> [a] in
+  List.flatten (List.map dispatch bl)
+
+let instantiate_notation_constr loc intern intern_pat ntnvars subst infos c =
+  let (terms,termlists,binders,binderlists) = 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,terminopt as subst') (renaming,env) c =
+  let rec aux (terms,binderopt,iteropt 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 when Id.equal id ldots_var ->
+        let rec aux_letin env = function
+        | [],terminator,_ -> aux (terms,None,None) (renaming,env) terminator
+        | AddPreBinderIter (y,binder)::rest,terminator,iter ->
+           let env,binders = intern_local_binder_aux intern ntnvars (env,[]) binder in
+           let binder,extra = flatten_generalized_binders_if_any y binders in
+           aux (terms,Some (y,binder),Some (extra@rest,terminator,iter)) (renaming,env) iter
+        | AddBinderIter (y,binder)::rest,terminator,iter ->
+           aux (terms,Some (y,binder),Some (rest,terminator,iter)) (renaming,env) iter
+        | AddTermIter nterms::rest,terminator,iter ->
+           aux (nterms,None,Some (rest,terminator,iter)) (renaming,env) iter
+        | AddLetIn (na,c,t)::rest,terminator,iter ->
+           let env,(na,_,c,t) = intern_letin_binder intern ntnvars env (na,c,t) in
+           DAst.make ?loc (GLetIn (na,c,t,aux_letin env (rest,terminator,iter))) in
+        aux_letin env (Option.get iteropt)
     | NVar id -> subst_var subst' (renaming, env) id
-    | NList (x,y,iter,terminator,lassoc) ->
+    | NList (x,y,iter,terminator,revert) ->
       let l,(scopt,subscopes) =
         (* All elements of the list are in scopes (scopt,subscopes) *)
         try
           let l,scopes = Id.Map.find x termlists in
-          (if lassoc then List.rev l else l),scopes
+          (if revert then List.rev l else l),scopes
         with Not_found ->
         try
-	  let (bl,(scopt,subscopes)) = Id.Map.find x binders in
+          let (bl,(scopt,subscopes)) = Id.Map.find x binderlists 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,[])
+          terms_of_binders (if revert 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
+      let l = List.map (fun a -> AddTermIter ((Id.Map.add y (a,(scopt,subscopes)) terms))) l in
+      aux (terms,None,Some (l,terminator,iter)) subinfos (NVar ldots_var)
     | NHole (knd, naming, arg) ->
       let knd = match knd with
       | Evar_kinds.BinderType (Name id as na) ->
         let na =
-          try snd (coerce_to_name (fst (Id.Map.find id terms)))
+          try (coerce_to_name (fst (Id.Map.find id terms))).v
           with Not_found ->
           try Name (Id.Map.find id renaming)
           with Not_found -> na
@@ -644,47 +710,57 @@ let instantiate_notation_constr loc intern ntnvars subst infos c =
           let gc = intern nenv c in
           (gc, Some c)
         in
-        let bindings = Id.Map.map mk_env terms in
+        let mk_env' (c, (onlyident,(tmp_scope,subscopes))) =
+          let nenv = {env with tmp_scope; scopes = subscopes @ env.scopes} in
+          if onlyident then
+            let na = out_var c in term_of_name na, None
+          else
+            let _,((disjpat,_),_),_ = intern_pat ntnvars nenv c in
+            match disjpat with
+            | [pat] -> (glob_constr_of_cases_pattern pat, None)
+            | _ -> error_cannot_coerce_disjunctive_pattern_term ?loc:c.CAst.loc ()
+        in
+        let terms = Id.Map.map mk_env terms in
+        let binders = Id.Map.map mk_env' binders in
+        let bindings = Id.Map.fold Id.Map.add terms binders in
         Some (Genintern.generic_substitute_notation bindings arg)
       in
-      CAst.make ?loc @@ GHole (knd, naming, arg)
-    | NBinderList (x,y,iter,terminator) ->
+      DAst.make ?loc @@ GHole (knd, naming, arg)
+    | NBinderList (x,y,iter,terminator,revert) ->
       (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 ntnvars) (env,[]) bl in
-	let letins,bl = subordinate_letins [] bl in
-        let termin = aux (terms,None,None) (renaming,env) terminator in
-	let res = List.fold_left (fun t binder ->
-	    aux (terms,Some(y,binder),Some t) subinfos iter)
-	  termin bl in
-	make_letins letins res
+        let (bl,(scopt,subscopes)) = Id.Map.find x binderlists in
+        (* We flatten binders so that we can interpret them at substitution time *)
+        let bl = flatten_binders bl in
+        let bl = if revert then List.rev bl else bl in
+        (* We isolate let-ins which do not contribute to the repeated pattern *)
+        let l = List.map (function | CLocalDef (na,c,t) -> AddLetIn (na,c,t)
+                                   | binder -> AddPreBinderIter (y,binder)) bl in
+        (* We stack the binders to iterate or let-ins to insert *)
+        aux (terms,None,Some (l,terminator,iter)) subinfos (NVar ldots_var)
       with Not_found ->
           anomaly (Pp.str "Inconsistent substitution of recursive notation."))
     | NProd (Name id, NHole _, c') when option_mem_assoc id binderopt ->
-        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
-        CAst.make ?loc @@ GProd (na,bk,t,e)
+        let binder = snd (Option.get binderopt) in
+        expand_binders ?loc mkGProd [binder] (aux subst' (renaming,env) c')
     | NLambda (Name id,NHole _,c') when option_mem_assoc id binderopt ->
-        let a,letins = snd (Option.get binderopt) in
-        let (_loc,(na,bk,t)) = a in
-        CAst.make ?loc @@ GLambda (na,bk,t,make_letins letins (aux subst' infos c'))
+        let binder = snd (Option.get binderopt) in
+        expand_binders ?loc mkGLambda [binder] (aux subst' (renaming,env) 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' ->
-        let subinfos,na = traverse_binder subst avoid subinfos na in
-        let ty = CAst.make ?loc @@ GHole (Evar_kinds.BinderType na,naming,arg) in
-	CAst.make ?loc @@ GProd (na,Explicit,ty,aux subst' subinfos c')
+        let subinfos,disjpat,na = traverse_binder intern_pat ntnvars subst avoid subinfos na in
+        let ty = DAst.make ?loc @@ GHole (Evar_kinds.BinderType na,naming,arg) in
+        DAst.make ?loc @@ GProd (na,Explicit,ty,Option.fold_right apply_cases_pattern disjpat (aux subst' subinfos c'))
     | NLambda (na,NHole(Evar_kinds.BinderType na',naming,arg),c')
         when Name.equal na na' ->
-        let subinfos,na = traverse_binder subst avoid subinfos na in
-        let ty = CAst.make ?loc @@ GHole (Evar_kinds.BinderType na,naming,arg) in
-	CAst.make ?loc @@ GLambda (na,Explicit,ty,aux subst' subinfos c')
+        let subinfos,disjpat,na = traverse_binder intern_pat ntnvars subst  avoid subinfos na in
+        let ty = DAst.make ?loc @@ GHole (Evar_kinds.BinderType na,naming,arg) in
+        DAst.make ?loc @@ GLambda (na,Explicit,ty,Option.fold_right apply_cases_pattern disjpat (aux subst' subinfos c'))
     | t ->
       glob_constr_of_notation_constr_with_binders ?loc
-        (traverse_binder subst avoid) (aux subst') subinfos t
-  and subst_var (terms, _binderopt, _terminopt) (renaming, env) id =
+        (traverse_binder intern_pat ntnvars subst  avoid) (aux subst') subinfos t
+  and subst_var (terms, binderopt, _terminopt) (renaming, env) id =
     (* subst remembers the delimiters stack in the interpretation *)
     (* of the notations *)
     try
@@ -692,7 +768,29 @@ let instantiate_notation_constr loc intern ntnvars subst infos c =
       intern {env with tmp_scope = scopt;
                 scopes = subscopes @ env.scopes} a
     with Not_found ->
-    CAst.make ?loc (
+    try
+      let pat,(onlyident,scopes) = Id.Map.find id binders in
+      let env = set_env_scopes env scopes in
+      (* We deactivate impls to avoid the check on hidden parameters *)
+      (* and since we are only interested in the pattern as a term *)
+      let env = reset_hidden_inductive_implicit_test env in
+      if onlyident then
+        term_of_name (out_var pat)
+      else
+        let env,((disjpat,ids),id),na = intern_pat ntnvars env pat in
+        match disjpat with
+        | [pat] -> glob_constr_of_cases_pattern pat
+        | _ -> user_err Pp.(str "Cannot turn a disjunctive pattern into a term.")
+    with Not_found ->
+    try
+      match binderopt with
+      | Some (x,binder) when Id.equal x id ->
+         let terms = terms_of_binders [binder] in
+         assert (List.length terms = 1);
+         intern env (List.hd terms)
+      | _ -> raise Not_found
+    with Not_found ->
+    DAst.make ?loc (
     try
       GVar (Id.Map.find id renaming)
     with Not_found ->
@@ -700,27 +798,80 @@ let instantiate_notation_constr loc intern ntnvars subst infos c =
       GVar id)
   in aux (terms,None,None) infos c
 
-let split_by_type ids =
-  List.fold_right (fun (x,(scl,typ)) (l1,l2,l3) ->
+(* Turning substitution coming from parsing and based on production
+   into a substitution for interpretation and based on binding/constr
+   distinction *)
+
+let cases_pattern_of_name {loc;v=na} =
+  let atom = match na with Name id -> Some (Ident (loc,id)) | Anonymous -> None in
+  CAst.make ?loc (CPatAtom atom)
+
+let split_by_type ids subst =
+  let bind id scl l s =
+    match l with
+    | [] -> assert false
+    | a::l -> l, Id.Map.add id (a,scl) s in
+  let (terms,termlists,binders,binderlists),subst =
+    List.fold_left (fun ((terms,termlists,binders,binderlists),(terms',termlists',binders',binderlists')) (id,(scl,typ)) ->
+    match typ with
+    | NtnTypeConstr ->
+       let terms,terms' = bind id scl terms terms' in
+       (terms,termlists,binders,binderlists),(terms',termlists',binders',binderlists')
+    | NtnTypeBinder NtnBinderParsedAsConstr (Extend.AsIdentOrPattern | Extend.AsStrictPattern) ->
+       let a,terms = match terms with a::terms -> a,terms | _ -> assert false in
+       let binders' = Id.Map.add id (coerce_to_cases_pattern_expr a,(false,scl)) binders' in
+       (terms,termlists,binders,binderlists),(terms',termlists',binders',binderlists')
+    | NtnTypeBinder NtnBinderParsedAsConstr Extend.AsIdent ->
+       let a,terms = match terms with a::terms -> a,terms | _ -> assert false in
+       let binders' = Id.Map.add id (cases_pattern_of_name (coerce_to_name a),(true,scl)) binders' in
+       (terms,termlists,binders,binderlists),(terms',termlists',binders',binderlists')
+    | NtnTypeBinder (NtnParsedAsIdent | NtnParsedAsPattern _ as x) ->
+       let onlyident = (x = NtnParsedAsIdent) in
+       let binders,binders' = bind id (onlyident,scl) binders binders' in
+       (terms,termlists,binders,binderlists),(terms',termlists',binders',binderlists')
+    | NtnTypeConstrList ->
+       let termlists,termlists' = bind id scl termlists termlists' in
+       (terms,termlists,binders,binderlists),(terms',termlists',binders',binderlists')
+    | NtnTypeBinderList ->
+       let binderlists,binderlists' = bind id scl binderlists binderlists' in
+       (terms,termlists,binders,binderlists),(terms',termlists',binders',binderlists'))
+                   (subst,(Id.Map.empty,Id.Map.empty,Id.Map.empty,Id.Map.empty)) ids in
+  assert (terms = [] && termlists = [] && binders = [] && binderlists = []);
+  subst
+
+let split_by_type_pat ?loc ids subst =
+  let bind id scl l s =
+    match l with
+    | [] -> assert false
+    | a::l -> l, Id.Map.add id (a,scl) s in
+  let (terms,termlists),subst =
+    List.fold_left (fun ((terms,termlists),(terms',termlists')) (id,(scl,typ)) ->
     match typ with
-    | NtnTypeConstr | NtnTypeOnlyBinder -> ((x,scl)::l1,l2,l3)
-    | NtnTypeConstrList -> (l1,(x,scl)::l2,l3)
-    | NtnTypeBinderList -> (l1,l2,(x,scl)::l3)) ids ([],[],[])
+    | NtnTypeConstr | NtnTypeBinder _ ->
+       let terms,terms' = bind id scl terms terms' in
+       (terms,termlists),(terms',termlists')
+    | NtnTypeConstrList ->
+       let termlists,termlists' = bind id scl termlists termlists' in
+       (terms,termlists),(terms',termlists')
+    | NtnTypeBinderList -> error_invalid_pattern_notation ?loc ())
+                   (subst,(Id.Map.empty,Id.Map.empty)) ids in
+  assert (terms = [] && termlists = []);
+  subst
 
 let make_subst ids l =
   let fold accu (id, scl) a = Id.Map.add id (a, scl) accu in
   List.fold_left2 fold Id.Map.empty ids l
 
-let intern_notation intern env lvar loc ntn fullargs =
-  let ntn,(args,argslist,bll as fullargs) = contract_notation ntn fullargs in
+let intern_notation intern env ntnvars loc ntn fullargs =
+  (* Adjust to parsing of { } *)
+  let ntn,fullargs = contract_curly_brackets ntn fullargs in
+  (* Recover interpretation { } *)
   let ((ids,c),df) = interp_notation ?loc ntn (env.tmp_scope,env.scopes) in
   Dumpglob.dump_notation_location (ntn_loc ?loc fullargs ntn) ntn df;
-  let ids,idsl,idsbl = split_by_type ids in
-  let terms = make_subst ids args in
-  let termlists = make_subst idsl argslist in
-  let binders = make_subst idsbl bll in
-  instantiate_notation_constr loc intern lvar
-    (terms, termlists, binders) (Id.Map.empty, env) c
+  (* Dispatch parsing substitution to an interpretation substitution *)
+  let subst = split_by_type ids fullargs in
+  (* Instantiate the notation *)
+  instantiate_notation_constr loc intern intern_cases_pattern_as_binder ntnvars subst (Id.Map.empty, env) c
 
 (**********************************************************************)
 (* Discriminating between bound variables and global references       *)
@@ -732,38 +883,41 @@ let string_of_ty = function
   | Variable -> "var"
 
 let gvar (loc, id) us = match us with
-| None -> CAst.make ?loc @@ GVar id
+| None -> DAst.make ?loc @@ GVar id
 | Some _ ->
-  user_err ?loc  (str "Variable " ++ pr_id id ++
+  user_err ?loc  (str "Variable " ++ Id.print 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 *)
+let intern_var env (ltacvars,ntnvars) namedctx loc id us =
+  (* Is [id] a notation variable *)
+  if Id.Map.mem id ntnvars then
+    begin
+      if not (Id.Map.mem id env.impls) then set_var_scope ?loc id true (env.tmp_scope,env.scopes) ntnvars;
+      gvar (loc,id) us, [], [], []
+    end
+  else
+  (* Is [id] registered with implicit arguments *)
   try
-    let ty,expl_impls,impls,argsc = Id.Map.find id genv.impls in
+    let ty,expl_impls,impls,argsc = Id.Map.find id env.impls in
     let expl_impls = List.map
-      (fun id -> CAst.make ?loc @@ CRef (Ident (loc,id),None), Some (loc,ExplByName id)) expl_impls in
+      (fun id -> CAst.make ?loc @@ CRef (Ident (loc,id),None), Some (make ?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) 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
+  if Id.Set.mem id env.ids || Id.Set.mem id ltacvars.ltac_vars
   then
     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) us, [], [], [])
-  (* Is [id] the special variable for recursive notations *)
   else if Id.equal id ldots_var
+  (* Is [id] the special variable for recursive notations? *)
   then if Id.Map.is_empty ntnvars
     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 ~hdr:"intern_var"
-     (str "variable " ++ pr_id id ++ str " should be bound to a term.")
+     (str "variable " ++ Id.print id ++ str " should be bound to a term.")
   else
     (* Is [id] a goal or section variable *)
     let _ = Context.Named.lookup id namedctx in
@@ -774,24 +928,27 @@ let intern_var genv (ltacvars,ntnvars) namedctx loc id us =
 	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";
-	CAst.make ?loc @@ GRef (ref, us), impls, scopes, []
+	DAst.make ?loc @@ GRef (ref, us), impls, scopes, []
       with e when CErrors.noncritical e ->
 	(* [id] a goal variable *)
 	gvar (loc,id) us, [], [], []
 
 let find_appl_head_data c =
-  match c.v with
+  match DAst.get c with
   | GRef (ref,_) ->
     let impls = implicits_of_global ref in
     let scopes = find_arguments_scope ref in
       c, impls, scopes, []
-  | GApp ({ v = GRef (ref,_) },l)
-      when l != [] ->
+  | GApp (r, l) ->
+    begin match DAst.get r with
+    | GRef (ref,_) when l != [] ->
       let n = List.length l in
       let impls = implicits_of_global ref in 
       let scopes = find_arguments_scope ref in
 	c, List.map (drop_first_implicits n) impls,
 	List.skipn_at_least n scopes,[]
+    | _ -> c,[],[],[]
+    end
   | _ -> c,[],[],[]
 
 let error_not_enough_arguments ?loc =
@@ -803,7 +960,7 @@ let check_no_explicitation l =
   match l with
   | [] -> ()
   | (_, None) :: _ -> assert false
-  | (_, Some (loc, _)) :: _ ->
+  | (_, Some {loc}) :: _ ->
     user_err ?loc  (str"Unexpected explicitation of the argument of an abbreviation.")
 
 let dump_extended_global loc = function
@@ -821,10 +978,22 @@ let intern_reference ref =
   in
   Smartlocate.global_of_extended_global r
 
+let sort_info_of_level_info (info: Misctypes.level_info) : (Libnames.reference * int) option =
+  match info with
+  | Misctypes.UAnonymous -> None
+  | Misctypes.UUnknown -> None
+  | Misctypes.UNamed id -> Some (id, 0)
+
+let glob_sort_of_level (level: Misctypes.glob_level) : Misctypes.glob_sort =
+  match level with
+  | Misctypes.GProp -> Misctypes.GProp
+  | Misctypes.GSet -> Misctypes.GSet
+  | Misctypes.GType info -> Misctypes.GType [sort_info_of_level_info info]
+
 (* Is it a global reference or a syntactic definition? *)
-let intern_qualid loc qid intern env lvar us args =
+let intern_qualid loc qid intern env ntnvars us args =
   match intern_extended_global_of_qualid (loc,qid) with
-  | TrueGlobal ref -> (CAst.make ?loc @@ GRef (ref, us)), true, args
+  | TrueGlobal ref -> (DAst.make ?loc @@ GRef (ref, us)), true, args
   | SynDef sp ->
       let (ids,c) = Syntax_def.search_syntactic_definition sp in
       let nids = List.length ids in
@@ -832,29 +1001,43 @@ let intern_qualid loc qid intern env lvar us args =
       let args1,args2 = List.chop nids args in
       check_no_explicitation args1;
       let terms = make_subst ids (List.map fst args1) in
-      let subst = (terms, Id.Map.empty, Id.Map.empty) in
+      let subst = (terms, Id.Map.empty, Id.Map.empty, Id.Map.empty) in
       let infos = (Id.Map.empty, env) in
       let projapp = match c with NRef _ -> true | _ -> false in
-      let c = instantiate_notation_constr loc intern lvar subst infos c in
-      let c = match us, c with
-      | None, _ -> c
-      | Some _, { loc; v = GRef (ref, None) } -> CAst.make ?loc @@ GRef (ref, us)
-      | Some _, { loc; v = GApp ({ loc = loc' ; v = GRef (ref, None) }, arg) } ->
-        CAst.make ?loc @@ GApp (CAst.make ?loc:loc' @@ GRef (ref, us), arg)
-      | Some _, _ ->
+      let c = instantiate_notation_constr loc intern intern_cases_pattern_as_binder ntnvars subst infos c in
+      let loc = c.CAst.loc in
+      let err () =
         user_err ?loc  (str "Notation " ++ pr_qualid qid
-                        ++ str " cannot have a universe instance,"
-                        ++ str " its expanded head does not start with a reference")
+                  ++ str " cannot have a universe instance,"
+                  ++ str " its expanded head does not start with a reference")
+      in
+      let c = match us, DAst.get c with
+      | None, _ -> c
+      | Some _, GRef (ref, None) -> DAst.make ?loc @@ GRef (ref, us)
+      | Some _, GApp (r, arg) ->
+        let loc' = r.CAst.loc in
+        begin match DAst.get r with
+        | GRef (ref, None) ->
+          DAst.make ?loc @@ GApp (DAst.make ?loc:loc' @@ GRef (ref, us), arg)
+        | _ -> err ()
+        end
+      | Some [s], GSort (Misctypes.GType []) -> DAst.make ?loc @@ GSort (glob_sort_of_level s)
+      | Some [_old_level], GSort _new_sort ->
+        (* TODO: add old_level and new_sort to the error message *)
+        user_err ?loc (str "Cannot change universe level of notation " ++ pr_qualid qid)
+      | Some _, _ -> err ()
       in
       c, projapp, args2
 
 (* Rule out section vars since these should have been found by intern_var *)
-let intern_non_secvar_qualid loc qid intern env lvar us args =
-  match intern_qualid loc qid intern env lvar us args with
-    | { v = GRef (VarRef _, _) },_,_ -> raise Not_found
-    | r -> r
-
-let intern_applied_reference intern env namedctx (_, ntnvars as lvar) us args = function
+let intern_non_secvar_qualid loc qid intern env ntnvars us args =
+  let c, _, _ as r = intern_qualid loc qid intern env ntnvars us args in
+  match DAst.get c with
+    | GRef (VarRef _, _) -> raise Not_found
+    | _ -> r
+
+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 ntnvars us args
@@ -888,14 +1071,14 @@ let interp_reference vars r =
 (** {5 Cases }                                                        *)
 
 (** Private internalization patterns *)
-type raw_cases_pattern_expr_r =
-  | RCPatAlias of raw_cases_pattern_expr * Id.t
+type 'a raw_cases_pattern_expr_r =
+  | RCPatAlias of 'a raw_cases_pattern_expr * Misctypes.lname
   | RCPatCstr  of Globnames.global_reference
-    * raw_cases_pattern_expr list * raw_cases_pattern_expr list
+    * 'a raw_cases_pattern_expr list * 'a raw_cases_pattern_expr list
   (** [RCPatCstr (loc, c, l1, l2)] represents ((@c l1) l2) *)
-  | RCPatAtom  of Id.t option
-  | RCPatOr    of raw_cases_pattern_expr list
-and raw_cases_pattern_expr = raw_cases_pattern_expr_r CAst.t
+  | RCPatAtom  of (Misctypes.lident * (Notation_term.tmp_scope_name option * Notation_term.scope_name list)) option
+  | RCPatOr    of 'a raw_cases_pattern_expr list
+and 'a raw_cases_pattern_expr = ('a raw_cases_pattern_expr_r, 'a) DAst.t
 
 (** {6 Elementary bricks } *)
 let apply_scope_env env = function
@@ -934,8 +1117,11 @@ let rec has_duplicate = function
   | [] -> None
   | x::l -> if Id.List.mem x l then (Some x) else has_duplicate l
 
+let loc_of_multiple_pattern pl =
+ Loc.merge_opt (cases_pattern_expr_loc (List.hd pl)) (cases_pattern_expr_loc (List.last pl))
+
 let loc_of_lhs lhs =
- Loc.merge_opt (fst (List.hd lhs)) (fst (List.last lhs))
+ Loc.merge_opt (loc_of_multiple_pattern (List.hd lhs)) (loc_of_multiple_pattern (List.last lhs))
 
 let check_linearity lhs ids =
   match has_duplicate ids with
@@ -950,7 +1136,7 @@ let check_number_of_pattern loc n l =
   if not (Int.equal n p) then raise (InternalizationError (loc,BadPatternsNumber (n,p)))
 
 let check_or_pat_variables loc ids idsl =
-  if List.exists (fun ids' -> not (List.eq_set Id.equal ids ids')) idsl then
+  if List.exists (fun ids' -> not (List.eq_set (fun {loc;v=id} {v=id'} -> Id.equal id id') ids ids')) idsl then
     user_err ?loc  (str
     "The components of this disjunctive pattern must bind the same variables.")
 
@@ -977,7 +1163,7 @@ let insert_local_defs_in_pattern (ind,j) l =
     let (decls,_) = decompose_prod_assum typi in
     let rec aux decls args =
       match decls, args with
-      | Context.Rel.Declaration.LocalDef _ :: decls, args -> (CAst.make @@ RCPatAtom None) :: aux decls args
+      | Context.Rel.Declaration.LocalDef _ :: decls, args -> (DAst.make @@ RCPatAtom None) :: aux decls args
       | _, [] -> [] (* In particular, if there were trailing local defs, they have been inserted *)
       | Context.Rel.Declaration.LocalAssum _ :: decls, a :: args -> a :: aux decls args
       | _ -> assert false in
@@ -1013,10 +1199,10 @@ let add_implicits_check_length fail nargs nargs_with_letin impls_st len_pl1 pl2
 	      else Int.equal args_len nargs_with_letin || (fst (fail (nargs - List.length impl_list + i))))
 	       ,l)
     |imp::q as il,[] -> if is_status_implicit imp && maximal_insertion_of imp
-      then let (b,out) = aux i (q,[]) in (b,(CAst.make @@ RCPatAtom None)::out)
+      then let (b,out) = aux i (q,[]) in (b,(DAst.make @@ RCPatAtom None)::out)
       else fail (remaining_args (len_pl1+i) il)
     |imp::q,(hh::tt as l) -> if is_status_implicit imp
-      then let (b,out) = aux i (q,l) in (b,(CAst.make @@ RCPatAtom(None))::out)
+      then let (b,out) = aux i (q,l) in (b,(DAst.make @@ RCPatAtom None)::out)
       else let (b,out) = aux (succ i) (q,tt) in (b,hh::out)
   in aux 0 (impl_list,pl2)
 
@@ -1041,8 +1227,9 @@ let chop_params_pattern loc ind args with_letin =
     else Inductiveops.inductive_nparams ind in
   assert (nparams <= List.length args);
   let params,args = List.chop nparams args in
-  List.iter (function { v = PatVar Anonymous } -> ()
-    | { loc; v = PatVar _ } | { loc; v = PatCstr(_,_,_) } -> error_parameter_not_implicit ?loc) params;
+  List.iter (fun c -> match DAst.get c with
+    | PatVar Anonymous -> ()
+    | PatVar _ | PatCstr(_,_,_) -> error_parameter_not_implicit ?loc:c.CAst.loc) params;
   args
 
 let find_constructor loc add_params ref =
@@ -1062,7 +1249,7 @@ let find_constructor loc add_params ref =
           then Inductiveops.inductive_nparamdecls ind
           else Inductiveops.inductive_nparams ind
       in
-      List.make nb ([], [(Id.Map.empty, CAst.make @@ PatVar Anonymous)])
+      List.make nb ([], [(Id.Map.empty, DAst.make @@ PatVar Anonymous)])
     | None -> []
 
 let find_pattern_variable = function
@@ -1188,7 +1375,7 @@ let sort_fields ~complete loc fields completer =
 (** {6 Manage multiple aliases} *)
 
 type alias = {
-  alias_ids : Id.t list;
+  alias_ids : Misctypes.lident list;
   alias_map : Id.t Id.Map.t;
 }
 
@@ -1199,17 +1386,20 @@ let empty_alias = {
 
   (* [merge_aliases] returns the sets of all aliases encountered at this
      point and a substitution mapping extra aliases to the first one *)
-let merge_aliases aliases id =
-  let alias_ids = aliases.alias_ids @ [id] in
+let merge_aliases aliases {loc;v=na} =
+  match na with
+  | Anonymous -> aliases
+  | Name id ->
+  let alias_ids = aliases.alias_ids @ [make ?loc id] in
   let alias_map = match aliases.alias_ids with
   | [] -> aliases.alias_map
-  | id' :: _ -> Id.Map.add id id' aliases.alias_map
+  | {v=id'} :: _ -> Id.Map.add id id' aliases.alias_map
   in
   { alias_ids; alias_map; }
 
 let alias_of als = match als.alias_ids with
 | [] -> Anonymous
-| id :: _ -> Name id
+| {v=id} :: _ -> Name id
 
 (** {6 Expanding notations }
 
@@ -1227,6 +1417,8 @@ let is_zero s =
 let merge_subst s1 s2 = Id.Map.fold Id.Map.add s1 s2
 
 let product_of_cases_patterns aliases idspl =
+  (* each [pl] is a disjunction of patterns over common identifiers [ids] *)
+  (* We stepwise build a disjunction of patterns [ptaill] over common [ids'] *)
   List.fold_right (fun (ids,pl) (ids',ptaill) ->
     (ids @ ids',
      (* Cartesian prod of the or-pats for the nth arg and the tail args *)
@@ -1235,15 +1427,23 @@ let product_of_cases_patterns aliases idspl =
 	 List.map (fun (subst',ptail) -> (merge_subst subst subst',p::ptail)) ptaill) pl)))
     idspl (aliases.alias_ids,[aliases.alias_map,[]])
 
-let rec subst_pat_iterator y t = CAst.(map (function
+let rec subst_pat_iterator y t = DAst.(map (function
   | RCPatAtom id as p ->
-    begin match id with Some x when Id.equal x y -> t.v | _ -> p end
+    begin match id with Some ({v=x},_) when Id.equal x y -> DAst.get t | _ -> p end
   | RCPatCstr (id,l1,l2) ->
     RCPatCstr (id,List.map (subst_pat_iterator y t) l1,
  	       List.map (subst_pat_iterator y t) l2)
   | RCPatAlias (p,a) -> RCPatAlias (subst_pat_iterator y t p,a)
   | RCPatOr pl -> RCPatOr (List.map (subst_pat_iterator y t) pl)))
 
+let is_non_zero c = match c with
+| { CAst.v = CPrim (Numeral (p, true)) } -> not (is_zero p)
+| _ -> false
+
+let is_non_zero_pat c = match c with
+| { CAst.v = CPatPrim (Numeral (p, true)) } -> not (is_zero p)
+| _ -> false
+
 let drop_notations_pattern looked_for genv =
   (* At toplevel, Constructors and Inductives are accepted, in recursive calls
      only constructor are allowed *)
@@ -1258,11 +1458,19 @@ let drop_notations_pattern looked_for genv =
     if top then looked_for else function ConstructRef _ -> () | _ -> raise Not_found
   in
   (** [rcp_of_glob] : from [glob_constr] to [raw_cases_pattern_expr] *)
-  let rec rcp_of_glob x = CAst.(map (function
-    | GVar id -> RCPatAtom (Some id)
+  let rec rcp_of_glob scopes x = DAst.(map (function
+    | GVar id -> RCPatAtom (Some (CAst.make ?loc:x.loc id,scopes))
     | GHole (_,_,_) -> RCPatAtom (None)
     | GRef (g,_) -> RCPatCstr (g,[],[])
-    | GApp ({ v = GRef (g,_) }, l) -> RCPatCstr (g, List.map rcp_of_glob l,[])
+    | GApp (r, l) ->
+      begin match DAst.get r with
+      | GRef (g,_) ->
+        let allscs = find_arguments_scope g in
+        let allscs = simple_adjust_scopes (List.length l) allscs in (* TO CHECK *)
+        RCPatCstr (g, List.map2 (fun sc a -> rcp_of_glob (sc,snd scopes) a) allscs l,[])
+      | _ ->
+        CErrors.anomaly Pp.(str "Invalid return pattern from Notation.interp_prim_token_cases_pattern_expr.")
+      end
     | _ -> CErrors.anomaly Pp.(str "Invalid return pattern from Notation.interp_prim_token_cases_pattern_expr."))) x
   in
   let rec drop_syndef top scopes re pats =
@@ -1303,25 +1511,25 @@ let drop_notations_pattern looked_for genv =
     let open CAst in
     let loc = pt.loc in
     match pt.v with
-    | CPatAlias (p, id) -> CAst.make ?loc @@ RCPatAlias (in_pat top scopes p, id)
+    | CPatAlias (p, id) -> DAst.make ?loc @@ RCPatAlias (in_pat top scopes p, id)
     | CPatRecord l ->
       let sorted_fields =
 	sort_fields ~complete:false loc l (fun _idx -> CAst.make ?loc @@ CPatAtom None) in
       begin match sorted_fields with
-	| None -> CAst.make ?loc @@ RCPatAtom None
+	| None -> DAst.make ?loc @@ RCPatAtom None
 	| Some (n, head, pl) ->
           let pl =
             if !asymmetric_patterns then pl else
             let pars = List.make n (CAst.make ?loc @@ CPatAtom None) in
             List.rev_append pars pl in
 	  match drop_syndef top scopes head pl with
-	    | Some (a,b,c) -> CAst.make ?loc @@ RCPatCstr(a, b, c)
+	    | Some (a,b,c) -> DAst.make ?loc @@ RCPatCstr(a, b, c)
 	    | None -> raise (InternalizationError (loc,NotAConstructor head))
       end
     | CPatCstr (head, None, pl) ->
       begin
 	match drop_syndef top scopes head pl with
-	  | Some (a,b,c) -> CAst.make ?loc @@ RCPatCstr(a, b, c)
+	  | Some (a,b,c) -> DAst.make ?loc @@ RCPatCstr(a, b, c)
 	  | None -> raise (InternalizationError (loc,NotAConstructor head))
       end
      | CPatCstr (r, Some expl_pl, pl) ->
@@ -1330,39 +1538,37 @@ let drop_notations_pattern looked_for genv =
  	      raise (InternalizationError (loc,NotAConstructor r)) in
       if expl_pl == [] then
         (* Convention: (@r) deactivates all further implicit arguments and scopes *)
-        CAst.make ?loc @@ RCPatCstr (g, List.map (in_pat false scopes) pl, [])
+        DAst.make ?loc @@ RCPatCstr (g, List.map (in_pat false scopes) pl, [])
       else
         (* Convention: (@r expl_pl) deactivates implicit arguments in expl_pl and in pl *)
         (* but not scopes in expl_pl *)
         let (argscs1,_) = find_remaining_scopes expl_pl pl g in
-        CAst.make ?loc @@ RCPatCstr (g, List.map2 (in_pat_sc scopes) argscs1 expl_pl @ List.map (in_pat false scopes) pl, [])
-    | CPatNotation ("- _",([{ CAst.v = CPatPrim(Numeral (p,true)) }],[]),[])
-	when not (is_zero p) ->
+        DAst.make ?loc @@ RCPatCstr (g, List.map2 (in_pat_sc scopes) argscs1 expl_pl @ List.map (in_pat false scopes) pl, [])
+    | CPatNotation ("- _",([a],[]),[]) when is_non_zero_pat a ->
+      let p = match a.CAst.v with CPatPrim (Numeral (p, _)) -> p | _ -> assert false in
       let pat, _df = Notation.interp_prim_token_cases_pattern_expr ?loc (ensure_kind false loc) (Numeral (p,false)) scopes in
-      rcp_of_glob pat
+      rcp_of_glob scopes pat
     | CPatNotation ("( _ )",([a],[]),[]) ->
       in_pat top scopes a
-    | CPatNotation (ntn, fullargs,extrargs) ->
-      let ntn,(args,argsl as fullargs) = contract_pat_notation ntn fullargs in
+    | CPatNotation (ntn,fullargs,extrargs) ->
+      let ntn,(terms,termlists) = contract_curly_brackets_pat ntn fullargs in
       let ((ids',c),df) = Notation.interp_notation ?loc ntn scopes in
-      let (ids',idsl',_) = split_by_type ids' in
+      let (terms,termlists) = split_by_type_pat ?loc ids' (terms,termlists) in
       Dumpglob.dump_notation_location (patntn_loc ?loc fullargs ntn) ntn df;
-      let substlist = make_subst idsl' argsl in
-      let subst = make_subst ids' args in
-      in_not top loc scopes (subst,substlist) extrargs c
+      in_not top loc scopes (terms,termlists) extrargs c
     | CPatDelimiters (key, e) ->
       in_pat top (None,find_delimiters_scope ?loc key::snd scopes) e
     | CPatPrim p ->
       let pat, _df = Notation.interp_prim_token_cases_pattern_expr ?loc (test_kind false) p scopes in
-      rcp_of_glob pat
-    | CPatAtom Some id ->
+      rcp_of_glob scopes pat
+    | CPatAtom (Some id) ->
       begin
 	match drop_syndef top scopes id [] with
-	  | Some (a,b,c) -> CAst.make ?loc @@ RCPatCstr (a, b, c)
-	  | None         -> CAst.make ?loc @@ RCPatAtom (Some (find_pattern_variable id))
+	  | Some (a,b,c) -> DAst.make ?loc @@ RCPatCstr (a, b, c)
+          | None         -> DAst.make ?loc @@ RCPatAtom (Some ((make ?loc @@ find_pattern_variable id),scopes))
       end
-    | CPatAtom None -> CAst.make ?loc @@ RCPatAtom None
-    | CPatOr pl     -> CAst.make ?loc @@ RCPatOr (List.map (in_pat top scopes) pl)
+    | CPatAtom None -> DAst.make ?loc @@ RCPatAtom None
+    | CPatOr pl     -> DAst.make ?loc @@ RCPatOr (List.map (in_pat top scopes) pl)
     | CPatCast (_,_) ->
       (* We raise an error if the pattern contains a cast, due to
          current restrictions on casts in patterns. Cast in patterns
@@ -1389,20 +1595,20 @@ let drop_notations_pattern looked_for genv =
 	  let (a,(scopt,subscopes)) = Id.Map.find id subst in
 	  in_pat top (scopt,subscopes@snd scopes) a
 	with Not_found ->
-	  if Id.equal id ldots_var then CAst.make ?loc @@ RCPatAtom (Some id) else
+          if Id.equal id ldots_var then DAst.make ?loc @@ RCPatAtom (Some ((make ?loc id),scopes)) else
 	    anomaly (str "Unbound pattern notation variable: " ++ Id.print id ++ str ".")
       end
     | NRef g ->
       ensure_kind top loc g;
       let (_,argscs) = find_remaining_scopes [] args g in
-      CAst.make ?loc @@ RCPatCstr (g, [], List.map2 (in_pat_sc scopes) argscs args)
+      DAst.make ?loc @@ RCPatCstr (g, [], List.map2 (in_pat_sc scopes) argscs args)
     | NApp (NRef g,pl) ->
       ensure_kind top loc g;
       let (argscs1,argscs2) = find_remaining_scopes pl args g in
       let pl = List.map2 (fun x -> in_not false loc (x,snd scopes) fullsubst []) argscs1 pl in
       let pl = add_local_defs_and_check_length loc genv g pl args in
-      CAst.make ?loc @@ RCPatCstr (g, pl @ List.map (in_pat false scopes) args, [])
-    | NList (x,y,iter,terminator,lassoc) ->
+      DAst.make ?loc @@ RCPatCstr (g, pl @ List.map (in_pat false scopes) args, [])
+    | NList (x,y,iter,terminator,revert) ->
       if not (List.is_empty args) then user_err ?loc 
         (strbrk "Application of arguments to a recursive notation not supported in patterns.");
       (try
@@ -1413,27 +1619,27 @@ let drop_notations_pattern looked_for genv =
            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
+           (if revert then List.rev l else l) termin
        with Not_found ->
          anomaly (Pp.str "Inconsistent substitution of recursive notation."))
     | NHole _ ->
       let () = assert (List.is_empty args) in
-      CAst.make ?loc @@ RCPatAtom None
+      DAst.make ?loc @@ RCPatAtom None
     | t -> error_invalid_pattern_notation ?loc ()
   in in_pat true
 
-let rec intern_pat genv aliases pat =
+let rec intern_pat genv ntnvars aliases pat =
   let intern_cstr_with_all_args loc c with_letin idslpl1 pl2 =
-    let idslpl2 = List.map (intern_pat genv empty_alias) pl2 in
+    let idslpl2 = List.map (intern_pat genv ntnvars empty_alias) pl2 in
     let (ids',pll) = product_of_cases_patterns aliases (idslpl1@idslpl2) in
     let pl' = List.map (fun (asubst,pl) ->
-      (asubst, CAst.make ?loc @@ PatCstr (c,chop_params_pattern loc (fst c) pl with_letin,alias_of aliases))) pll in
+      (asubst, DAst.make ?loc @@ PatCstr (c,chop_params_pattern loc (fst c) pl with_letin,alias_of aliases))) pll in
     ids',pl' in
-  let loc = CAst.(pat.loc) in
-  match CAst.(pat.v) with
+  let loc = pat.loc in
+  match DAst.get pat with
     | RCPatAlias (p, id) ->
       let aliases' = merge_aliases aliases id in
-      intern_pat genv aliases' p
+      intern_pat genv ntnvars aliases' p
     | RCPatCstr (head, expl_pl, pl) ->
       if !asymmetric_patterns then
         let len = if List.is_empty expl_pl then Some (List.length pl) else None in
@@ -1446,44 +1652,44 @@ let rec intern_pat genv aliases pat =
 	let with_letin, pl2 =
 	  add_implicits_check_constructor_length genv loc c (List.length idslpl1 + List.length expl_pl) pl in
 	intern_cstr_with_all_args loc c with_letin idslpl1 (expl_pl@pl2)
-    | RCPatAtom (Some id) ->
-      let aliases = merge_aliases aliases id in
-      (aliases.alias_ids,[aliases.alias_map, CAst.make ?loc @@ PatVar (alias_of aliases)])
+    | RCPatAtom (Some ({loc;v=id},scopes)) ->
+      let aliases = merge_aliases aliases (make ?loc @@ Name id) in
+      set_var_scope ?loc id false scopes ntnvars;
+      (aliases.alias_ids,[aliases.alias_map, DAst.make ?loc @@ PatVar (alias_of aliases)]) (* TO CHECK: aura-t-on id? *)
     | RCPatAtom (None) ->
       let { alias_ids = ids; alias_map = asubst; } = aliases in
-      (ids, [asubst, CAst.make ?loc @@ PatVar (alias_of aliases)])
+      (ids, [asubst, DAst.make ?loc @@ PatVar (alias_of aliases)])
     | RCPatOr pl ->
       assert (not (List.is_empty pl));
-      let pl' = List.map (intern_pat genv aliases) pl in
+      let pl' = List.map (intern_pat genv ntnvars aliases) pl in
       let (idsl,pl') = List.split pl' in
       let ids = List.hd idsl in
       check_or_pat_variables loc ids (List.tl idsl);
       (ids,List.flatten pl')
 
-let intern_cases_pattern genv scopes aliases pat =
-  intern_pat genv aliases
+let intern_cases_pattern genv ntnvars scopes aliases pat =
+  intern_pat genv ntnvars aliases
     (drop_notations_pattern (function ConstructRef _ -> () | _ -> raise Not_found) genv scopes pat)
 
 let _ =
   intern_cases_pattern_fwd :=
-    fun scopes p -> intern_cases_pattern (Global.env ()) scopes empty_alias p
+    fun ntnvars scopes p -> intern_cases_pattern (Global.env ()) ntnvars scopes empty_alias p
 
-let intern_ind_pattern genv scopes pat =
+let intern_ind_pattern genv ntnvars scopes pat =
   let no_not =
     try
       drop_notations_pattern (function (IndRef _ | ConstructRef _) -> () | _ -> raise Not_found) genv scopes pat
     with InternalizationError(loc,NotAConstructor _) -> error_bad_inductive_type ?loc
   in
   let loc = no_not.CAst.loc in
-  match no_not.CAst.v with
+  match DAst.get no_not with
     | RCPatCstr (head, expl_pl, pl) ->
       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
-      let idslpl2 = List.map (intern_pat genv empty_alias) pl2 in
+      let idslpl = List.map (intern_pat genv ntnvars empty_alias) (expl_pl@pl2) in
       (with_letin,
-       match product_of_cases_patterns empty_alias (List.rev_append idslpl1 idslpl2) with
+       match product_of_cases_patterns empty_alias idslpl with
        | _,[_,pl] -> (c,chop_params_pattern loc c pl with_letin)
        | _ -> error_bad_inductive_type ?loc)
     | x -> error_bad_inductive_type ?loc
@@ -1493,12 +1699,12 @@ let intern_ind_pattern genv scopes pat =
 
 let merge_impargs l args =
   let test x = function
-  | (_, Some (_, y)) -> explicitation_eq x y
+  | (_, Some {v=y}) -> explicitation_eq x y
   | _ -> false
   in
   List.fold_right (fun a l ->
     match a with
-      | (_,Some (_,(ExplByName id as x))) when
+      | (_, Some {v=ExplByName id as x}) when
 	  List.exists (test x) args -> l
       | _ -> a::l)
     l args
@@ -1506,9 +1712,18 @@ let merge_impargs l args =
 let get_implicit_name n imps =
   Some (Impargs.name_of_implicit (List.nth imps (n-1)))
 
-let set_hole_implicit i b = function
-  | {loc; v = GRef (r,_) } | { v = GApp ({loc; v = GRef (r,_)},_) } -> Loc.tag ?loc (Evar_kinds.ImplicitArg (r,i,b),Misctypes.IntroAnonymous,None)
-  | {loc; v = GVar id } -> Loc.tag ?loc (Evar_kinds.ImplicitArg (VarRef id,i,b),Misctypes.IntroAnonymous,None)
+let set_hole_implicit i b c =
+  let loc = c.CAst.loc in
+  match DAst.get c with
+  | GRef (r, _) -> Loc.tag ?loc (Evar_kinds.ImplicitArg (r,i,b),Misctypes.IntroAnonymous,None)
+  | GApp (r, _) ->
+    let loc = r.CAst.loc in
+    begin match DAst.get r with
+    | GRef (r, _) ->
+      Loc.tag ?loc (Evar_kinds.ImplicitArg (r,i,b),Misctypes.IntroAnonymous,None)
+    | _ -> anomaly (Pp.str "Only refs have implicits.")
+    end
+  | GVar id -> Loc.tag ?loc (Evar_kinds.ImplicitArg (VarRef id,i,b),Misctypes.IntroAnonymous,None)
   | _ -> anomaly (Pp.str "Only refs have implicits.")
 
 let exists_implicit_name id =
@@ -1521,14 +1736,14 @@ let extract_explicit_arg imps args =
       let (eargs,rargs) = aux l in
       match e with
       | None -> (eargs,a::rargs)
-      | Some (loc,pos) ->
+      | Some {loc;v=pos} ->
 	  let id = match pos with
 	  | ExplByName id ->
 	      if not (exists_implicit_name id imps) then
 		user_err ?loc 
-		  (str "Wrong argument name: " ++ pr_id id ++ str ".");
+		  (str "Wrong argument name: " ++ Id.print id ++ str ".");
 	      if Id.Map.mem id eargs then
-		user_err ?loc  (str "Argument name " ++ pr_id id
+		user_err ?loc  (str "Argument name " ++ Id.print id
 		++ str " occurs more than once.");
 	      id
 	  | ExplByPos (p,_id) ->
@@ -1560,8 +1775,8 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
 	in
 	  apply_impargs c env imp subscopes l loc
 
-    | CFix ((locid,iddef), dl) ->
-        let lf = List.map (fun ((_, id),_,_,_,_) -> id) dl in
+    | CFix ({ CAst.loc = locid; v = iddef}, dl) ->
+        let lf = List.map (fun ({CAst.v = id},_,_,_,_) -> id) dl in
         let dl = Array.of_list dl in
 	let n =
 	  try List.index0 Id.equal iddef lf
@@ -1574,7 +1789,8 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
 	       let before, after = split_at_annot bl n in
 	       let (env',rbefore) = List.fold_left intern_local_binder (env,[]) before in
 	       let ro = f (intern env') in
-	       let n' = Option.map (fun _ -> List.count (function | { v = GLocalAssum _ } -> true
+	       let n' = Option.map (fun _ -> List.count (fun c -> match DAst.get c with
+                                                                  | GLocalAssum _ -> true
                                                                   | _ -> false (* remove let-ins *))
                         rbefore) n in
 		 n', ro, List.fold_left intern_local_binder (env',rbefore) after
@@ -1595,17 +1811,17 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
 					     let (_,bli,tyi,_) = idl_temp.(i) in
 					     let fix_args = (List.map (fun (na, bk, _, _) -> (build_impls bk na)) bli) in
 					       push_name_env ntnvars (impls_type_list ~args:fix_args tyi)
-					    en (Loc.tag @@ Name name)) 0 env' lf in
+                                            en (CAst.make @@ Name name)) 0 env' lf in
              (a,b,c,intern {env'' with tmp_scope = None} bd)) dl idl_temp in
-	CAst.make ?loc @@
+	DAst.make ?loc @@
           GRec (GFix
 	      (Array.map (fun (ro,_,_,_) -> ro) idl,n),
               Array.of_list lf,
               Array.map (fun (_,bl,_,_) -> bl) idl,
               Array.map (fun (_,_,ty,_) -> ty) idl,
               Array.map (fun (_,_,_,bd) -> bd) idl)
-    | CCoFix ((locid,iddef), dl) ->
-        let lf = List.map (fun ((_, id),_,_,_) -> id) dl in
+    | CCoFix ({ CAst.loc = locid; v = iddef }, dl) ->
+        let lf = List.map (fun ({CAst.v = id},_,_,_) -> id) dl in
         let dl = Array.of_list dl in
 	let n =
           try List.index0 Id.equal iddef lf
@@ -1613,7 +1829,7 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
 	    raise (InternalizationError (locid,UnboundFixName (true,iddef)))
 	in
         let idl_tmp = Array.map
-          (fun ((loc,id),bl,ty,_) ->
+          (fun ({ CAst.loc; v = id },bl,ty,_) ->
             let (env',rbl) = List.fold_left intern_local_binder (env,[]) bl in
             (List.rev (List.map glob_local_binder_of_extended rbl),
              intern_type env' ty,env')) dl in
@@ -1622,32 +1838,33 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
 					     let (bli,tyi,_) = idl_tmp.(i) in
 					     let cofix_args =  List.map (fun (na, bk, _, _) -> (build_impls bk na)) bli in
 	       push_name_env ntnvars (impls_type_list ~args:cofix_args tyi)
-					    en (Loc.tag @@ Name name)) 0 env' lf in
+                                            en (CAst.make @@ Name name)) 0 env' lf in
              (b,c,intern {env'' with tmp_scope = None} bd)) dl idl_tmp in
-	CAst.make ?loc @@
+	DAst.make ?loc @@
 	GRec (GCoFix n,
               Array.of_list lf,
               Array.map (fun (bl,_,_) -> bl) idl,
               Array.map (fun (_,ty,_) -> ty) idl,
               Array.map (fun (_,_,bd) -> bd) idl)
-    | CProdN ([],c2) ->
-        intern_type env c2
-    | CProdN ((nal,bk,ty)::bll,c2) ->
-        iterate_prod ?loc env bk ty (CAst.make ?loc @@ CProdN (bll, c2)) nal
+    | CProdN (bl,c2) ->
+        let (env',bl) = List.fold_left intern_local_binder (env,[]) bl in
+        expand_binders ?loc mkGProd bl (intern_type env' c2)
     | CLambdaN ([],c2) ->
+        (* Such a term is built sometimes: it should not change scope *)
         intern env c2
-    | CLambdaN ((nal,bk,ty)::bll,c2) ->
-	iterate_lam loc (reset_tmp_scope env) bk ty (CAst.make ?loc @@ CLambdaN (bll, c2)) nal
+    | CLambdaN (bl,c2) ->
+        let (env',bl) = List.fold_left intern_local_binder (reset_tmp_scope env,[]) bl in
+        expand_binders ?loc mkGLambda bl (intern env' c2)
     | CLetIn (na,c1,t,c2) ->
 	let inc1 = intern (reset_tmp_scope env) c1 in
 	let int = Option.map (intern_type env) t in
-	CAst.make ?loc @@
-	GLetIn (snd na, inc1, int,
+	DAst.make ?loc @@
+        GLetIn (na.CAst.v, inc1, int,
           intern (push_name_env ntnvars (impls_term_list inc1) env na) c2)
-    | CNotation ("- _",([{ CAst.v = CPrim (Numeral (p,true)) }],[],[]))
-         when not (is_zero p) ->
+    | CNotation ("- _", ([a],[],[],[])) when is_non_zero a ->
+      let p = match a.CAst.v with CPrim (Numeral (p, _)) -> p | _ -> assert false in
        intern env (CAst.make ?loc @@ CPrim (Numeral (p,false)))
-    | CNotation ("( _ )",([a],[],[])) -> intern env a
+    | CNotation ("( _ )",([a],[],[],[])) -> intern env a
     | CNotation (ntn,args) ->
         intern_notation intern env ntnvars loc ntn args
     | CGeneralization (b,a,c) ->
@@ -1664,13 +1881,13 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
 	    lvar us args ref 
 	in
 	  (* Rem: GApp(_,f,[]) stands for @f *)
-	CAst.make ?loc @@
+	DAst.make ?loc @@
 	  GApp (f, intern_args env args_scopes (List.map fst args))
 
     | CApp ((isproj,f), args) ->
-        let f,args = match f with
+        let f,args = match f.CAst.v with
           (* Compact notations like "t.(f args') args" *)
-          | { CAst.v = CApp ((Some _,f), args') } when not (Option.has_some isproj) ->
+          | CApp ((Some _,f), args') when not (Option.has_some isproj) ->
 	    f,args'@args
           (* Don't compact "(f args') args" to resolve implicits separately *)
           | _ -> f,args in
@@ -1679,8 +1896,8 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
             | CRef (ref,us) -> 
 	       intern_applied_reference intern env
 		 (Environ.named_context globalenv) lvar us args ref
-            | CNotation (ntn,([],[],[])) ->
-                let c = intern_notation intern env ntnvars loc ntn ([],[],[]) in
+            | CNotation (ntn,([],[],[],[])) ->
+                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
             | _ -> (intern env f,[],[],[]), args in
@@ -1705,7 +1922,7 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
     | CCases (sty, rtnpo, tms, eqns) ->
         let as_in_vars = List.fold_left (fun acc (_,na,inb) ->
 	  Option.fold_left (fun acc tt -> Id.Set.union (ids_of_cases_indtype tt) acc)
-            (Option.fold_left (fun acc (_,y) -> Name.fold_right Id.Set.add y acc) acc na)
+            (Option.fold_left (fun acc { CAst.v = y } -> Name.fold_right Id.Set.add y acc) acc na)
 	    inb) Id.Set.empty tms in
         (* as, in & return vars *)
         let forbidden_vars = Option.cata free_vars_of_constr_expr as_in_vars rtnpo in
@@ -1715,13 +1932,17 @@ let internalize globalenv env pattern_mode (_, ntnvars as 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 ntnvars (Variable,[],[],[]) bli (Loc.tag @@ Name var))
+          (fun var bli -> push_name_env ntnvars (Variable,[],[],[]) bli (CAst.make @@ 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 =
+          let is_patvar c = match DAst.get c with
+          | PatVar _ -> true
+          | _ -> false
+          in
           let rec aux = function
 	    | [] -> []
-	    | (_, { v = PatVar _}) :: q -> aux q
+	    | (_, c) :: q when is_patvar c -> aux q
 	    | l -> l
 	  in aux match_from_in in
         let rtnpo = match stripped_match_from_in with
@@ -1730,20 +1951,20 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
              (* Build a return predicate by expansion of the patterns of the "in" clause *)
              let thevars, thepats = List.split l in
              let sub_rtn = (* Some (GSort (Loc.ghost,GType None)) *) None in
-             let sub_tms = List.map (fun id -> (CAst.make @@ GVar id),(Name id,None)) thevars (* "match v1,..,vn" *) in
+             let sub_tms = List.map (fun id -> (DAst.make @@ GVar id),(Name id,None)) thevars (* "match v1,..,vn" *) in
              let main_sub_eqn = Loc.tag @@
                ([],thepats, (* "|p1,..,pn" *)
 		Option.cata (intern_type env')
-                  (CAst.make ?loc @@ GHole(Evar_kinds.CasesType false,Misctypes.IntroAnonymous,None))
+                  (DAst.make ?loc @@ GHole(Evar_kinds.CasesType false,Misctypes.IntroAnonymous,None))
                   rtnpo) (* "=> P" if there were a return predicate P, and "=> _" otherwise *) in
              let catch_all_sub_eqn =
                if List.for_all (irrefutable globalenv) thepats then [] else
-                  [Loc.tag @@ ([],List.make (List.length thepats) (CAst.make @@ PatVar Anonymous), (* "|_,..,_" *)
-                   CAst.make @@ GHole(Evar_kinds.ImpossibleCase,Misctypes.IntroAnonymous,None))]   (* "=> _" *) in
-             Some (CAst.make @@ GCases(Term.RegularStyle,sub_rtn,sub_tms,main_sub_eqn::catch_all_sub_eqn))
+                  [Loc.tag @@ ([],List.make (List.length thepats) (DAst.make @@ PatVar Anonymous), (* "|_,..,_" *)
+                   DAst.make @@ GHole(Evar_kinds.ImpossibleCase,Misctypes.IntroAnonymous,None))]   (* "=> _" *) in
+             Some (DAst.make @@ GCases(Term.RegularStyle,sub_rtn,sub_tms,main_sub_eqn::catch_all_sub_eqn))
 	in
         let eqns' = List.map (intern_eqn (List.length tms) env) eqns in
-	CAst.make ?loc @@
+	DAst.make ?loc @@
 	GCases (sty, rtnpo, tms, List.flatten eqns')
     | CLetTuple (nal, (na,po), b, c) ->
 	let env' = reset_tmp_scope env in
@@ -1751,19 +1972,19 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
         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 ntnvars (Variable,[],[],[]) (reset_hidden_inductive_implicit_test env')
-	    (Loc.tag na') in
+            (CAst.make na') in
 	  intern_type env'' u) po in
-	CAst.make ?loc @@
-        GLetTuple (List.map snd nal, (na', p'), b',
+	DAst.make ?loc @@
+        GLetTuple (List.map (fun { CAst.v } -> v) nal, (na', p'), b',
                    intern (List.fold_left (push_name_env ntnvars (Variable,[],[],[])) (reset_hidden_inductive_implicit_test env) nal) c)
     | CIf (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 ntnvars (Variable,[],[],[]) (reset_hidden_inductive_implicit_test env)
-	    (Loc.tag na') in
+            (CAst.make na') in
 	  intern_type env'' p) po in
-	CAst.make ?loc @@
+	DAst.make ?loc @@
         GIf (c', (na', p'), intern env b1, intern env b2)
     | CHole (k, naming, solve) ->
         let k = match k with
@@ -1778,6 +1999,8 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
         | None -> None
         | Some gen ->
           let (ltacvars, ntnvars) = lvar in
+          (* Preventively declare notation variables in ltac as non-bindings *)
+          Id.Map.iter (fun x (used_as_binder,_,_) -> used_as_binder := false) ntnvars;
           let ntnvars = Id.Map.domain ntnvars in
           let extra = ltacvars.ltac_extra in
           let lvars = Id.Set.union ltacvars.ltac_bound ltacvars.ltac_vars in
@@ -1791,38 +2014,45 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
           let (_, glb) = Genintern.generic_intern ist gen in
           Some glb
         in
-	CAst.make ?loc @@
+	DAst.make ?loc @@
 	GHole (k, naming, solve)
     (* Parsing pattern variables *)
     | CPatVar n when pattern_mode ->
-	CAst.make ?loc @@
+	DAst.make ?loc @@
 	GPatVar (Evar_kinds.SecondOrderPatVar n)
     | CEvar (n, []) when pattern_mode ->
-	CAst.make ?loc @@
+	DAst.make ?loc @@
 	GPatVar (Evar_kinds.FirstOrderPatVar n)
     (* end *)
     (* Parsing existential variables *)
     | CEvar (n, l) ->
-	CAst.make ?loc @@
+	DAst.make ?loc @@
 	GEvar (n, List.map (on_snd (intern env)) l)
     | CPatVar _ ->
         raise (InternalizationError (loc,IllegalMetavariable))
     (* end *)
     | CSort s ->
-	CAst.make ?loc @@
+	DAst.make ?loc @@
 	GSort s
     | CCast (c1, c2) ->
-	CAst.make ?loc @@
+	DAst.make ?loc @@
         GCast (intern env c1, Miscops.map_cast_type (intern_type env) c2)
-  )
+    | CProj (pr, c) ->
+      match intern_reference pr with
+      | ConstRef p ->
+        DAst.make ?loc @@ GProj (Projection.make p false, intern env c)
+      | _ ->
+        raise (InternalizationError (loc,IllegalMetavariable)) (* FIXME *)
+    )
   and intern_type env = intern (set_type_scope env)
 
   and intern_local_binder env bind : intern_env * Glob_term.extended_glob_local_binder list =
     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) =
-    let idsl_pll = List.map (intern_cases_pattern globalenv (None,env.scopes) empty_alias) pl in
+  and intern_multiple_pattern env n pl =
+    let idsl_pll = List.map (intern_cases_pattern globalenv ntnvars (None,env.scopes) empty_alias) pl in
+    let loc = loc_of_multiple_pattern pl in
     check_number_of_pattern loc n pl;
     product_of_cases_patterns empty_alias idsl_pll
 
@@ -1836,9 +2066,10 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
     (ids,List.flatten mpl')
 
   (* Expands a pattern-matching clause [lhs => rhs] *)
-  and intern_eqn n env (loc,(lhs,rhs)) =
+  and intern_eqn n env {loc;v=(lhs,rhs)} =
     let eqn_ids,pll = intern_disjunctive_multiple_pattern env loc n lhs in
     (* Linearity implies the order in ids is irrelevant *)
+    let eqn_ids = List.map (fun x -> x.v) eqn_ids in
     check_linearity lhs eqn_ids;
     let env_ids = List.fold_right Id.Set.add eqn_ids env.ids in
     List.map (fun (asubst,pl) ->
@@ -1850,15 +2081,17 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
     (* the "match" part *)
     let tm' = intern env tm in
     (* the "as" part *)
-    let extra_id,na = match tm', na with
-      | {loc; v = GVar id}, None when not (Id.Map.mem id (snd lvar)) -> Some id,(loc,Name id)
-      | {loc; v = GRef (VarRef id, _)}, None -> Some id,(loc,Name id)
-      | _, None -> None,(Loc.tag Anonymous)
-      | _, Some (loc,na) -> None,(loc,na) in
+    let extra_id,na =
+      let loc = tm'.CAst.loc in
+      match DAst.get tm', na with
+      | GVar id, None when not (Id.Map.mem id (snd lvar)) -> Some id, CAst.make ?loc @@ Name id
+      | GRef (VarRef id, _), None -> Some id, CAst.make ?loc @@ Name id
+      | _, None -> None, CAst.make Anonymous
+      | _, Some ({ CAst.loc; v = na } as lna) -> None, lna in
     (* the "in" part *)
     let match_td,typ = match t with
     | Some t ->
-	let with_letin,(ind,l) = intern_ind_pattern globalenv (None,env.scopes) t in
+        let with_letin,(ind,l) = intern_ind_pattern globalenv ntnvars (None,env.scopes) t in
 	let (mib,mip) = Inductive.lookup_mind_specif globalenv ind in
 	let nparams = (List.length (mib.Declarations.mind_params_ctxt)) in
 	(* for "in Vect n", we answer (["n","n"],[(loc,"n")])
@@ -1870,38 +2103,34 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
 	let (match_to_do,nal) =
 	  let rec canonize_args case_rel_ctxt arg_pats forbidden_names match_acc var_acc =
 	    let add_name l = function
-	      | _,Anonymous -> l
-	      | loc,(Name y as x) -> (y, CAst.make ?loc @@ PatVar x) :: l in
+              | { CAst.v = Anonymous } -> l
+              | { CAst.loc; v = (Name y as x) } -> (y, DAst.make ?loc @@ PatVar x) :: l in
 	    match case_rel_ctxt,arg_pats with
 	      (* LetIn in the rel_context *)
 	      | LocalDef _ :: t, l when not with_letin ->
 		canonize_args t l forbidden_names match_acc ((Loc.tag Anonymous)::var_acc)
 	      | [],[] ->
 		(add_name match_acc na, var_acc)
-	      | _::t, { loc; v = PatVar x}::tt ->
-		canonize_args t tt forbidden_names
-		  (add_name match_acc (loc,x)) ((loc,x)::var_acc)
 	      | (LocalAssum (cano_name,ty) | LocalDef (cano_name,_,ty)) :: t, c::tt ->
-		let fresh =
-		  Namegen.next_name_away_with_default_using_types "iV" cano_name forbidden_names (EConstr.of_constr ty) in
-		canonize_args t tt (fresh::forbidden_names)
-		  ((fresh,c)::match_acc) ((cases_pattern_loc c,Name fresh)::var_acc)
+                begin match DAst.get c with
+                | PatVar x ->
+                  let loc = c.CAst.loc in
+                  canonize_args t tt forbidden_names
+                    (add_name match_acc CAst.(make ?loc x)) ((loc,x)::var_acc)
+                | _ ->
+                  let fresh =
+                    Namegen.next_name_away_with_default_using_types "iV" cano_name forbidden_names (EConstr.of_constr ty) in
+                  canonize_args t tt (Id.Set.add fresh forbidden_names)
+                    ((fresh,c)::match_acc) ((cases_pattern_loc c,Name fresh)::var_acc)
+                end
 	      | _ -> assert false in
 	  let _,args_rel =
 	    List.chop nparams (List.rev mip.Declarations.mind_arity_ctxt) in
-	  canonize_args args_rel l (Id.Set.elements forbidden_names_for_gen) [] [] in
+	  canonize_args args_rel l forbidden_names_for_gen [] [] in
 	match_to_do, Some (cases_pattern_expr_loc t,(ind,List.rev_map snd nal))
     | None ->
       [], None in
-    (tm',(snd na,typ)), extra_id, match_td
-
-  and iterate_prod ?loc env bk ty body nal =
-    let env, bl = intern_assumption intern ntnvars env nal bk ty in
-    it_mkGProd ?loc bl (intern_type env body)
-
-  and iterate_lam loc env bk ty body nal =
-    let env, bl = intern_assumption intern ntnvars env nal bk ty in
-    it_mkGLambda ?loc bl (intern env body)
+    (tm',(na.CAst.v,typ)), extra_id, match_td
 
   and intern_impargs c env l subscopes args =
     let eargs, rargs = extract_explicit_arg l args in
@@ -1924,7 +2153,7 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
             (* with implicit arguments if maximal insertion is set *)
 	    []
 	  else
-              (CAst.map_from_loc (fun ?loc (a,b,c) -> GHole(a,b,c))
+              (DAst.map_from_loc (fun ?loc (a,b,c) -> GHole(a,b,c))
                 (set_hole_implicit (n,get_implicit_name n l) (force_inference_of imp) c)
               ) :: aux (n+1) impl' subscopes' eargs rargs
 	  end
@@ -1935,7 +2164,7 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
 	    (let (id,(loc,_)) = Id.Map.choose eargs in
 	       user_err ?loc  (str "Not enough non implicit \
 	    arguments to accept the argument bound to " ++
-		 pr_id id ++ str"."));
+		 Id.print id ++ str"."));
 	  []
       | ([], rargs) ->
 	  assert (Id.Map.is_empty eargs);
@@ -1943,16 +2172,17 @@ let internalize globalenv env pattern_mode (_, ntnvars as lvar) c =
     in aux 1 l subscopes eargs rargs
 
   and apply_impargs c env imp subscopes l loc =
-    let l : (Constrexpr.constr_expr * Constrexpr.explicitation Loc.located option) list = l 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
 
   and smart_gapp f loc = function
     | [] -> f
-    | l -> match f with
-      | { loc = loc'; v = GApp (g, args) } -> CAst.make ?loc:(Loc.merge_opt loc' loc) @@ GApp (g, args@l)
-      | _ -> CAst.make ?loc:(Loc.merge_opt (loc_of_glob_constr f) loc) @@ GApp (f, l)
+    | l ->
+      let loc' = f.CAst.loc in
+      match DAst.get f with
+      | GApp (g, args) -> DAst.make ?loc:(Loc.merge_opt loc' loc) @@ GApp (g, args@l)
+      | _ -> DAst.make ?loc:(Loc.merge_opt (loc_of_glob_constr f) loc) @@ GApp (f, l)
 
   and intern_args env subscopes = function
     | [] -> []
@@ -2003,7 +2233,7 @@ let intern_type env c = intern_gen IsType env c
 
 let intern_pattern globalenv patt =
   try
-    intern_cases_pattern globalenv (None,[]) empty_alias patt
+    intern_cases_pattern globalenv Id.Map.empty (None,[]) empty_alias patt
   with
       InternalizationError (loc,e) ->
 	user_err ?loc ~hdr:"internalize" (explain_internalization_error e)
@@ -2034,39 +2264,36 @@ let interp_open_constr env sigma c =
 
 (* Not all evars expected to be resolved and computation of implicit args *)
 
-let interp_constr_evars_gen_impls env evdref
+let interp_constr_evars_gen_impls env sigma
     ?(impls=empty_internalization_env) expected_type c =
   let c = intern_gen expected_type ~impls env c in
   let imps = Implicit_quantifiers.implicits_of_glob_constr ~with_products:(expected_type == IsType) c in
-  let evd, c = understand_tcc env !evdref ~expected_type c in
-  evdref := evd;
-  c, imps
+  let sigma, c = understand_tcc env sigma ~expected_type c in
+  sigma, (c, imps)
 
-let interp_constr_evars_impls env evdref ?(impls=empty_internalization_env) c =
-  interp_constr_evars_gen_impls env evdref ~impls WithoutTypeConstraint c
+let interp_constr_evars_impls env sigma ?(impls=empty_internalization_env) c =
+  interp_constr_evars_gen_impls env sigma ~impls WithoutTypeConstraint c
 
 let interp_casted_constr_evars_impls env evdref ?(impls=empty_internalization_env) c typ =
   interp_constr_evars_gen_impls env evdref ~impls (OfType typ) c
 
-let interp_type_evars_impls env evdref ?(impls=empty_internalization_env) c =
-  interp_constr_evars_gen_impls env evdref ~impls IsType c
+let interp_type_evars_impls env sigma ?(impls=empty_internalization_env) c =
+  interp_constr_evars_gen_impls env sigma ~impls IsType c
 
 (* Not all evars expected to be resolved, with side-effect on evars *)
 
-let interp_constr_evars_gen env evdref ?(impls=empty_internalization_env) expected_type c =
+let interp_constr_evars_gen env sigma ?(impls=empty_internalization_env) expected_type c =
   let c = intern_gen expected_type ~impls env c in
-  let evd, c = understand_tcc env !evdref ~expected_type c in
-  evdref := evd;
-  c
+  understand_tcc env sigma ~expected_type c
 
 let interp_constr_evars env evdref ?(impls=empty_internalization_env) c =
   interp_constr_evars_gen env evdref WithoutTypeConstraint ~impls c
 
-let interp_casted_constr_evars env evdref ?(impls=empty_internalization_env) c typ =
-  interp_constr_evars_gen env evdref ~impls (OfType (EConstr.of_constr typ)) c
+let interp_casted_constr_evars env sigma ?(impls=empty_internalization_env) c typ =
+  interp_constr_evars_gen env sigma ~impls (OfType typ) c
 
-let interp_type_evars env evdref ?(impls=empty_internalization_env) c =
-  interp_constr_evars_gen env evdref IsType ~impls c
+let interp_type_evars env sigma ?(impls=empty_internalization_env) c =
+  interp_constr_evars_gen env sigma IsType ~impls c
 
 (* Miscellaneous *)
 
@@ -2075,10 +2302,10 @@ let intern_constr_pattern env ?(as_type=false) ?(ltacvars=empty_ltac_sign) c =
             ~pattern_mode:true ~ltacvars env c in
   pattern_of_glob_constr c
 
-let interp_notation_constr ?(impls=empty_internalization_env) nenv a =
-  let env = Global.env () in
+let interp_notation_constr env ?(impls=empty_internalization_env) nenv a =
   (* [vl] is intended to remember the scope of the free variables of [a] *)
-  let vl = Id.Map.map (fun typ -> (ref true, ref None, typ)) nenv.ninterp_var_type in
+  let vl = Id.Map.map (fun typ -> (ref false, ref None, typ)) nenv.ninterp_var_type in
+  let impls = Id.Map.fold (fun id _ impls -> Id.Map.remove id impls) nenv.ninterp_var_type impls in
   let c = internalize (Global.env()) {ids = extract_ids env; unb = false;
 						tmp_scope = None; scopes = []; impls = impls}
     false (empty_ltac_sign, vl) a in
@@ -2087,8 +2314,9 @@ let interp_notation_constr ?(impls=empty_internalization_env) nenv a =
   (* 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
+  let unused = match reversible with NonInjective ids -> ids | _ -> [] in
+  let vars = Id.Map.mapi (fun id (used_as_binder, sc, typ) ->
+    (!used_as_binder && not (List.mem_f Id.equal id unused), out_scope !sc)) vl in
   (* Returns [a] and the ordered list of variables with their scopes *)
   vars, a, reversible
 
@@ -2122,17 +2350,16 @@ let intern_context global_level env impl_env binders =
   with InternalizationError (loc,e) ->
     user_err ?loc ~hdr:"internalize" (explain_internalization_error e)
 
-let interp_glob_context_evars env evdref k bl =
+let interp_glob_context_evars env sigma k bl =
   let open EConstr in
-  let (env, par, _, impls) =
+  let env, sigma, par, _, impls =
     List.fold_left
-      (fun (env,params,n,impls) (na, k, b, t) ->
+      (fun (env,sigma,params,n,impls) (na, k, b, t) ->
        let t' =
 	 if Option.is_empty b then locate_if_hole ?loc:(loc_of_glob_constr t) na t
 	 else t
        in
-       let (evd,t) = understand_tcc env !evdref ~expected_type:IsType t' in
-       evdref := evd;
+       let sigma, t = understand_tcc env sigma ~expected_type:IsType t' in
 	match b with
 	    None ->
 	      let d = LocalAssum (na,t) in
@@ -2142,17 +2369,15 @@ let interp_glob_context_evars env evdref k bl =
 		    (ExplByPos (n, na), (true, true, true)) :: impls
 		else impls
 	      in
-		(push_rel d env, d::params, succ n, impls)
+                (push_rel d env, sigma, d::params, succ n, impls)
 	  | Some b ->
-	      let (evd,c) = understand_tcc env !evdref ~expected_type:(OfType t) b in
-              evdref := evd;
+              let sigma, c = understand_tcc env sigma ~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
+                (push_rel d env, sigma, d::params, n, impls))
+      (env,sigma,[],k+1,[]) (List.rev bl)
+  in sigma, ((env, par), impls)
 
-let interp_context_evars ?(global_level=false) ?(impl_env=empty_internalization_env) ?(shift=0) env evdref params =
+let interp_context_evars ?(global_level=false) ?(impl_env=empty_internalization_env) ?(shift=0) env sigma params =
   let int_env,bl = intern_context global_level env impl_env params in
-  let x = interp_glob_context_evars env evdref shift bl in
-  int_env, x
-
+  let sigma, x = interp_glob_context_evars env sigma shift bl in
+  sigma, (int_env, x)
diff --git a/interp/constrintern.mli b/interp/constrintern.mli
index 0a4eaf838..7411fb84b 100644
--- a/interp/constrintern.mli
+++ b/interp/constrintern.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Evd
 open Environ
 open Libnames
@@ -87,7 +87,7 @@ val intern_gen : typing_constraint -> env ->
   constr_expr -> glob_constr
 
 val intern_pattern : env -> cases_pattern_expr ->
-  Id.t list * (Id.t Id.Map.t * cases_pattern) list
+  lident list * (Id.t Id.Map.t * cases_pattern) list
 
 val intern_context : bool -> env -> internalization_env -> local_binder_expr list -> internalization_env * glob_decl list
 
@@ -112,28 +112,28 @@ val interp_open_constr : env -> evar_map -> constr_expr -> evar_map * EConstr.co
 
 (** Accepting unresolved evars *)
 
-val interp_constr_evars : env -> evar_map ref ->
-  ?impls:internalization_env -> constr_expr -> EConstr.constr
+val interp_constr_evars : env -> evar_map ->
+  ?impls:internalization_env -> constr_expr -> evar_map * EConstr.constr
 
-val interp_casted_constr_evars : env -> evar_map ref ->
-  ?impls:internalization_env -> constr_expr -> types -> EConstr.constr
+val interp_casted_constr_evars : env -> evar_map ->
+  ?impls:internalization_env -> constr_expr -> EConstr.types -> evar_map * EConstr.constr
 
-val interp_type_evars : env -> evar_map ref ->
-  ?impls:internalization_env -> constr_expr -> EConstr.types
+val interp_type_evars : env -> evar_map ->
+  ?impls:internalization_env -> constr_expr -> evar_map * EConstr.types
 
 (** Accepting unresolved evars and giving back the manual implicit arguments *)
 
-val interp_constr_evars_impls : env -> evar_map ref ->
+val interp_constr_evars_impls : env -> evar_map ->
   ?impls:internalization_env -> constr_expr ->
-  EConstr.constr * Impargs.manual_implicits
+  evar_map * (EConstr.constr * Impargs.manual_implicits)
 
-val interp_casted_constr_evars_impls : env -> evar_map ref ->
+val interp_casted_constr_evars_impls : env -> evar_map ->
   ?impls:internalization_env -> constr_expr -> EConstr.types ->
-  EConstr.constr * Impargs.manual_implicits
+  evar_map * (EConstr.constr * Impargs.manual_implicits)
 
-val interp_type_evars_impls : env -> evar_map ref ->
+val interp_type_evars_impls : env -> evar_map ->
   ?impls:internalization_env -> constr_expr ->
-  EConstr.types * Impargs.manual_implicits
+  evar_map * (EConstr.types * Impargs.manual_implicits)
 
 (** Interprets constr patterns *)
 
@@ -158,8 +158,8 @@ val interp_binder_evars : env -> evar_map ref -> Name.t -> constr_expr -> EConst
 
 val interp_context_evars :
   ?global_level:bool -> ?impl_env:internalization_env -> ?shift:int ->
-  env -> evar_map ref -> local_binder_expr list ->
-  internalization_env * ((env * EConstr.rel_context) * Impargs.manual_implicits)
+  env -> evar_map -> local_binder_expr list ->
+  evar_map * (internalization_env * ((env * EConstr.rel_context) * Impargs.manual_implicits))
 
 (* val interp_context_gen : (env -> glob_constr -> unsafe_type_judgment Evd.in_evar_universe_context) -> *)
 (*   (env -> Evarutil.type_constraint -> glob_constr -> unsafe_judgment Evd.in_evar_universe_context) -> *)
@@ -182,10 +182,9 @@ val global_reference_in_absolute_module : DirPath.t -> Id.t -> Globnames.global_
 
 (** Interprets a term as the left-hand side of a notation. The returned map is
     guaranteed to have the same domain as the input one. *)
-val interp_notation_constr : ?impls:internalization_env ->
+val interp_notation_constr : env -> ?impls:internalization_env ->
   notation_interp_env -> constr_expr ->
-  (bool * subscopes * notation_var_internalization_type) Id.Map.t *
-  notation_constr * reversibility_flag
+  (bool * subscopes) Id.Map.t * notation_constr * reversibility_status
 
 (** Globalization options *)
 val parsing_explicit : bool ref
diff --git a/interp/declare.ml b/interp/declare.ml
index 7fcb38296..dfa84f278 100644
--- a/interp/declare.ml
+++ b/interp/declare.ml
@@ -14,8 +14,7 @@ open Util
 open Names
 open Libnames
 open Globnames
-open Nameops
-open Term
+open Constr
 open Declarations
 open Entries
 open Libobject
@@ -32,64 +31,6 @@ type internal_flag =
   | InternalTacticRequest  (* kernel action, no message is displayed *)
   | UserIndividualRequest   (* user action, a message is displayed *)
 
-(** Declaration of section variables and local definitions *)
-
-type section_variable_entry =
-  | SectionLocalDef of Safe_typing.private_constants definition_entry
-  | SectionLocalAssum of types Univ.in_universe_context_set * polymorphic * bool (** Implicit status *)
-
-type variable_declaration = DirPath.t * section_variable_entry * logical_kind
-
-let cache_variable ((sp,_),o) =
-  match o with
-  | Inl ctx -> Global.push_context_set false ctx
-  | Inr (id,(p,d,mk)) ->
-  (* Constr raisonne sur les noms courts *)
-  if variable_exists id then
-    alreadydeclared (pr_id id ++ str " already exists");
-
-  let impl,opaq,poly,ctx = match d with (* Fails if not well-typed *)
-    | SectionLocalAssum ((ty,ctx),poly,impl) ->
-      let () = Global.push_named_assum ((id,ty,poly),ctx) in
-      let impl = if impl then Implicit else Explicit in
-	impl, true, poly, ctx
-    | SectionLocalDef (de) ->
-      let univs = Global.push_named_def (id,de) in
-      let poly = match de.const_entry_universes with
-      | Monomorphic_const_entry _ -> false
-      | Polymorphic_const_entry _ -> true
-      in
-      Explicit, de.const_entry_opaque,
-      poly, univs in
-  Nametab.push (Nametab.Until 1) (restrict_path 0 sp) (VarRef id);
-  add_section_variable id impl poly ctx;
-  Dischargedhypsmap.set_discharged_hyps sp [];
-  add_variable_data id (p,opaq,ctx,poly,mk)
-
-let discharge_variable (_,o) = match o with
-  | Inr (id,_) ->
-    if variable_polymorphic id then None
-    else Some (Inl (variable_context id))
-  | Inl _ -> Some o
-
-type variable_obj =
-    (Univ.ContextSet.t, Id.t * variable_declaration) union
-
-let inVariable : variable_obj -> obj =
-  declare_object { (default_object "VARIABLE") with
-    cache_function = cache_variable;
-    discharge_function = discharge_variable;
-    classify_function = (fun _ -> Dispose) }
-
-(* for initial declaration *)
-let declare_variable id obj =
-  let oname = add_leaf id (inVariable (Inr (id,obj))) in
-  declare_var_implicits id;
-  Notation.declare_ref_arguments_scope (VarRef id);
-  Heads.declare_head (EvalVarRef id);
-  oname
-
-
 (** Declaration of constants and parameters *)
 
 type constant_obj = {
@@ -107,7 +48,7 @@ type constant_declaration = Safe_typing.private_constants constant_entry * logic
 (* section (if Remark or Fact) is needed to access a construction *)
 let load_constant i ((sp,kn), obj) =
   if Nametab.exists_cci sp then
-    alreadydeclared (pr_id (basename sp) ++ str " already exists");
+    alreadydeclared (Id.print (basename sp) ++ str " already exists");
   let con = Global.constant_of_delta_kn kn in
   Nametab.push (Nametab.Until i) sp (ConstRef con);
   add_constant_kind con obj.cst_kind
@@ -132,38 +73,38 @@ let exists_name id =
 
 let check_exists sp =
   let id = basename sp in
-  if exists_name id then alreadydeclared (pr_id id ++ str " already exists")
+  if exists_name id then alreadydeclared (Id.print id ++ str " already exists")
 
 let cache_constant ((sp,kn), obj) =
   let id = basename sp in
-  let _,dir,_ = repr_kn kn in
+  let _,dir,_ = KerName.repr kn in
   let kn' =
     match obj.cst_decl with
     | None ->
       if Global.exists_objlabel (Label.of_id (basename sp))
-      then constant_of_kn kn
+      then Constant.make1 kn
       else CErrors.anomaly Pp.(str"Ex seff not found: " ++ Id.print(basename sp) ++ str".")
     | Some decl ->
       let () = check_exists sp in
       Global.add_constant dir id decl
   in
-  assert (eq_constant kn' (constant_of_kn kn));
-  Nametab.push (Nametab.Until 1) sp (ConstRef (constant_of_kn kn));
+  assert (Constant.equal kn' (Constant.make1 kn));
+  Nametab.push (Nametab.Until 1) sp (ConstRef (Constant.make1 kn));
   let cst = Global.lookup_constant kn' in
   add_section_constant (Declareops.constant_is_polymorphic cst) kn' cst.const_hyps;
   Dischargedhypsmap.set_discharged_hyps sp obj.cst_hyps;
-  add_constant_kind (constant_of_kn kn) obj.cst_kind
+  add_constant_kind (Constant.make1 kn) obj.cst_kind
 
 let discharged_hyps kn sechyps =
-  let (_,dir,_) = repr_kn kn in
+  let (_,dir,_) = KerName.repr kn in
   let args = Array.to_list (instance_from_variable_context sechyps) in
   List.rev_map (Libnames.make_path dir) args
 
 let discharge_constant ((sp, kn), obj) =
-  let con = constant_of_kn kn in
+  let con = Constant.make1 kn in
   let from = Global.lookup_constant con in
   let modlist = replacement_context () in
-  let hyps,subst,uctx = section_segment_of_constant con in
+  let { abstr_ctx = hyps; abstr_subst = subst; abstr_uctx = uctx } = section_segment_of_constant con in
   let new_hyps = (discharged_hyps kn hyps) @ obj.cst_hyps in
   let abstract = (named_of_variable_context hyps, subst, uctx) in
   let new_decl = GlobalRecipe{ from; info = { Opaqueproof.modlist; abstract}} in
@@ -196,6 +137,20 @@ let update_tables c =
   Heads.declare_head (EvalConstRef c);
   Notation.declare_ref_arguments_scope (ConstRef c)
 
+let register_side_effect (c, role) =
+  let o = inConstant {
+    cst_decl = None;
+    cst_hyps = [] ;
+    cst_kind = IsProof Theorem;
+    cst_locl = false;
+  } in
+  let id = Label.to_id (pi3 (Constant.repr3 c)) in
+  ignore(add_leaf id o);
+  update_tables c;
+  match role with
+  | Safe_typing.Subproof -> ()
+  | Safe_typing.Schema (ind, kind) -> !declare_scheme kind [|ind,c|]
+
 let declare_constant_common id cst =
   let o = inConstant cst in
   let _, kn as oname = add_leaf id o in
@@ -204,12 +159,9 @@ let declare_constant_common id cst =
   update_tables c;
   c
 
+let default_univ_entry = Monomorphic_const_entry Univ.ContextSet.empty
 let definition_entry ?fix_exn ?(opaque=false) ?(inline=false) ?types
-    ?(poly=false) ?(univs=Univ.UContext.empty) ?(eff=Safe_typing.empty_private_constants) body =
-  let univs =
-    if poly then Polymorphic_const_entry univs
-    else Monomorphic_const_entry univs
-  in
+    ?(univs=default_univ_entry) ?(eff=Safe_typing.empty_private_constants) body =
   { const_entry_body = Future.from_val ?fix_exn ((body,Univ.ContextSet.empty), eff);
     const_entry_secctx = None;
     const_entry_type = types;
@@ -233,25 +185,11 @@ let declare_constant ?(internal = UserIndividualRequest) ?(local = false) id ?(e
       (** This globally defines the side-effects in the environment. We mark
           exported constants as being side-effect not to redeclare them at
           caching time. *)
-      let cd, export = Global.export_private_constants ~in_section cd in
-      export, ConstantEntry (PureEntry, cd)
+      let de, export = Global.export_private_constants ~in_section de in
+      export, ConstantEntry (PureEntry, DefinitionEntry de)
     | _ -> [], ConstantEntry (EffectEntry, cd)
   in
-  let iter_eff (c, role) =
-    let o = inConstant {
-      cst_decl = None;
-      cst_hyps = [] ;
-      cst_kind = IsProof Theorem;
-      cst_locl = false;
-    } in
-    let id = Label.to_id (pi3 (Constant.repr3 c)) in
-    ignore(add_leaf id o);
-    update_tables c;
-    match role with
-    | Safe_typing.Subproof -> ()
-    | Safe_typing.Schema (ind, kind) -> !declare_scheme kind [|ind,c|]
-  in
-  let () = List.iter iter_eff export in
+  let () = List.iter register_side_effect export in
   let cst = {
     cst_decl = Some decl;
     cst_hyps = [] ;
@@ -262,13 +200,85 @@ let declare_constant ?(internal = UserIndividualRequest) ?(local = false) id ?(e
 
 let declare_definition ?(internal=UserIndividualRequest)
   ?(opaque=false) ?(kind=Decl_kinds.Definition) ?(local = false)
-  ?(poly=false) id ?types (body,ctx) =
+  id ?types (body,univs) =
   let cb =
-    definition_entry ?types ~poly ~univs:(Univ.ContextSet.to_context ctx) ~opaque body
+    definition_entry ?types ~univs ~opaque body
   in
     declare_constant ~internal ~local id
       (Entries.DefinitionEntry cb, Decl_kinds.IsDefinition kind)
 
+(** Declaration of section variables and local definitions *)
+
+type section_variable_entry =
+  | SectionLocalDef of Safe_typing.private_constants definition_entry
+  | SectionLocalAssum of types Univ.in_universe_context_set * polymorphic * bool (** Implicit status *)
+
+type variable_declaration = DirPath.t * section_variable_entry * logical_kind
+
+let cache_variable ((sp,_),o) =
+  match o with
+  | Inl ctx -> Global.push_context_set false ctx
+  | Inr (id,(p,d,mk)) ->
+  (* Constr raisonne sur les noms courts *)
+  if variable_exists id then
+    alreadydeclared (Id.print id ++ str " already exists");
+
+  let impl,opaq,poly,ctx = match d with (* Fails if not well-typed *)
+    | SectionLocalAssum ((ty,ctx),poly,impl) ->
+      let () = Global.push_named_assum ((id,ty,poly),ctx) in
+      let impl = if impl then Implicit else Explicit in
+        impl, true, poly, ctx
+    | SectionLocalDef (de) ->
+      let (de, eff) = Global.export_private_constants ~in_section:true de in
+      let () = List.iter register_side_effect eff in
+      (** The body should already have been forced upstream because it is a
+          section-local definition, but it's not enforced by typing *)
+      let (body, uctx), () = Future.force de.const_entry_body in
+      let poly, univs = match de.const_entry_universes with
+      | Monomorphic_const_entry uctx -> false, uctx
+      | Polymorphic_const_entry uctx -> true, Univ.ContextSet.of_context uctx
+      in
+      let univs = Univ.ContextSet.union uctx univs in
+      (** We must declare the universe constraints before type-checking the
+          term. *)
+      let () = Global.push_context_set (not poly) univs in
+      let se = {
+        secdef_body = body;
+        secdef_secctx = de.const_entry_secctx;
+        secdef_feedback = de.const_entry_feedback;
+        secdef_type = de.const_entry_type;
+      } in
+      let () = Global.push_named_def (id, se) in
+      Explicit, de.const_entry_opaque,
+      poly, univs in
+  Nametab.push (Nametab.Until 1) (restrict_path 0 sp) (VarRef id);
+  add_section_variable id impl poly ctx;
+  Dischargedhypsmap.set_discharged_hyps sp [];
+  add_variable_data id (p,opaq,ctx,poly,mk)
+
+let discharge_variable (_,o) = match o with
+  | Inr (id,_) ->
+    if variable_polymorphic id then None
+    else Some (Inl (variable_context id))
+  | Inl _ -> Some o
+
+type variable_obj =
+    (Univ.ContextSet.t, Id.t * variable_declaration) union
+
+let inVariable : variable_obj -> obj =
+  declare_object { (default_object "VARIABLE") with
+    cache_function = cache_variable;
+    discharge_function = discharge_variable;
+    classify_function = (fun _ -> Dispose) }
+
+(* for initial declaration *)
+let declare_variable id obj =
+  let oname = add_leaf id (inVariable (Inr (id,obj))) in
+  declare_var_implicits id;
+  Notation.declare_ref_arguments_scope (VarRef id);
+  Heads.declare_head (EvalVarRef id);
+  oname
+
 (** Declaration of inductive blocks *)
 
 let declare_inductive_argument_scopes kn mie =
@@ -311,9 +321,9 @@ let cache_inductive ((sp,kn),(dhyps,mie)) =
   let names = inductive_names sp kn mie in
   List.iter check_exists (List.map fst names);
   let id = basename sp in
-  let _,dir,_ = repr_kn kn in
+  let _,dir,_ = KerName.repr kn in
   let kn' = Global.add_mind dir id mie in
-  assert (eq_mind kn' (mind_of_kn kn));
+  assert (MutInd.equal kn' (MutInd.make1 kn));
   let mind = Global.lookup_mind kn' in
   add_section_kn (Declareops.inductive_is_polymorphic mind) kn' mind.mind_hyps;
   Dischargedhypsmap.set_discharged_hyps sp dhyps;
@@ -323,7 +333,8 @@ let discharge_inductive ((sp,kn),(dhyps,mie)) =
   let mind = Global.mind_of_delta_kn kn in
   let mie = Global.lookup_mind mind in
   let repl = replacement_context () in
-  let sechyps, _, _ as info = section_segment_of_mutual_inductive mind in
+  let info = section_segment_of_mutual_inductive mind in
+  let sechyps = info.Lib.abstr_ctx in
   Some (discharged_hyps kn sechyps,
         Discharge.process_inductive info repl mie)
 
@@ -339,9 +350,9 @@ let dummy_one_inductive_entry mie = {
 let dummy_inductive_entry (_,m) = ([],{
   mind_entry_params = [];
   mind_entry_record = None;
-  mind_entry_finite = Decl_kinds.BiFinite;
+  mind_entry_finite = Declarations.BiFinite;
   mind_entry_inds = List.map dummy_one_inductive_entry m.mind_entry_inds;
-  mind_entry_universes = Monomorphic_ind_entry Univ.UContext.empty;
+  mind_entry_universes = Monomorphic_ind_entry Univ.ContextSet.empty;
   mind_entry_private = None;
 })
 
@@ -353,13 +364,8 @@ let infer_inductive_subtyping (pth, mind_ent) =
   | Cumulative_ind_entry cumi ->
     begin
       let env = Global.env () in
-      let env' =
-        Environ.push_context
-          (Univ.CumulativityInfo.univ_context cumi) env
-      in
       (* let (env'', typed_params) = Typeops.infer_local_decls env' (mind_ent.mind_entry_params) in *)
-      let evd = Evd.from_env env' in
-        (pth, Inductiveops.infer_inductive_subtyping env' evd mind_ent)
+        (pth, InferCumulativity.infer_inductive env mind_ent)
     end
 
 type inductive_obj = Dischargedhypsmap.discharged_hyps * mutual_inductive_entry
@@ -384,7 +390,7 @@ let declare_projections mind =
 	let kn' = declare_constant id (ProjectionEntry entry,
 				       IsDefinition StructureComponent)
 	in
-	  assert(eq_constant kn kn')) kns; true,true
+	  assert(Constant.equal kn kn')) kns; true,true
     | Some None -> true,false
     | None -> false,false
 
@@ -407,11 +413,11 @@ let pr_rank i = pr_nth (i+1)
 let fixpoint_message indexes l =
   Flags.if_verbose Feedback.msg_info (match l with
   | [] -> anomaly (Pp.str "no recursive definition.")
-  | [id] -> pr_id id ++ str " is recursively defined" ++
+  | [id] -> Id.print id ++ str " is recursively defined" ++
       (match indexes with
 	 | Some [|i|] -> str " (decreasing on "++pr_rank i++str " argument)"
 	 | _ -> mt ())
-  | l -> hov 0 (prlist_with_sep pr_comma pr_id l ++
+  | l -> hov 0 (prlist_with_sep pr_comma Id.print l ++
 		  spc () ++ str "are recursively defined" ++
 		  match indexes with
 		    | Some a -> spc () ++ str "(decreasing respectively on " ++
@@ -422,25 +428,25 @@ let fixpoint_message indexes l =
 let cofixpoint_message l =
   Flags.if_verbose Feedback.msg_info (match l with
   | [] -> anomaly (Pp.str "No corecursive definition.")
-  | [id] -> pr_id id ++ str " is corecursively defined"
-  | l -> hov 0 (prlist_with_sep pr_comma pr_id l ++
+  | [id] -> Id.print id ++ str " is corecursively defined"
+  | l -> hov 0 (prlist_with_sep pr_comma Id.print l ++
                     spc () ++ str "are corecursively defined"))
 
 let recursive_message isfix i l =
   (if isfix then fixpoint_message i else cofixpoint_message) l
 
 let definition_message id =
-  Flags.if_verbose Feedback.msg_info (pr_id id ++ str " is defined")
+  Flags.if_verbose Feedback.msg_info (Id.print id ++ str " is defined")
 
 let assumption_message id =
   (* Changing "assumed" to "declared", "assuming" referring more to
   the type of the object than to the name of the object (see
   discussion on coqdev: "Chapter 4 of the Reference Manual", 8/10/2015) *)
-  Flags.if_verbose Feedback.msg_info (pr_id id ++ str " is declared")
+  Flags.if_verbose Feedback.msg_info (Id.print id ++ str " is declared")
 
 (** Global universe names, in a different summary *)
 
-type universe_context_decl = polymorphic * Univ.universe_context_set
+type universe_context_decl = polymorphic * Univ.ContextSet.t
 
 let cache_universe_context (p, ctx) =
   Global.push_context_set p ctx;
@@ -457,28 +463,95 @@ let input_universe_context : universe_context_decl -> Libobject.obj =
 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 = Global.global_universe_names () in
-  let glob', ctx =
-    List.fold_left (fun ((idl,lid),ctx) (id, lev) ->
-        ((Idmap.add id (p, lev) idl,
-          Univ.LMap.add lev id lid),
-         Univ.ContextSet.add_universe lev ctx))
-      (glob, Univ.ContextSet.empty) l
+(** Global universes are not substitutive objects but global objects
+   bound at the *library* or *module* level. The polymorphic flag is
+   used to distinguish universes declared in polymorphic sections, which
+   are discharged and do not remain in scope. *)
+
+type universe_source =
+  | BoundUniv (* polymorphic universe, bound in a function (this will go away someday) *)
+  | QualifiedUniv of Id.t (* global universe introduced by some global value *)
+  | UnqualifiedUniv (* other global universe *)
+
+type universe_decl = universe_source * Nametab.universe_id
+
+let add_universe src (dp, i) =
+  let level = Univ.Level.make dp i in
+  let optpoly = match src with
+    | BoundUniv -> Some true
+    | UnqualifiedUniv -> Some false
+    | QualifiedUniv _ -> None
   in
-  cache_universe_context (p, ctx);
-  Global.set_global_universe_names glob'
+  Option.iter (fun poly ->
+      let ctx = Univ.ContextSet.add_universe level Univ.ContextSet.empty in
+      Global.push_context_set poly ctx;
+      Universes.add_global_universe level poly;
+      if poly then Lib.add_section_context ctx)
+    optpoly
 
-let input_universes : universe_decl -> Libobject.obj =
+let check_exists sp =
+  let depth = sections_depth () in
+  let sp = Libnames.make_path (pop_dirpath_n depth (dirpath sp)) (basename sp) in
+  if Nametab.exists_universe sp then
+    alreadydeclared (str "Universe " ++ Id.print (basename sp) ++ str " already exists")
+  else ()
+
+let qualify_univ src (sp,i as orig) =
+  match src with
+  | BoundUniv | UnqualifiedUniv -> orig
+  | QualifiedUniv l ->
+    let sp0, id = Libnames.repr_path sp in
+    let sp0 = DirPath.repr sp0 in
+    Libnames.make_path (DirPath.make (l::sp0)) id, i+1
+
+let cache_universe ((sp, _), (src, id)) =
+  let sp, i = qualify_univ src (sp,1) in
+  let () = check_exists sp in
+  let () = Nametab.push_universe (Nametab.Until i) sp id in
+    add_universe src id
+
+let load_universe i ((sp, _), (src, id)) =
+  let sp, i = qualify_univ src (sp,i) in
+  let () = Nametab.push_universe (Nametab.Until i) sp id in
+  add_universe src id
+
+let open_universe i ((sp, _), (src, id)) =
+  let sp, i = qualify_univ src (sp,i) in
+  let () = Nametab.push_universe (Nametab.Exactly i) sp id in
+  ()
+
+let discharge_universe = function
+  | _, (BoundUniv, _) -> None
+  | _, ((QualifiedUniv _ | UnqualifiedUniv), _ as x) -> Some x
+
+let input_universe : universe_decl -> Libobject.obj =
   declare_object
     { (default_object "Global universe name state") with
-      cache_function = (fun (na, pi) -> cache_universes pi);
-      load_function = (fun _ (_, pi) -> cache_universes pi);
-      discharge_function = (fun (_, (p, _ as x)) -> if p then None else Some x);
-      classify_function = (fun a -> Keep a) }
+      cache_function = cache_universe;
+      load_function = load_universe;
+      open_function = open_universe;
+      discharge_function = discharge_universe;
+      subst_function = (fun (subst, a) -> (** Actually the name is generated once and for all. *) a);
+      classify_function = (fun a -> Substitute a) }
+
+let declare_univ_binders gr pl =
+  if Global.is_polymorphic gr then
+    Universes.register_universe_binders gr pl
+  else
+    let l = match gr with
+      | ConstRef c -> Label.to_id @@ Constant.label c
+      | IndRef (c, _) -> Label.to_id @@ MutInd.label c
+      | VarRef id -> id
+      | ConstructRef _ ->
+        anomaly ~label:"declare_univ_binders"
+          Pp.(str "declare_univ_binders on an constructor reference")
+    in
+    Id.Map.iter (fun id lvl ->
+        match Univ.Level.name lvl with
+        | None -> ()
+        | Some na ->
+          ignore (Lib.add_leaf id (input_universe (QualifiedUniv l, na))))
+      pl
 
 let do_universe poly l =
   let in_section = Lib.sections_are_opened () in
@@ -488,13 +561,16 @@ let do_universe poly l =
                    (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
-	      (id, lev)) l
+    List.map (fun {CAst.v=id} ->
+      let lev = Universes.new_univ_id () in
+      (id, lev)) l
   in
-    Lib.add_anonymous_leaf (input_universes (poly, l))
+  let src = if poly then BoundUniv else UnqualifiedUniv in
+  List.iter (fun (id,lev) ->
+      ignore(Lib.add_leaf id (input_universe (src, lev))))
+    l
 
-type constraint_decl = polymorphic * Univ.constraints
+type constraint_decl = polymorphic * Univ.Constraint.t
 
 let cache_constraints (na, (p, c)) =
   let ctx =
@@ -514,20 +590,15 @@ let input_constraints : constraint_decl -> Libobject.obj =
       discharge_function = discharge_constraints;
       classify_function = (fun a -> Keep a) }
 
+let loc_of_glob_level = function
+  | Misctypes.GType (Misctypes.UNamed n) -> Libnames.loc_of_reference n
+  | _ -> None
+
 let do_constraint poly l =
-  let open Misctypes in
   let u_of_id x =
-    match x with
-    | GProp -> Loc.tag (false, Univ.Level.prop)
-    | GSet  -> Loc.tag (false, Univ.Level.set)
-    | GType None | GType (Some (_, Anonymous)) ->
-       user_err ~hdr:"Constraint"
-                     (str "Cannot declare constraints on anonymous universes")
-    | GType (Some (loc, Name id)) ->
-       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)
+    let level = Pretyping.interp_known_glob_level (Evd.from_env (Global.env ())) x in
+    let loc = loc_of_glob_level x in
+    loc, Universes.is_polymorphic level, level
   in
   let in_section = Lib.sections_are_opened () in
   let () =
@@ -545,7 +616,7 @@ let do_constraint poly l =
                     ++ str "Polymorphic Constraint instead")
   in
   let constraints = List.fold_left (fun acc (l, d, r) ->
-     let ploc, (p, lu) = u_of_id l and rloc, (p', ru) = u_of_id r in
+     let ploc, p, lu = u_of_id l and rloc, p', ru = u_of_id r in
      check_poly ?loc:ploc p rloc p';
      Univ.Constraint.add (lu, d, ru) acc)
     Univ.Constraint.empty l
diff --git a/interp/declare.mli b/interp/declare.mli
index ccd7d28bb..9bec32d29 100644
--- a/interp/declare.mli
+++ b/interp/declare.mli
@@ -8,7 +8,7 @@
 
 open Names
 open Libnames
-open Term
+open Constr
 open Entries
 open Decl_kinds
 
@@ -42,7 +42,7 @@ type internal_flag =
 (* Defaut definition entries, transparent with no secctx or proj information *)
 val definition_entry : ?fix_exn:Future.fix_exn ->
   ?opaque:bool -> ?inline:bool -> ?types:types ->
-  ?poly:polymorphic -> ?univs:Univ.universe_context ->
+  ?univs:Entries.constant_universes_entry ->
   ?eff:Safe_typing.private_constants -> constr -> Safe_typing.private_constants definition_entry
 
 (** [declare_constant id cd] declares a global declaration
@@ -52,17 +52,17 @@ val definition_entry : ?fix_exn:Future.fix_exn ->
   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
+ ?internal:internal_flag -> ?local:bool -> Id.t -> ?export_seff:bool -> constant_declaration -> Constant.t
 
 val declare_definition : 
   ?internal:internal_flag -> ?opaque:bool -> ?kind:definition_object_kind ->
-  ?local:bool -> ?poly:polymorphic -> Id.t -> ?types:constr -> 
-  constr Univ.in_universe_context_set -> constant
+  ?local:bool -> Id.t -> ?types:constr ->
+  constr Entries.in_constant_universes_entry -> Constant.t
 
 (** Since transparent constants' side effects are globally declared, we
  *  need that *)
 val set_declare_scheme :
-  (string -> (inductive * constant) array -> unit) -> unit
+  (string -> (inductive * Constant.t) array -> unit) -> unit
 
 (** [declare_mind me] declares a block of inductive types with
    their constructors in the current section; it returns the path of
@@ -80,13 +80,11 @@ val recursive_message : bool (** true = fixpoint *) ->
 
 val exists_name : Id.t -> bool
 
-
-
 (** Global universe contexts, names and constraints *)
+val declare_univ_binders : Globnames.global_reference -> Universes.universe_binders -> unit
 
-val declare_universe_context : polymorphic -> Univ.universe_context_set -> unit
+val declare_universe_context : polymorphic -> Univ.ContextSet.t -> unit
 
-val do_universe : polymorphic -> Id.t Loc.located list -> unit
-val do_constraint : polymorphic ->
-  (Misctypes.glob_level * Univ.constraint_type * Misctypes.glob_level) list ->
-  unit
+val do_universe : polymorphic -> Misctypes.lident list -> unit
+val do_constraint : polymorphic -> (Misctypes.glob_level * Univ.constraint_type * Misctypes.glob_level) list ->
+                    unit
diff --git a/vernac/discharge.ml b/interp/discharge.ml
index 474c0b4dd..710f88c3f 100644
--- a/vernac/discharge.ml
+++ b/interp/discharge.ml
@@ -10,6 +10,7 @@ open Names
 open CErrors
 open Util
 open Term
+open Constr
 open Vars
 open Declarations
 open Cooking
@@ -36,32 +37,32 @@ let detype_param =
      I1..Ip:(B1 y1..yq)..(Bp y1..yq) |- ci : (y1..yq:C1..Cq)Ti[Ij:=(Ij y1..yq)]
 *)
 
-let abstract_inductive hyps nparams inds =
+let abstract_inductive decls nparamdecls inds =
   let ntyp = List.length inds in
-  let nhyp = Context.Named.length hyps in
-  let args = Context.Named.to_instance mkVar (List.rev hyps) in
+  let ndecls = Context.Named.length decls in
+  let args = Context.Named.to_instance mkVar (List.rev decls) in
   let args = Array.of_list args in
-  let subs = List.init ntyp (fun k -> lift nhyp (mkApp(mkRel (k+1),args))) in
+  let subs = List.init ntyp (fun k -> lift ndecls (mkApp(mkRel (k+1),args))) in
   let inds' =
     List.map
       (function (tname,arity,template,cnames,lc) ->
 	let lc' = List.map (substl subs) lc in
-	let lc'' = List.map (fun b -> Termops.it_mkNamedProd_wo_LetIn b hyps) lc' in
-	let arity' = Termops.it_mkNamedProd_wo_LetIn arity hyps in
+	let lc'' = List.map (fun b -> Termops.it_mkNamedProd_wo_LetIn b decls) lc' in
+	let arity' = Termops.it_mkNamedProd_wo_LetIn arity decls in
         (tname,arity',template,cnames,lc''))
       	inds in
-  let nparams' = nparams + Array.length args in
+  let nparamdecls' = nparamdecls + Array.length args in
 (* To be sure to be the same as before, should probably be moved to process_inductive *)
   let params' = let (_,arity,_,_,_) = List.hd inds' in
-		let (params,_) = decompose_prod_n_assum nparams' arity in
+		let (params,_) = decompose_prod_n_assum nparamdecls' arity in
                 List.map detype_param params
   in
   let ind'' =
   List.map
     (fun (a,arity,template,c,lc) ->
-      let _, short_arity = decompose_prod_n_assum nparams' arity in
+      let _, short_arity = decompose_prod_n_assum nparamdecls' arity in
       let shortlc =
-	List.map (fun c -> snd (decompose_prod_n_assum nparams' c)) lc in
+	List.map (fun c -> snd (decompose_prod_n_assum nparamdecls' c)) lc in
       { mind_entry_typename = a;
 	mind_entry_arity = short_arity;
 	mind_entry_template = template;
@@ -77,9 +78,9 @@ let refresh_polymorphic_type_of_inductive (_,mip) =
     let ctx = List.rev mip.mind_arity_ctxt in
       mkArity (List.rev ctx, Type ar.template_level), true
 
-let process_inductive (sechyps,_,_ as info) modlist mib =
-  let sechyps = Lib.named_of_variable_context sechyps in
-  let nparams = mib.mind_nparams in
+let process_inductive info modlist mib =
+  let section_decls = Lib.named_of_variable_context info.Lib.abstr_ctx in
+  let nparamdecls = Context.Rel.length mib.mind_params_ctxt in
   let subst, ind_univs =
     match mib.mind_universes with
     | Monomorphic_ind ctx -> Univ.empty_level_subst, Monomorphic_ind_entry ctx
@@ -91,7 +92,7 @@ let process_inductive (sechyps,_,_ as info) modlist mib =
       let auctx = Univ.ACumulativityInfo.univ_context cumi in
       let subst, auctx = Lib.discharge_abstract_universe_context info auctx in
       let auctx = Univ.AUContext.repr auctx in
-      subst, Cumulative_ind_entry (Universes.univ_inf_ind_from_universe_context auctx)
+      subst, Cumulative_ind_entry (Univ.CumulativityInfo.from_universe_context auctx)
   in
   let discharge c = Vars.subst_univs_level_constr subst (expmod_constr modlist c) in
   let inds =
@@ -105,8 +106,8 @@ let process_inductive (sechyps,_,_ as info) modlist mib =
 	   Array.to_list mip.mind_consnames,
 	   Array.to_list lc))
       mib.mind_packets in
-  let sechyps' = Context.Named.map discharge sechyps in
-  let (params',inds') = abstract_inductive sechyps' nparams inds in
+  let section_decls' = Context.Named.map discharge section_decls in
+  let (params',inds') = abstract_inductive section_decls' nparamdecls inds in
   let record = match mib.mind_record with
     | Some (Some (id, _, _)) -> Some (Some id)
     | Some None -> Some None
diff --git a/vernac/discharge.mli b/interp/discharge.mli
index c8c7e3b8b..c8c7e3b8b 100644
--- a/vernac/discharge.mli
+++ b/interp/discharge.mli
diff --git a/interp/dumpglob.ml b/interp/dumpglob.ml
index 561b0078a..e439db2b2 100644
--- a/interp/dumpglob.ml
+++ b/interp/dumpglob.ml
@@ -68,11 +68,12 @@ let pause () = previous_state := !glob_output; glob_output := NoGlob
 let continue () = glob_output := !previous_state
 
 open Decl_kinds
+open Declarations
 
 let type_of_logical_kind = function
   | IsDefinition def ->
       (match def with
-      | Definition -> "def"
+      | Definition | Let -> "def"
       | Coercion -> "coe"
       | SubClass -> "subclass"
       | CanonicalStructure -> "canonstruc"
@@ -111,14 +112,12 @@ let type_of_global_ref gr =
     | Globnames.IndRef ind ->
 	let (mib,oib) = Inductive.lookup_mind_specif (Global.env ()) ind in
 	  if mib.Declarations.mind_record <> None then
-            let open Decl_kinds in
             begin match mib.Declarations.mind_finite with
             | Finite -> "indrec"
             | BiFinite -> "rec"
 	    | CoFinite -> "corec"
             end
 	  else
-            let open Decl_kinds in
             begin match mib.Declarations.mind_finite with
             | Finite -> "ind"
             | BiFinite -> "variant"
@@ -231,7 +230,7 @@ let add_glob ?loc ref =
     add_glob_gen ?loc sp lib_dp ty
 
 let mp_of_kn kn =
-  let mp,sec,l = Names.repr_kn kn in
+  let mp,sec,l = Names.KerName.repr kn in
     Names.MPdot (mp,l)
 
 let add_glob_kn ?loc kn =
@@ -250,12 +249,12 @@ let dump_def ?loc ty secpath id = Option.iter (fun loc ->
     dump_string (Printf.sprintf "%s %d:%d %s %s\n" ty bl el secpath id)
   ) loc
 
-let dump_definition (loc, id) sec s =
+let dump_definition {CAst.loc;v=id} sec s =
   dump_def ?loc s (Names.DirPath.to_string (Lib.current_dirpath sec)) (Names.Id.to_string id)
 
-let dump_constraint (((loc, n),_), _, _) sec ty =
+let dump_constraint (({ CAst.loc; v = n },_), _, _) sec ty =
   match n with
-    | Names.Name id -> dump_definition (loc, id) sec ty
+    | Names.Name id -> dump_definition CAst.(make ?loc id) sec ty
     | Names.Anonymous -> ()
 
 let dump_moddef ?loc mp ty =
diff --git a/interp/dumpglob.mli b/interp/dumpglob.mli
index 054e43e7c..c779e860f 100644
--- a/interp/dumpglob.mli
+++ b/interp/dumpglob.mli
@@ -23,11 +23,11 @@ val pause : unit -> unit
 val continue : unit -> unit
 
 val add_glob : ?loc:Loc.t -> Globnames.global_reference -> unit
-val add_glob_kn : ?loc:Loc.t -> Names.kernel_name -> unit
+val add_glob_kn : ?loc:Loc.t -> Names.KerName.t -> unit
 
-val dump_definition : Names.Id.t Loc.located -> bool -> string -> unit
-val dump_moddef : ?loc:Loc.t -> Names.module_path -> string -> unit
-val dump_modref  : ?loc:Loc.t -> Names.module_path -> string -> unit
+val dump_definition : Misctypes.lident -> bool -> string -> unit
+val dump_moddef : ?loc:Loc.t -> Names.ModPath.t -> string -> unit
+val dump_modref  : ?loc:Loc.t -> Names.ModPath.t -> string -> unit
 val dump_reference  : ?loc:Loc.t -> string -> string -> string -> unit
 val dump_libref : ?loc:Loc.t -> Names.DirPath.t -> string -> unit
 val dump_notation_location : (int * int) list -> Constrexpr.notation ->
@@ -37,7 +37,7 @@ val dump_notation :
   (Constrexpr.notation * Notation.notation_location) Loc.located ->
   Notation_term.scope_name option -> bool -> unit
 val dump_constraint :
-  Constrexpr.typeclass_constraint -> bool -> string -> unit
+  Vernacexpr.typeclass_constraint -> bool -> string -> unit
 
 val dump_string : string -> unit
 
diff --git a/interp/genintern.ml b/interp/genintern.ml
index f4996c997..2f2edab30 100644
--- a/interp/genintern.ml
+++ b/interp/genintern.ml
@@ -10,7 +10,7 @@ open Names
 open Mod_subst
 open Genarg
 
-module Store = Store.Make(struct end)
+module Store = Store.Make ()
 
 type glob_sign = {
   ltacvars : Id.Set.t;
diff --git a/interp/impargs.ml b/interp/impargs.ml
index d8241c044..ed1cd5276 100644
--- a/interp/impargs.ml
+++ b/interp/impargs.ml
@@ -10,8 +10,7 @@ open CErrors
 open Util
 open Names
 open Globnames
-open Nameops
-open Term
+open Constr
 open Reduction
 open Declarations
 open Environ
@@ -167,7 +166,7 @@ let update pos rig (na,st) =
 
 (* modified is_rigid_reference with a truncated env *)
 let is_flexible_reference env bound depth f =
-  match kind_of_term f with
+  match kind f with
     | Rel n when n >= bound+depth -> (* inductive type *) false
     | Rel n when n >= depth -> (* previous argument *) true
     | Rel n -> (* since local definitions have been expanded *) false
@@ -191,7 +190,7 @@ 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_all env c else c in
     let c = if strongly_strict then hd else c in
-    match kind_of_term hd with
+    match kind hd with
     | Rel n when (n < bound+depth) && (n >= depth) ->
 	let i = bound + depth - n - 1 in
         acc.(i) <- update pos rig acc.(i)
@@ -214,13 +213,13 @@ let add_free_rels_until strict strongly_strict revpat bound env m pos acc =
   let () = if not (Vars.noccur_between 1 bound m) then frec true (env,1) m in
   acc
 
-let rec is_rigid_head t = match kind_of_term t with
+let rec is_rigid_head t = match kind t with
   | Rel _ | Evar _ -> false
   | Ind _ | Const _ | Var _ | Sort _ -> true
   | Case (_,_,f,_) -> is_rigid_head f
   | Proj (p,c) -> true
   | App (f,args) ->
-      (match kind_of_term f with
+      (match kind f with
 	| Fix ((fi,i),_) -> is_rigid_head (args.(fi.(i)))
 	| _ -> is_rigid_head f)
   | Lambda _ | LetIn _ | Construct _ | CoFix _ | Fix _
@@ -240,7 +239,7 @@ let compute_implicits_gen strict strongly_strict revpat contextual all env t =
   let open Context.Rel.Declaration in
   let rec aux env avoid n names t =
     let t = whd_all env t in
-    match kind_of_term t with
+    match kind t with
       | Prod (na,a,b) ->
 	  let na',avoid' = find_displayed_name_in all avoid na (names,b) in
 	  add_free_rels_until strict strongly_strict revpat n env a (Hyp (n+1))
@@ -253,9 +252,9 @@ 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_all env t) with
+  match kind (whd_all env t) with
     | Prod (na,a,b) ->
-	let na',avoid = find_displayed_name_in all [] na ([],b) in
+	let na',avoid = find_displayed_name_in all Id.Set.empty na ([],b) in
 	let v = aux (push_rel (LocalAssum (na',a)) env) avoid 1 [na'] b in
 	!rigid, Array.to_list v
     | _ -> true, []
@@ -343,7 +342,7 @@ let check_correct_manual_implicits autoimps l =
     | ExplByName id,(b,fi,forced) ->
 	if not forced then
 	  user_err 
-            (str "Wrong or non-dependent implicit argument name: " ++ pr_id id ++ str ".")
+            (str "Wrong or non-dependent implicit argument name: " ++ Id.print id ++ str ".")
     | ExplByPos (i,_id),_t ->
 	if i<1 || i>List.length autoimps then
 	  user_err 
@@ -483,8 +482,8 @@ type implicit_interactive_request =
 
 type implicit_discharge_request =
   | ImplLocal
-  | ImplConstant of constant * implicits_flags
-  | ImplMutualInductive of mutual_inductive * implicits_flags
+  | ImplConstant of Constant.t * implicits_flags
+  | ImplMutualInductive of MutInd.t * implicits_flags
   | ImplInteractive of global_reference * implicits_flags *
       implicit_interactive_request
 
@@ -549,7 +548,7 @@ let discharge_implicits (_,(req,l)) =
   | ImplConstant (con,flags) ->
     (try
       let con' = pop_con con in
-      let vars,_,_ = section_segment_of_constant con in
+      let vars = variable_section_segment_of_reference (ConstRef con) in
       let extra_impls = impls_of_context vars in
       let newimpls = List.map (add_section_impls vars extra_impls) (snd (List.hd l)) in
       let l' = [ConstRef con',newimpls] in
diff --git a/interp/impargs.mli b/interp/impargs.mli
index 4b78f54ea..40fa4cb26 100644
--- a/interp/impargs.mli
+++ b/interp/impargs.mli
@@ -7,8 +7,8 @@
 (************************************************************************)
 
 open Names
+open Constr
 open Globnames
-open Term
 open Environ
 
 (** {6 Implicit Arguments } *)
@@ -98,8 +98,8 @@ val compute_implicits_names : env -> types -> Name.t list
 (** {6 Computation of implicits (done using the global environment). } *)
 
 val declare_var_implicits : variable -> unit
-val declare_constant_implicits : constant -> unit
-val declare_mib_implicits : mutual_inductive -> unit
+val declare_constant_implicits : Constant.t -> unit
+val declare_mib_implicits : MutInd.t -> unit
 
 val declare_implicits : bool -> global_reference -> unit
 
diff --git a/interp/implicit_quantifiers.ml b/interp/implicit_quantifiers.ml
index e498d979d..326969b67 100644
--- a/interp/implicit_quantifiers.ml
+++ b/interp/implicit_quantifiers.ml
@@ -26,14 +26,14 @@ module RelDecl = Context.Rel.Declaration
 
 let generalizable_table = Summary.ref Id.Pred.empty ~name:"generalizable-ident"
 
-let declare_generalizable_ident table (loc,id) =
+let declare_generalizable_ident table {CAst.loc;v=id} =
   if not (Id.equal id (root_of_id id)) then
     user_err ?loc ~hdr:"declare_generalizable_ident"
-    ((pr_id id ++ str
+    ((Id.print 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 ~hdr:"declare_generalizable_ident"
-		((pr_id id++str" is already declared as a generalizable identifier"))
+		((Id.print id++str" is already declared as a generalizable identifier"))
   else Id.Pred.add id table
 
 let add_generalizable gen table =
@@ -49,7 +49,7 @@ let cache_generalizable_type (_,(local,cmd)) =
 let load_generalizable_type _ (_,(local,cmd)) =
   generalizable_table := add_generalizable cmd !generalizable_table
 
-let in_generalizable : bool * Id.t Loc.located list option -> obj =
+let in_generalizable : bool * Misctypes.lident list option -> obj =
   declare_object {(default_object "GENERALIZED-IDENT") with
     load_function = load_generalizable_type;
     cache_function = cache_generalizable_type;
@@ -80,7 +80,7 @@ let is_freevar ids env x =
 
 let ungeneralizable loc id =
   user_err ?loc ~hdr:"Generalization"
-	       (str "Unbound and ungeneralizable variable " ++ pr_id id)
+	       (str "Unbound and ungeneralizable variable " ++ Id.print id)
 
 let free_vars_of_constr_expr c ?(bound=Id.Set.empty) l =
   let found loc id bdvars l =
@@ -93,13 +93,13 @@ let free_vars_of_constr_expr c ?(bound=Id.Set.empty) l =
   in
   let rec aux bdvars l c = match CAst.(c.v) with
     | CRef (Ident (loc,id),_) -> found loc id bdvars l
-    | CNotation ("{ _ : _ | _ }", ({ CAst.v = CRef (Ident (_, id),_) } :: _, [], [])) when not (Id.Set.mem id bdvars) ->
-	Topconstr.fold_constr_expr_with_binders (fun a l -> Id.Set.add a l) aux (Id.Set.add id bdvars) l c
-    | _ -> Topconstr.fold_constr_expr_with_binders (fun a l -> Id.Set.add a l) aux bdvars l c
+    | CNotation ("{ _ : _ | _ }", ({ CAst.v = CRef (Ident (_, id),_) } :: _, [], [], [])) when not (Id.Set.mem id bdvars) ->
+        Constrexpr_ops.fold_constr_expr_with_binders (fun a l -> Id.Set.add a l) aux (Id.Set.add id bdvars) l c
+    | _ -> Constrexpr_ops.fold_constr_expr_with_binders (fun a l -> Id.Set.add a l) aux bdvars l c
   in aux bound l c
 
 let ids_of_names l =
-  List.fold_left (fun acc x -> match snd x with Name na -> na :: acc | Anonymous -> acc) [] l
+  List.fold_left (fun acc x -> match x.CAst.v with Name na -> na :: acc | Anonymous -> acc) [] l
 
 let free_vars_of_binders ?(bound=Id.Set.empty) l (binders : local_binder_expr list) =
   let rec aux bdvars l c = match c with
@@ -109,7 +109,7 @@ let free_vars_of_binders ?(bound=Id.Set.empty) l (binders : local_binder_expr li
 	  aux (Id.Set.union (ids_of_list bound) bdvars) l' tl
 
     | ((CLocalDef (n, c, t)) :: tl) ->
-	let bound = match snd n with Anonymous -> [] | Name n -> [n] in
+        let bound = match n.CAst.v with Anonymous -> [] | Name n -> [n] in
 	let l' = free_vars_of_constr_expr c ~bound:bdvars l in
 	let l'' = Option.fold_left (fun l t -> free_vars_of_constr_expr t ~bound:bdvars l) l' t in
 	  aux (Id.Set.union (ids_of_list bound) bdvars) l'' tl
@@ -119,16 +119,17 @@ let free_vars_of_binders ?(bound=Id.Set.empty) l (binders : local_binder_expr li
   in aux bound l binders
 
 let generalizable_vars_of_glob_constr ?(bound=Id.Set.empty) ?(allowed=Id.Set.empty) =
-  let rec vars bound vs t = match t with
-    | { loc; CAst.v = GVar id } ->
+  let rec vars bound vs c = match DAst.get c with
+    | GVar id ->
+        let loc = c.CAst.loc in
 	if is_freevar bound (Global.env ()) id then
-	  if Id.List.mem_assoc_sym id vs then vs
-	  else (Loc.tag ?loc id) :: vs
+          if List.exists (fun {CAst.v} -> Id.equal v id) vs then vs
+          else CAst.(make ?loc id) :: vs
 	else vs
-    | c -> Glob_ops.fold_glob_constr_with_binders Id.Set.add vars bound vs c
+    | _ -> Glob_ops.fold_glob_constr_with_binders Id.Set.add vars bound vs c
   in fun rt -> 
     let vars = List.rev (vars bound [] rt) in
-      List.iter (fun (loc, id) ->
+      List.iter (fun {CAst.loc;v=id} ->
 	if not (Id.Set.mem id allowed || find_generalizable_ident id) then 
 	  ungeneralizable loc id) vars;
       vars
@@ -145,18 +146,18 @@ let combine_params avoid fn applied needed =
   let named, applied =
     List.partition
       (function
-	  (t, Some (loc, ExplByName id)) ->
+          (t, Some {CAst.loc;v=ExplByName id}) ->
             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  (str "Wrong argument name: " ++ Nameops.pr_id id);
+	      user_err ?loc  (str "Wrong argument name: " ++ Id.print id);
 	    true
 	| _ -> false) applied
   in
   let named = List.map
-    (fun x -> match x with (t, Some (loc, ExplByName id)) -> id, t | _ -> assert false)
+    (fun x -> match x with (t, Some {CAst.loc;v=ExplByName id}) -> id, t | _ -> assert false)
     named
   in
   let is_unset (_, decl) = match decl with
@@ -197,23 +198,23 @@ let destClassApp cl =
   let open CAst in
   let loc = cl.loc in
   match cl.v with
-    | CApp ((None, { v = CRef (ref, inst) }), l) -> Loc.tag ?loc (ref, List.map fst l, inst)
-    | CAppExpl ((None, ref, inst), l) -> Loc.tag ?loc (ref, l, inst)
-    | CRef (ref, inst) -> Loc.tag ?loc:(loc_of_reference ref) (ref, [], inst)
+    | CApp ((None, { v = CRef (ref, inst) }), l) -> CAst.make ?loc (ref, List.map fst l, inst)
+    | CAppExpl ((None, ref, inst), l) -> CAst.make ?loc (ref, l, inst)
+    | CRef (ref, inst) -> CAst.make ?loc:(loc_of_reference ref) (ref, [], inst)
     | _ -> raise Not_found
 
 let destClassAppExpl cl =
   let open CAst in
   let loc = cl.loc in
   match cl.v with
-    | CApp ((None, { v = CRef (ref, inst) } ), l) -> Loc.tag ?loc (ref, l, inst)
-    | CRef (ref, inst) -> Loc.tag ?loc:(loc_of_reference ref) (ref, [], inst)
+    | CApp ((None, { v = CRef (ref, inst) } ), l) -> CAst.make ?loc (ref, l, inst)
+    | CRef (ref, inst) -> CAst.make ?loc:(loc_of_reference ref) (ref, [], inst)
     | _ -> raise Not_found
 
 let implicit_application env ?(allow_partial=true) f ty =
   let is_class =
     try
-      let (_, (r, _, _) as clapp) = destClassAppExpl ty in
+      let ({CAst.v=(r, _, _)} as clapp) = destClassAppExpl ty in
       let (loc, qid) = qualid_of_reference r in
       let gr = Nametab.locate qid in
 	if Typeclasses.is_class gr then Some (clapp, gr) else None
@@ -221,7 +222,7 @@ let implicit_application env ?(allow_partial=true) f ty =
   in
     match is_class with
     | None -> ty, env
-    | Some ((loc, (id, par, inst)), gr) ->
+    | Some ({CAst.loc;v=(id, par, inst)}, gr) ->
 	let avoid = Id.Set.union env (ids_of_list (free_vars_of_constr_expr ty ~bound:env [])) in
 	let c, avoid =
 	  let c = class_info gr in
@@ -253,11 +254,11 @@ let implicits_of_glob_constr ?(with_products=true) l =
     (ExplByPos (i, name), (true, true, true)) :: l
   | _ -> l
   in
-  let rec aux i { loc; CAst.v = c } =
+  let rec aux i c =
     let abs na bk b =
       add_impl i na bk (aux (succ i) b)
     in
-      match c with
+      match DAst.get c with
       | GProd (na, bk, t, b) ->
 	  if with_products then abs na bk b
 	  else
diff --git a/interp/implicit_quantifiers.mli b/interp/implicit_quantifiers.mli
index f7c36c4e5..625e12003 100644
--- a/interp/implicit_quantifiers.mli
+++ b/interp/implicit_quantifiers.mli
@@ -6,18 +6,17 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Loc
 open Names
 open Glob_term
 open Constrexpr
 open Libnames
 open Globnames
 
-val declare_generalizable : Vernacexpr.locality_flag -> (Id.t located) list option -> unit
+val declare_generalizable : Vernacexpr.locality_flag -> Misctypes.lident list option -> unit
 
 val ids_of_list : Id.t list -> Id.Set.t
-val destClassApp : constr_expr -> (reference * constr_expr list * instance_expr option) located
-val destClassAppExpl : constr_expr -> (reference * (constr_expr * explicitation located option) list * instance_expr option) located
+val destClassApp : constr_expr -> (reference * constr_expr list * instance_expr option) CAst.t
+val destClassAppExpl : constr_expr -> (reference * (constr_expr * explicitation CAst.t option) list * instance_expr option) CAst.t
 
 (** Fragile, should be used only for construction a set of identifiers to avoid *)
 
@@ -31,17 +30,17 @@ val free_vars_of_binders :
    order with the location of their first occurrence *)
 
 val generalizable_vars_of_glob_constr : ?bound:Id.Set.t -> ?allowed:Id.Set.t ->
-  glob_constr -> Id.t located list
+  glob_constr -> Misctypes.lident list
 
 val make_fresh : Id.Set.t -> Environ.env -> Id.t -> Id.t
 
 val implicits_of_glob_constr : ?with_products:bool -> Glob_term.glob_constr -> Impargs.manual_implicits
 
 val combine_params_freevar :
-  Id.Set.t -> (global_reference * bool) option * Context.Rel.Declaration.t ->
+  Id.Set.t -> global_reference option * Context.Rel.Declaration.t ->
   Constrexpr.constr_expr * Id.Set.t
 
 val implicit_application : Id.Set.t -> ?allow_partial:bool ->
-  (Id.Set.t -> (global_reference * bool) option * Context.Rel.Declaration.t ->
+  (Id.Set.t -> global_reference option * Context.Rel.Declaration.t ->
     Constrexpr.constr_expr * Id.Set.t) ->
   constr_expr -> constr_expr * Id.Set.t
diff --git a/interp/interp.mllib b/interp/interp.mllib
index 6d290a325..bb22cf468 100644
--- a/interp/interp.mllib
+++ b/interp/interp.mllib
@@ -1,12 +1,13 @@
+Tactypes
 Stdarg
 Genintern
-Constrexpr_ops
 Notation_ops
-Ppextend
 Notation
-Dumpglob
 Syntax_def
 Smartlocate
+Constrexpr_ops
+Ppextend
+Dumpglob
 Topconstr
 Reserve
 Impargs
diff --git a/interp/modintern.ml b/interp/modintern.ml
index 08657936e..e631b3ea4 100644
--- a/interp/modintern.ml
+++ b/interp/modintern.ml
@@ -59,33 +59,42 @@ let lookup_module lqid = fst (lookup_module_or_modtype Module lqid)
 
 let transl_with_decl env = function
   | CWith_Module ((_,fqid),qid) ->
-      WithMod (fqid,lookup_module qid)
+      WithMod (fqid,lookup_module qid), Univ.ContextSet.empty
   | CWith_Definition ((_,fqid),c) ->
     let c, ectx = interp_constr env (Evd.from_env env) c in
-    let ctx = Evd.evar_context_universe_context ectx in
-      WithDef (fqid,(c,ctx))
+    if Flags.is_universe_polymorphism () then
+      let ctx = UState.context ectx in
+      let inst, ctx = Univ.abstract_universes ctx in
+      let c = Vars.subst_univs_level_constr (Univ.make_instance_subst inst) c in
+      WithDef (fqid,(c, Some ctx)), Univ.ContextSet.empty
+    else
+      WithDef (fqid,(c, None)), UState.context_set ectx
 
 let loc_of_module l = l.CAst.loc
 
 (* Invariant : the returned kind is never ModAny, and it is
    equal to the input kind when this one isn't ModAny. *)
 
-let rec interp_module_ast env kind m = match m.CAst.v with
+let rec interp_module_ast env kind m cst = match m.CAst.v with
   | CMident qid ->
       let (mp,kind) = lookup_module_or_modtype kind (m.CAst.loc,qid) in
-      (MEident mp, kind)
+      (MEident mp, kind, cst)
   | CMapply (me1,me2) ->
-      let me1',kind1 = interp_module_ast env kind me1 in
-      let me2',kind2 = interp_module_ast env ModAny me2 in
+      let me1',kind1, cst = interp_module_ast env kind me1 cst in
+      let me2',kind2, cst = interp_module_ast env ModAny me2 cst in
       let mp2 = match me2' with
         | MEident mp -> mp
         | _ -> error_application_to_not_path (loc_of_module me2) me2'
       in
       if kind2 == ModType then
         error_application_to_module_type (loc_of_module me2);
-      (MEapply (me1',mp2), kind1)
+      (MEapply (me1',mp2), kind1, cst)
   | CMwith (me,decl) ->
-      let me,kind = interp_module_ast env kind me in
+      let me,kind,cst = interp_module_ast env kind me cst in
       if kind == Module then error_incorrect_with_in_module m.CAst.loc;
-      let decl = transl_with_decl env decl in
-      (MEwith(me,decl), kind)
+      let decl, cst' = transl_with_decl env decl in
+      let cst = Univ.ContextSet.union cst cst' in
+      (MEwith(me,decl), kind, cst)
+
+let interp_module_ast env kind m =
+  interp_module_ast env kind m Univ.ContextSet.empty
diff --git a/interp/modintern.mli b/interp/modintern.mli
index a21b6e231..8d6100667 100644
--- a/interp/modintern.mli
+++ b/interp/modintern.mli
@@ -28,4 +28,4 @@ exception ModuleInternalizationError of module_internalization_error
    isn't ModAny. *)
 
 val interp_module_ast :
-  env -> module_kind -> module_ast -> module_struct_entry * module_kind
+  env -> module_kind -> module_ast -> module_struct_entry * module_kind * Univ.ContextSet.t
diff --git a/interp/notation.ml b/interp/notation.ml
index c373faf68..ea7ef21b1 100644
--- a/interp/notation.ml
+++ b/interp/notation.ml
@@ -11,7 +11,7 @@ open CErrors
 open Util
 open Pp
 open Names
-open Term
+open Constr
 open Libnames
 open Globnames
 open Constrexpr
@@ -82,18 +82,35 @@ let parenRelation_eq t1 t2 = match t1, t2 with
 | Prec l1, Prec l2 -> Int.equal l1 l2
 | _ -> false
 
-let notation_var_internalization_type_eq v1 v2 = match v1, v2 with
-| NtnInternTypeConstr, NtnInternTypeConstr -> true
-| NtnInternTypeBinder, NtnInternTypeBinder -> true
-| NtnInternTypeIdent, NtnInternTypeIdent -> true
-| (NtnInternTypeConstr | NtnInternTypeBinder | NtnInternTypeIdent), _ -> false
-
-let level_eq (l1, t1, u1) (l2, t2, u2) =
-  let tolerability_eq (i1, r1) (i2, r2) =
-    Int.equal i1 i2 && parenRelation_eq r1 r2
-  in
+open Extend
+
+let production_level_eq l1 l2 = true (* (l1 = l2) *)
+
+let production_position_eq pp1 pp2 = true (* pp1 = pp2 *) (* match pp1, pp2 with
+| NextLevel, NextLevel -> true
+| NumLevel n1, NumLevel n2 -> Int.equal n1 n2
+| (NextLevel | NumLevel _), _ -> false *)
+
+let constr_entry_key_eq eq v1 v2 = match v1, v2 with
+| ETName, ETName -> true
+| ETReference, ETReference -> true
+| ETBigint, ETBigint -> true
+| ETBinder b1, ETBinder b2 -> b1 == b2
+| ETConstr lev1, ETConstr lev2 -> eq lev1 lev2
+| ETConstrAsBinder (bk1,lev1), ETConstrAsBinder (bk2,lev2) -> eq lev1 lev2 && bk1 = bk2
+| ETPattern (b1,n1), ETPattern (b2,n2) -> b1 = b2 && Option.equal Int.equal n1 n2
+| ETOther (s1,s1'), ETOther (s2,s2') -> String.equal s1 s2 && String.equal s1' s2'
+| (ETName | ETReference | ETBigint | ETBinder _ | ETConstr _ | ETPattern _ | ETOther _ | ETConstrAsBinder _), _ -> false
+
+let level_eq_gen strict (l1, t1, u1) (l2, t2, u2) =
+  let tolerability_eq (i1, r1) (i2, r2) = Int.equal i1 i2 && parenRelation_eq r1 r2 in
+  let prod_eq (l1,pp1) (l2,pp2) =
+    if strict then production_level_eq l1 l2 && production_position_eq pp1 pp2
+    else production_level_eq l1 l2 in
   Int.equal l1 l2 && List.equal tolerability_eq t1 t2
-  && List.equal notation_var_internalization_type_eq u1 u2
+  && List.equal (constr_entry_key_eq prod_eq) u1 u2
+
+let level_eq = level_eq_gen false
 
 let declare_scope scope =
   try let _ = String.Map.find scope !scope_map in ()
@@ -234,7 +251,7 @@ let find_delimiters_scope ?loc key =
 
 type interp_rule =
   | NotationRule of scope_name option * notation
-  | SynDefRule of kernel_name
+  | SynDefRule of KerName.t
 
 (* We define keys for glob_constr and aconstr to split the syntax entries
    according to the key of the pattern (adapted from Chet Murthy by HH) *)
@@ -265,25 +282,34 @@ let keymap_find key map =
 (* Scopes table : interpretation -> scope_name *)
 let notations_key_table = ref (KeyMap.empty : notation_rule list KeyMap.t)
 
-let prim_token_key_table = ref KeyMap.empty
+let prim_token_key_table = ref (KeyMap.empty : (string * (any_glob_constr -> prim_token option) * bool) KeyMap.t)
 
-let glob_prim_constr_key = function
-  | { CAst.v = GApp ({ CAst.v = GRef (ref,_) } ,_) } | { CAst.v = GRef (ref,_) } -> RefKey (canonical_gr ref)
+let glob_prim_constr_key c = match DAst.get c with
+  | GRef (ref, _) -> RefKey (canonical_gr ref)
+  | GApp (c, _) ->
+    begin match DAst.get c with
+    | GRef (ref, _) -> RefKey (canonical_gr ref)
+    | _ -> Oth
+    end
   | _ -> Oth
 
-let glob_constr_keys = function
-  | { CAst.v = GApp ({ CAst.v = GRef (ref,_) },_) } -> [RefKey (canonical_gr ref); Oth]
-  | { CAst.v = GRef (ref,_) } -> [RefKey (canonical_gr ref)]
+let glob_constr_keys c = match DAst.get c with
+  | GApp (c, _) ->
+    begin match DAst.get c with
+    | GRef (ref, _) -> [RefKey (canonical_gr ref); Oth]
+    | _ -> [Oth]
+    end
+  | GRef (ref,_) -> [RefKey (canonical_gr ref)]
   | _ -> [Oth]
 
-let cases_pattern_key = function
-  | { CAst.v = PatCstr (ref,_,_) } -> RefKey (canonical_gr (ConstructRef ref))
+let cases_pattern_key c = match DAst.get c with
+  | PatCstr (ref,_,_) -> RefKey (canonical_gr (ConstructRef ref))
   | _ -> Oth
 
 let notation_constr_key = function (* Rem: NApp(NRef ref,[]) stands for @ref *)
   | NApp (NRef ref,args) -> RefKey(canonical_gr ref), Some (List.length args)
   | NList (_,_,NApp (NRef ref,args),_,_)
-  | NBinderList (_,_,NApp (NRef ref,args),_) ->
+  | NBinderList (_,_,NApp (NRef ref,args),_,_) ->
       RefKey (canonical_gr ref), Some (List.length args)
   | NRef ref -> RefKey(canonical_gr ref), None
   | NApp (_,args) -> Oth, Some (List.length args)
@@ -300,7 +326,7 @@ type 'a prim_token_interpreter =
 type cases_pattern_status = bool (* true = use prim token in patterns *)
 
 type 'a prim_token_uninterpreter =
-    glob_constr list * (glob_constr -> 'a option) * cases_pattern_status
+    glob_constr list * (any_glob_constr -> 'a option) * cases_pattern_status
 
 type internal_prim_token_interpreter =
     ?loc:Loc.t -> prim_token -> required_module * (unit -> glob_constr)
@@ -416,7 +442,7 @@ 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)
+                    ++ strbrk "was already used" ++ which_scope ++ str ".")
 
 let declare_notation_interpretation ntn scopt pat df ~onlyprint =
   let scope = match scopt with Some s -> s | None -> default_scope in
@@ -496,11 +522,15 @@ let interp_prim_token_gen ?loc g p local_scopes =
 let interp_prim_token ?loc =
   interp_prim_token_gen ?loc (fun _ -> ())
 
-let rec check_allowed_ref_in_pat looked_for = CAst.(with_val (function
+let rec check_allowed_ref_in_pat looked_for = DAst.(with_val (function
   | GVar _ | GHole _ -> ()
   | GRef (g,_) -> looked_for g
-  | GApp ({ v = GRef (g,_) },l) ->
-    looked_for g; List.iter (check_allowed_ref_in_pat looked_for) l
+  | GApp (f, l) ->
+    begin match DAst.get f with
+    | GRef (g, _) ->
+      looked_for g; List.iter (check_allowed_ref_in_pat looked_for) l
+    | _ -> raise Not_found
+    end
   | _ -> raise Not_found))
 
 let interp_prim_token_cases_pattern_expr ?loc looked_for p =
@@ -513,15 +543,38 @@ let interp_notation ?loc ntn local_scopes =
     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)
-    (glob_constr_keys c)
-
-let uninterp_cases_pattern_notations c =
-  keymap_find (cases_pattern_key c) !notations_key_table
-
-let uninterp_ind_pattern_notations ind =
-  keymap_find (RefKey (canonical_gr (IndRef ind))) !notations_key_table
+let sort_notations scopes l =
+  let extract_scope l = function
+    | Scope sc -> List.partitioni (fun _i x ->
+                      match x with
+                      | NotationRule (Some sc',_),_,_ -> String.equal sc sc'
+                      | _ -> false) l
+    | SingleNotation ntn -> List.partitioni (fun _i x ->
+                      match x with
+                      | NotationRule (None,ntn'),_,_ -> String.equal ntn ntn'
+                      | _ -> false) l in
+  let rec aux l scopes =
+    if l == [] then [] (* shortcut *) else
+    match scopes with
+    | sc :: scopes -> let ntn_in_sc,l = extract_scope l sc in ntn_in_sc @ aux l scopes
+    | [] -> l in
+  aux l scopes
+
+let uninterp_notations scopes c =
+  let scopes = make_current_scopes scopes in
+  let keys = glob_constr_keys c in
+  let maps = List.map_append (fun key -> keymap_find key !notations_key_table) keys in
+  sort_notations scopes maps
+
+let uninterp_cases_pattern_notations scopes c =
+  let scopes = make_current_scopes scopes in
+  let maps = keymap_find (cases_pattern_key c) !notations_key_table in
+  sort_notations scopes maps
+
+let uninterp_ind_pattern_notations scopes ind =
+  let scopes = make_current_scopes scopes in
+  let maps = keymap_find (RefKey (canonical_gr (IndRef ind))) !notations_key_table in
+  sort_notations scopes maps
 
 let availability_of_notation (ntn_scope,ntn) scopes =
   let f scope =
@@ -532,7 +585,7 @@ let uninterp_prim_token c =
   try
     let (sc,numpr,_) =
       KeyMap.find (glob_prim_constr_key c) !prim_token_key_table in
-    match numpr c with
+    match numpr (AnyGlobConstr c) with
       | None -> raise Notation_ops.No_match
       | Some n -> (sc,n)
   with Not_found -> raise Notation_ops.No_match
@@ -545,8 +598,8 @@ let uninterp_prim_token_ind_pattern ind args =
     if not b then raise Notation_ops.No_match;
     let args' = List.map
       (fun x -> snd (glob_constr_of_closed_cases_pattern x)) args in
-    let ref = CAst.make @@ GRef (ref,None) in
-    match numpr (CAst.make @@ GApp (ref,args')) with
+    let ref = DAst.make @@ GRef (ref,None) in
+    match numpr (AnyGlobConstr (DAst.make @@ GApp (ref,args'))) with
       | None -> raise Notation_ops.No_match
       | Some n -> (sc,n)
   with Not_found -> raise Notation_ops.No_match
@@ -557,7 +610,7 @@ let uninterp_prim_token_cases_pattern c =
     let (sc,numpr,b) = KeyMap.find k !prim_token_key_table in
     if not b then raise Notation_ops.No_match;
     let na,c = glob_constr_of_closed_cases_pattern c in
-    match numpr c with
+    match numpr (AnyGlobConstr c) with
       | None -> raise Notation_ops.No_match
       | Some n -> (na,sc,n)
   with Not_found -> raise Notation_ops.No_match
@@ -573,12 +626,18 @@ let availability_of_prim_token n printer_scope local_scopes =
 
 let pair_eq f g (x1, y1) (x2, y2) = f x1 x2 && g y1 y2
 
+let notation_binder_source_eq s1 s2 = match s1, s2 with
+| NtnParsedAsIdent,  NtnParsedAsIdent -> true
+| NtnParsedAsPattern b1, NtnParsedAsPattern b2 -> b1 = b2
+| NtnBinderParsedAsConstr bk1, NtnBinderParsedAsConstr bk2 -> bk1 = bk2
+| (NtnParsedAsIdent | NtnParsedAsPattern _ | NtnBinderParsedAsConstr _), _ -> false
+
 let ntpe_eq t1 t2 = match t1, t2 with
 | NtnTypeConstr, NtnTypeConstr -> true
-| NtnTypeOnlyBinder, NtnTypeOnlyBinder -> true
+| NtnTypeBinder s1, NtnTypeBinder s2 -> notation_binder_source_eq s1 s2
 | NtnTypeConstrList, NtnTypeConstrList -> true
 | NtnTypeBinderList, NtnTypeBinderList -> true
-| (NtnTypeConstr | NtnTypeOnlyBinder | NtnTypeConstrList | NtnTypeBinderList), _ -> false
+| (NtnTypeConstr | NtnTypeBinder _ | NtnTypeConstrList | NtnTypeBinderList), _ -> false
 
 let var_attributes_eq (_, (sc1, tp1)) (_, (sc2, tp2)) =
   pair_eq (Option.equal String.equal) (List.equal String.equal) sc1 sc2 &&
@@ -640,7 +699,7 @@ let find_scope_class_opt = function
 (* Special scopes associated to arguments of a global reference *)
 
 let rec compute_arguments_classes t =
-  match kind_of_term (EConstr.Unsafe.to_constr (Reductionops.whd_betaiotazeta Evd.empty (EConstr.of_constr t))) with
+  match Constr.kind (EConstr.Unsafe.to_constr (Reductionops.whd_betaiotazeta Evd.empty (EConstr.of_constr t))) with
     | Prod (_,t,u) ->
 	let cl = try Some (compute_scope_class t) with Not_found -> None in
 	cl :: compute_arguments_classes u
@@ -890,8 +949,63 @@ let factorize_entries = function
 	  (ntn,[c],[]) l in
       (ntn,l_of_ntn)::rest
 
+type symbol_token = WhiteSpace of int | String of string
+
+let split_notation_string str =
+  let push_token beg i l =
+    if Int.equal beg i then l else
+      let s = String.sub str beg (i - beg) in
+      String s :: l
+  in
+  let push_whitespace beg i l =
+    if Int.equal beg i then l else WhiteSpace (i-beg) :: l
+  in
+  let rec loop beg i =
+    if i < String.length str then
+      if str.[i] == ' ' then
+        push_token beg i (loop_on_whitespace (i+1) (i+1))
+      else
+        loop beg (i+1)
+    else
+      push_token beg i []
+  and loop_on_whitespace beg i =
+    if i < String.length str then
+      if str.[i] != ' ' then
+        push_whitespace beg i (loop i (i+1))
+      else
+        loop_on_whitespace beg (i+1)
+    else
+      push_whitespace beg i []
+  in
+  loop 0 0
+
+let rec raw_analyze_notation_tokens = function
+  | []    -> []
+  | String ".." :: sl -> NonTerminal Notation_ops.ldots_var :: raw_analyze_notation_tokens sl
+  | String "_" :: _ -> user_err Pp.(str "_ must be quoted.")
+  | String x :: sl when Id.is_valid x ->
+      NonTerminal (Names.Id.of_string x) :: raw_analyze_notation_tokens sl
+  | String s :: sl ->
+      Terminal (String.drop_simple_quotes s) :: raw_analyze_notation_tokens sl
+  | WhiteSpace n :: sl ->
+      Break n :: raw_analyze_notation_tokens sl
+
+let decompose_raw_notation ntn = raw_analyze_notation_tokens (split_notation_string ntn)
+
+let possible_notations ntn =
+  (* We collect the possible interpretations of a notation string depending on whether it is
+    in "x 'U' y" or "_ U _" format *)
+  let toks = split_notation_string ntn in
+  if List.exists (function String "_" -> true | _ -> false) toks then
+    (* Only "_ U _" format *)
+    [ntn]
+  else
+    let ntn' = make_notation_key (raw_analyze_notation_tokens toks) in
+    if String.equal ntn ntn' then (* Only symbols *) [ntn] else [ntn;ntn']
+
 let browse_notation strict ntn map =
-  let find ntn' =
+  let ntns = possible_notations ntn in
+  let find ntn' ntn =
     if String.contains ntn ' ' then String.equal ntn ntn'
     else
       let toks = decompose_notation_key ntn' in
@@ -904,7 +1018,7 @@ let browse_notation strict ntn map =
     String.Map.fold
       (fun scope_name sc ->
 	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)
+          if List.exists (find ntn) ntns 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
 
diff --git a/interp/notation.mli b/interp/notation.mli
index f9f247fe1..a4c79d6d3 100644
--- a/interp/notation.mli
+++ b/interp/notation.mli
@@ -70,7 +70,7 @@ type 'a prim_token_interpreter =
     ?loc:Loc.t -> 'a -> glob_constr
 
 type 'a prim_token_uninterpreter =
-    glob_constr list * (glob_constr -> 'a option) * cases_pattern_status
+    glob_constr list * (any_glob_constr -> 'a option) * cases_pattern_status
 
 type rawnum = Constrexpr.raw_natural_number * Constrexpr.sign
 
@@ -96,9 +96,9 @@ val interp_prim_token_cases_pattern_expr : ?loc:Loc.t -> (global_reference -> un
    raise [No_match] if no such token *)
 
 val uninterp_prim_token :
-  glob_constr -> scope_name * prim_token
+  'a glob_constr_g -> scope_name * prim_token
 val uninterp_prim_token_cases_pattern :
-  cases_pattern -> Name.t * scope_name * prim_token
+  'a cases_pattern_g -> Name.t * scope_name * prim_token
 val uninterp_prim_token_ind_pattern :
  inductive -> cases_pattern list -> scope_name * prim_token
 
@@ -110,7 +110,7 @@ val availability_of_prim_token :
 (** Binds a notation in a given scope to an interpretation *)
 type interp_rule =
   | NotationRule of scope_name option * notation
-  | SynDefRule of kernel_name
+  | SynDefRule of KerName.t
 
 val declare_notation_interpretation : notation -> scope_name option ->
       interpretation -> notation_location -> onlyprint:bool -> unit
@@ -124,9 +124,9 @@ val interp_notation : ?loc:Loc.t -> notation -> local_scopes ->
 type notation_rule = interp_rule * interpretation * int option
 
 (** Return the possible notations for a given term *)
-val uninterp_notations : glob_constr -> notation_rule list
-val uninterp_cases_pattern_notations : cases_pattern -> notation_rule list
-val uninterp_ind_pattern_notations : inductive -> notation_rule list
+val uninterp_notations : local_scopes -> 'a glob_constr_g -> notation_rule list
+val uninterp_cases_pattern_notations : local_scopes -> 'a cases_pattern_g -> notation_rule list
+val uninterp_ind_pattern_notations : local_scopes -> inductive -> notation_rule list
 
 (** Test if a notation is available in the scopes 
    context [scopes]; if available, the result is not None; the first 
@@ -165,8 +165,8 @@ val subst_scope_class :
 val declare_scope_class : scope_name -> scope_class -> unit
 val declare_ref_arguments_scope : global_reference -> unit
 
-val compute_arguments_scope : Term.types -> scope_name option list
-val compute_type_scope : Term.types -> scope_name option
+val compute_arguments_scope : Constr.types -> scope_name option list
+val compute_type_scope : Constr.types -> scope_name option
 
 (** Get the current scope bound to Sortclass, if it exists *)
 val current_type_scope_name : unit -> scope_name option
@@ -176,16 +176,20 @@ val scope_class_of_class : Classops.cl_typ -> scope_class
 (** Building notation key *)
 
 type symbol =
-  | Terminal of string
-  | NonTerminal of Id.t
-  | SProdList of Id.t * symbol list
-  | Break of int
+  | Terminal of string              (* an expression including symbols or a simply-quoted ident, e.g. "'U'" or "!" *)
+  | NonTerminal of Id.t             (* an identifier "x" *)
+  | SProdList of Id.t * symbol list (* an expression "x sep .. sep y", remembering x (or y) and sep *)
+  | Break of int                    (* a sequence of blanks > 1, e.g. "   " *)
 
 val symbol_eq : symbol -> symbol -> bool
 
+(** Make/decompose a notation of the form "_ U _" *)
 val make_notation_key : symbol list -> notation
 val decompose_notation_key : notation -> symbol list
 
+(** Decompose a notation of the form "a 'U' b" *)
+val decompose_raw_notation : string -> symbol list
+
 (** Prints scopes (expects a pure aconstr printer) *)
 val pr_scope_class : scope_class -> Pp.t
 val pr_scope : (glob_constr -> Pp.t) -> scope_name -> Pp.t
diff --git a/interp/notation_ops.ml b/interp/notation_ops.ml
index 565a7e642..9bc41a996 100644
--- a/interp/notation_ops.ml
+++ b/interp/notation_ops.ml
@@ -42,9 +42,9 @@ let rec eq_notation_constr (vars1,vars2 as vars) t1 t2 = match t1, t2 with
   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 vars) t1 t2 && (eq_notation_constr vars) u1 u2
-| NBinderList (i1, j1, t1, u1), NBinderList (i2, j2, t2, u2) ->
+| NBinderList (i1, j1, t1, u1, b1), NBinderList (i2, j2, t2, u2, b2) ->
   Id.equal i1 i2 && Id.equal j1 j2 && (eq_notation_constr vars) t1 t2 &&
-  (eq_notation_constr vars) u1 u2
+  (eq_notation_constr vars) u1 u2 && b1 == b2
 | NLetIn (na1, b1, t1, u1), NLetIn (na2, b2, t2, u2) ->
   Name.equal na1 na2 && eq_notation_constr vars b1 b2 &&
   Option.equal (eq_notation_constr vars) t1 t2 && (eq_notation_constr vars) u1 u2
@@ -86,9 +86,11 @@ let rec eq_notation_constr (vars1,vars2 as vars) t1 t2 = match t1, t2 with
   Miscops.glob_sort_eq s1 s2
 | NCast (t1, c1), NCast (t2, c2) ->
   (eq_notation_constr vars) t1 t2 && cast_type_eq (eq_notation_constr vars) c1 c2
+| NProj (p1, c1), NProj (p2, c2) ->
+  Projection.equal p1 p2 && eq_notation_constr vars c1 c2
 | (NRef _ | NVar _ | NApp _ | NHole _ | NList _ | NLambda _ | NProd _
   | NBinderList _ | NLetIn _ | NCases _ | NLetTuple _ | NIf _
-  | NRec _ | NSort _ | NCast _), _ -> false
+  | NRec _ | NSort _ | NCast _ | NProj _), _ -> false
 
 (**********************************************************************)
 (* Re-interpret a notation as a glob_constr, taking care of binders   *)
@@ -99,43 +101,64 @@ let name_to_ident = function
 
 let to_id g e id = let e,na = g e (Name id) in e,name_to_ident na
 
-let rec cases_pattern_fold_map ?loc g e = CAst.with_val (function
+let product_of_cases_patterns patl =
+  List.fold_right (fun patl restl ->
+     List.flatten (List.map (fun p -> List.map (fun rest -> p::rest) restl) patl))
+    patl [[]]
+
+let rec cases_pattern_fold_map ?loc g e = DAst.with_val (function
   | PatVar na ->
-      let e',na' = g e na in e', CAst.make ?loc @@ PatVar na'
+      let e',disjpat,na' = g e na in
+      e', (match disjpat with
+      | None -> [DAst.make ?loc @@ PatVar na']
+      | Some ((_,disjpat),_) -> disjpat)
   | PatCstr (cstr,patl,na) ->
-      let e',na' = g e na in
+      let e',disjpat,na' = g e na in
+      if disjpat <> None then user_err (Pp.str "Unable to instantiate an \"as\" clause with a pattern.");
       let e',patl' = List.fold_left_map (cases_pattern_fold_map ?loc g) e patl in
-      e', CAst.make ?loc @@ PatCstr (cstr,patl',na')
+      (* Distribute outwards the inner disjunctive patterns *)
+      let disjpatl' = product_of_cases_patterns patl' in
+      e', List.map (fun patl' -> DAst.make ?loc @@ PatCstr (cstr,patl',na')) disjpatl'
   )
 
 let subst_binder_type_vars l = function
   | Evar_kinds.BinderType (Name id) ->
      let id =
-       try match Id.List.assoc id l with { CAst.v = GVar id' } -> id' | _ -> id
+       try match DAst.get (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 gc = CAst.map (function
-  | GVar id as r -> (try (Id.List.assoc id l).CAst.v with Not_found -> r)
+let rec subst_glob_vars l gc = DAst.map (function
+  | GVar id as r -> (try DAst.get (Id.List.assoc id l) with Not_found -> r)
   | GProd (Name id,bk,t,c) ->
       let id =
-	try match Id.List.assoc id l with { CAst.v = GVar id' } -> id' | _ -> id
+	try match DAst.get (Id.List.assoc id l) with GVar id' -> id' | _ -> id
 	with Not_found -> id in
       GProd (Name id,bk,subst_glob_vars l t,subst_glob_vars l c)
   | GLambda (Name id,bk,t,c) ->
       let id =
-	try match Id.List.assoc id l with { CAst.v = GVar id' } -> id' | _ -> id
+	try match DAst.get (Id.List.assoc id l) with GVar id' -> id' | _ -> id
 	with Not_found -> id in
       GLambda (Name id,bk,subst_glob_vars l t,subst_glob_vars l c)
   | GHole (x,naming,arg) -> GHole (subst_binder_type_vars l x,naming,arg)
-  | _ -> (map_glob_constr (subst_glob_vars l) gc).CAst.v (* assume: id is not binding *)
+  | _ -> DAst.get (map_glob_constr (subst_glob_vars l) gc) (* assume: id is not binding *)
   ) gc
 
 let ldots_var = Id.of_string ".."
 
+let protect g e na =
+  let e',disjpat,na = g e na in
+  if disjpat <> None then user_err (Pp.str "Unsupported substitution of an arbitrary pattern.");
+  e',na
+
+let apply_cases_pattern ?loc ((ids,disjpat),id) c =
+  let tm = DAst.make ?loc (GVar id) in
+  let eqns = List.map (fun pat -> (loc,(ids,[pat],c))) disjpat in
+  DAst.make ?loc @@ GCases (LetPatternStyle, None, [tm,(Anonymous,None)], eqns)
+
 let glob_constr_of_notation_constr_with_binders ?loc g f e nc =
-  let lt x = CAst.make ?loc x in lt @@ match nc with
+  let lt x = DAst.make ?loc x in lt @@ match nc with
   | NVar id -> GVar id
   | NApp (a,args) -> GApp (f e a, List.map (f e) args)
   | NList (x,y,iter,tail,swap) ->
@@ -143,86 +166,104 @@ let glob_constr_of_notation_constr_with_binders ?loc g f e nc =
       let innerl = (ldots_var,t)::(if swap then [] else [x, lt @@ GVar y]) in
       let inner  = lt @@ GApp (lt @@ GVar (ldots_var),[subst_glob_vars innerl it]) in
       let outerl = (ldots_var,inner)::(if swap then [x, lt @@ GVar y] else []) in
-      (subst_glob_vars outerl it).CAst.v
-  | NBinderList (x,y,iter,tail) ->
+      DAst.get (subst_glob_vars outerl it)
+  | NBinderList (x,y,iter,tail,swap) ->
       let t = f e tail in let it = f e iter in
-      let innerl = [(ldots_var,t);(x, lt @@ GVar y)] in
+      let innerl = (ldots_var,t)::(if swap then [] else [x, lt @@ GVar y]) in
       let inner  = lt @@ GApp (lt @@ GVar ldots_var,[subst_glob_vars innerl it]) in
-      let outerl = [(ldots_var,inner)] in
-      (subst_glob_vars outerl it).CAst.v
+      let outerl = (ldots_var,inner)::(if swap then [x, lt @@ GVar y] else []) in
+      DAst.get (subst_glob_vars outerl it)
   | NLambda (na,ty,c) ->
-      let e',na = g e na in GLambda (na,Explicit,f e ty,f e' c)
+      let e',disjpat,na = g e na in GLambda (na,Explicit,f e ty,Option.fold_right (apply_cases_pattern ?loc) disjpat (f e' c))
   | NProd (na,ty,c) ->
-      let e',na = g e na in GProd (na,Explicit,f e ty,f e' c)
+      let e',disjpat,na = g e na in GProd (na,Explicit,f e ty,Option.fold_right (apply_cases_pattern ?loc) disjpat (f e' c))
   | NLetIn (na,b,t,c) ->
-      let e',na = g e na in GLetIn (na,f e b,Option.map (f e) t,f e' c)
+      let e',disjpat,na = g e na in
+      (match disjpat with
+       | None -> GLetIn (na,f e b,Option.map (f e) t,f e' c)
+       | Some disjpat -> DAst.get (apply_cases_pattern ?loc disjpat (f e' c)))
   | NCases (sty,rtntypopt,tml,eqnl) ->
       let e',tml' = List.fold_right (fun (tm,(na,t)) (e',tml') ->
 	let e',t' = match t with
 	| None -> e',None
 	| Some (ind,nal) ->
 	  let e',nal' = List.fold_right (fun na (e',nal) ->
-	      let e',na' = g e' na in e',na'::nal) nal (e',[]) in
-	  e',Some (Loc.tag ?loc (ind,nal')) in
-	let e',na' = g e' na in
-	(e',(f e tm,(na',t'))::tml')) tml (e,[]) in
-      let fold (idl,e) na = let (e,na) = g e na in ((Name.cons na idl,e),na) in
+              let e',na' = protect g e' na in
+              e',na'::nal) nal (e',[]) in
+          e',Some (Loc.tag ?loc (ind,nal')) in
+        let e',na' = protect g e' na in
+        (e',(f e tm,(na',t'))::tml')) tml (e,[]) in
+      let fold (idl,e) na = let (e,disjpat,na) = g e na in ((Name.cons na idl,e),disjpat,na) in
       let eqnl' = List.map (fun (patl,rhs) ->
-	let ((idl,e),patl) =
-	  List.fold_left_map (cases_pattern_fold_map ?loc fold) ([],e) patl in
-	Loc.tag (idl,patl,f e rhs)) eqnl in
-      GCases (sty,Option.map (f e') rtntypopt,tml',eqnl')
+        let ((idl,e),patl) =
+          List.fold_left_map (cases_pattern_fold_map ?loc fold) ([],e) patl in
+        let disjpatl = product_of_cases_patterns patl in
+        List.map (fun patl -> Loc.tag (idl,patl,f e rhs)) disjpatl) eqnl in
+      GCases (sty,Option.map (f e') rtntypopt,tml',List.flatten eqnl')
   | NLetTuple (nal,(na,po),b,c) ->
-      let e',nal = List.fold_left_map g e nal in
-      let e'',na = g e na in
+      let e',nal = List.fold_left_map (protect g) e nal in
+      let e'',na = protect g e na in
       GLetTuple (nal,(na,Option.map (f e'') po),f e b,f e' c)
   | NIf (c,(na,po),b1,b2) ->
-      let e',na = g e na in
+      let e',na = protect g e na in
       GIf (f e c,(na,Option.map (f e') po),f e b1,f e b2)
   | NRec (fk,idl,dll,tl,bl) ->
-      let e,dll = Array.fold_left_map (List.fold_left_map (fun e (na,oc,b) ->
-	  let e,na = g e na in
+      let e,dll = Array.fold_left_map (List.fold_map (fun e (na,oc,b) ->
+          let e,na = protect g e na in
 	  (e,(na,Explicit,Option.map (f e) oc,f e b)))) e dll in
-      let e',idl = Array.fold_left_map (to_id g) e idl in
+      let e',idl = Array.fold_left_map (to_id (protect g)) e idl in
       GRec (fk,idl,dll,Array.map (f e) tl,Array.map (f e') bl)
   | NCast (c,k) -> GCast (f e c,Miscops.map_cast_type (f e) k)
   | NSort x -> GSort x
   | NHole (x, naming, arg)  -> GHole (x, naming, arg)
   | NRef x -> GRef (x,None)
+  | NProj (p,c) -> GProj (p, f e c)
 
 let glob_constr_of_notation_constr ?loc x =
   let rec aux () x =
-    glob_constr_of_notation_constr_with_binders ?loc (fun () id -> ((),id)) aux () x
+    glob_constr_of_notation_constr_with_binders ?loc (fun () id -> ((),None,id)) aux () x
   in aux () x
 
 (******************************************************************************)
 (* Translating a glob_constr into a notation, interpreting recursive patterns *)
 
-let add_id r id = r := (id :: pi1 !r, pi2 !r, pi3 !r)
+type found_variables = {
+    vars : Id.t list;
+    recursive_term_vars : (Id.t * Id.t) list;
+    recursive_binders_vars : (Id.t * Id.t) list;
+  }
+
+let add_id r id = r := { !r with vars = id :: (!r).vars }
 let add_name r = function Anonymous -> () | Name id -> add_id r id
 
+let is_gvar id c = match DAst.get c with
+| GVar id' -> Id.equal id id'
+| _ -> false
+
 let split_at_recursive_part c =
   let sub = ref None in
-  let open CAst in
-  let rec aux = function
-  | { loc = loc0; v = GApp ({ loc; v = GVar v },c::l) } when Id.equal v ldots_var -> (*  *)
+  let rec aux c =
+    let loc0 = c.CAst.loc in
+    match DAst.get c with
+    | GApp (f, c::l) when is_gvar ldots_var f -> (*  *)
+      let loc = f.CAst.loc in
       begin match !sub with
       | None ->
         let () = sub := Some c in
         begin match l with
-        | []     -> CAst.make ?loc @@ GVar ldots_var
-        | _ :: _ -> CAst.make ?loc:loc0 @@ GApp (CAst.make ?loc @@ GVar ldots_var, l)
+        | []     -> DAst.make ?loc @@ GVar ldots_var
+        | _ :: _ -> DAst.make ?loc:loc0 @@ GApp (DAst.make ?loc @@ GVar ldots_var, l)
         end
       | Some _ ->
         (* Not narrowed enough to find only one recursive part *)
         raise Not_found
       end
-  | c -> map_glob_constr aux c in
+    | _ -> map_glob_constr aux c in
   let outer_iterator = aux c in
   match !sub with
   | None -> (* No recursive pattern found *) raise Not_found
   | Some c ->
-  match outer_iterator.v with
+  match DAst.get outer_iterator with
   | GVar v when Id.equal v ldots_var -> (* Not enough context *) raise Not_found
   | _ -> outer_iterator, c
 
@@ -231,51 +272,83 @@ let subtract_loc loc1 loc2 =
   let l2 = fst (Option.cata Loc.unloc (0,0) loc2) in
   Some (Loc.make_loc (l1,l2-1))
 
-let check_is_hole id = function { CAst.v = GHole _ } -> () | t ->
+let check_is_hole id t = match DAst.get t with GHole _ -> () | _ ->
   user_err ?loc:(loc_of_glob_constr t)
-   (strbrk "In recursive notation with binders, " ++ pr_id id ++
+   (strbrk "In recursive notation with binders, " ++ Id.print id ++
     strbrk " is expected to come without type.")
 
+let check_pair_matching ?loc x y x' y' revert revert' =
+  if not (Id.equal x x' && Id.equal y y' && revert = revert') then
+    let x,y = if revert then y,x else x,y in
+    let x',y' = if revert' then y',x' else x',y' in
+    (* This is a case where one would like to highlight two locations! *)
+    user_err ?loc
+      (strbrk "Found " ++ Id.print x ++ strbrk " matching " ++ Id.print y ++
+       strbrk " while " ++ Id.print x' ++ strbrk " matching " ++ Id.print y' ++
+       strbrk " was first found.")
+
 let pair_equal eq1 eq2 (a,b) (a',b') = eq1 a a' && eq2 b b'
 
+let mem_recursive_pair (x,y) l = List.mem_f (pair_equal Id.equal Id.equal) (x,y) l
+
 type recursive_pattern_kind =
-| RecursiveTerms of bool (* associativity *)
-| RecursiveBinders of glob_constr * glob_constr
+| RecursiveTerms of bool (* in reverse order *)
+| RecursiveBinders of bool (* in reverse order *)
 
-let compare_recursive_parts found f f' (iterator,subc) =
-  let open CAst in
+let compare_recursive_parts recvars found f f' (iterator,subc) =
   let diff = ref None in
   let terminator = ref None in
-  let rec aux c1 c2 = match c1.v, c2.v with
+  let rec aux c1 c2 = match DAst.get c1, DAst.get c2 with
   | GVar v, term when Id.equal v ldots_var ->
       (* We found the pattern *)
       assert (match !terminator with None -> true | Some _ -> false);
       terminator := Some c2;
       true
-  | GApp ({ v = GVar v },l1), GApp (term, l2) when Id.equal v ldots_var ->
+  | GApp (f,l1), GApp (term, l2) ->
+    begin match DAst.get f with
+    | GVar v when Id.equal v ldots_var ->
       (* We found the pattern, but there are extra arguments *)
       (* (this allows e.g. alternative (recursive) notation of application) *)
       assert (match !terminator with None -> true | Some _ -> false);
       terminator := Some term;
       List.for_all2eq aux l1 l2
-  | GVar x, GVar y when not (Id.equal x y) ->
+    | _ -> mk_glob_constr_eq aux c1 c2
+    end
+  | GVar x, GVar y
+        when mem_recursive_pair (x,y) recvars || mem_recursive_pair (y,x) recvars ->
       (* We found the position where it differs *)
-      let lassoc = match !terminator with None -> false | Some _ -> true in
-      let x,y = if lassoc then y,x else x,y in
+      let revert = mem_recursive_pair (y,x) recvars in
+      let x,y = if revert then y,x else x,y in
       begin match !diff with
       | None ->
-        let () = diff := Some (x, y, RecursiveTerms lassoc) in
+        let () = diff := Some (x, y, RecursiveTerms revert) in
+        true
+      | Some (x', y', RecursiveTerms revert')
+      | Some (x', y', RecursiveBinders revert') ->
+        check_pair_matching ?loc:c1.CAst.loc x y x' y' revert revert';
         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) when not (Id.equal x y) ->
+  | GProd (Name x,_,t_x,c), GProd (Name y,_,t_y,term)
+        when mem_recursive_pair (x,y) recvars || mem_recursive_pair (y,x) recvars ->
       (* We found a binding position where it differs *)
+      check_is_hole x t_x;
+      check_is_hole y t_y;
+      let revert = mem_recursive_pair (y,x) recvars in
+      let x,y = if revert then y,x else x,y in
       begin match !diff with
       | None ->
-        let () = diff := Some (x, y, RecursiveBinders (t_x,t_y)) in
+        let () = diff := Some (x, y, RecursiveBinders revert) in
         aux c term
-      | Some _ -> false
+      | Some (x', y', RecursiveBinders revert') ->
+        check_pair_matching ?loc:c1.CAst.loc x y x' y' revert revert';
+        true
+      | Some (x', y', RecursiveTerms revert') ->
+        (* Recursive binders have precedence: they can be coerced to
+           terms but not reciprocally *)
+        check_pair_matching ?loc:c1.CAst.loc x y x' y' revert revert';
+        let () = diff := Some (x, y, RecursiveBinders revert) in
+        true
       end
   | _ ->
       mk_glob_constr_eq aux c1 c2 in
@@ -284,57 +357,53 @@ let compare_recursive_parts found f f' (iterator,subc) =
     | None ->
 	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)
+        (* 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,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 iterator
-	      else subst_glob_vars [x, CAst.make @@ GVar y] iterator) in
-	(* found have been collected by compare_constr *)
-	found := newfound;
-	NList (x,y,iterator,f (Option.get !terminator),lassoc)
-    | Some (x,y,RecursiveBinders (t_x,t_y)) ->
-	let newfound = (pi1 !found, pi2 !found, (x,y) :: pi3 !found) in
-	let iterator = f' (subst_glob_vars [x, CAst.make @@ GVar 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))
+    | Some (x,y,RecursiveTerms revert) ->
+        (* By arbitrary convention, we use the second variable of the pair
+           as the place-holder for the iterator *)
+        let iterator =
+          f' (if revert then iterator else subst_glob_vars [x, DAst.make @@ GVar y] iterator) in
+        (* found variables have been collected by compare_constr *)
+        found := { !found with vars = List.remove Id.equal y (!found).vars;
+                               recursive_term_vars = List.add_set (pair_equal Id.equal Id.equal) (x,y) (!found).recursive_term_vars };
+        NList (x,y,iterator,f (Option.get !terminator),revert)
+    | Some (x,y,RecursiveBinders revert) ->
+        let iterator =
+          f' (if revert then iterator else subst_glob_vars [x, DAst.make @@ GVar y] iterator) in
+        (* found have been collected by compare_constr *)
+        found := { !found with vars = List.remove Id.equal y (!found).vars;
+                               recursive_binders_vars = List.add_set (pair_equal Id.equal Id.equal) (x,y) (!found).recursive_binders_vars };
+        NBinderList (x,y,iterator,f (Option.get !terminator),revert)
   else
     raise Not_found
 
-let notation_constr_and_vars_of_glob_constr a =
-  let found = ref ([],[],[]) in
+let notation_constr_and_vars_of_glob_constr recvars a =
+  let found = ref { vars = []; recursive_term_vars = []; recursive_binders_vars = [] } in
   let has_ltac = ref false in
+  (* Turn a glob_constr into a notation_constr by first trying to find a recursive pattern *)
   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 aux' (split_at_recursive_part c)
+    try compare_recursive_parts recvars found aux aux' (split_at_recursive_part c)
     with Not_found ->
     found := keepfound;
-    match c.CAst.v with
-    | GApp ({ CAst.v = GVar f; loc},[c]) when Id.equal f ldots_var ->
+    match DAst.get c with
+    | GApp (t, [_]) ->
+      begin match DAst.get t with
+      | GVar f when Id.equal f ldots_var ->
 	(* Fall on the second part of the recursive pattern w/o having
 	   found the first part *)
+        let loc = t.CAst.loc in
 	user_err ?loc 
 	(str "Cannot find where the recursive pattern starts.")
+      | _ -> aux' c
+      end
     | _c ->
 	aux' c
-  and aux' x = CAst.with_val (function
-  | GVar id -> add_id found id; NVar id
+  and aux' x = DAst.with_val (function
+  | GVar id -> if not (Id.equal id ldots_var) then add_id found id; NVar id
   | GApp (g,args) -> NApp (aux g, List.map aux args)
   | GLambda (na,bk,ty,c) -> add_name found na; NLambda (na,aux ty,aux c)
   | GProd (na,bk,ty,c) -> add_name found na; NProd (na,aux ty,aux c)
@@ -368,6 +437,7 @@ let notation_constr_and_vars_of_glob_constr a =
      if arg != None then has_ltac := true;
      NHole (w, naming, arg)
   | GRef (r,_) -> NRef r
+  | GProj (p, c) -> NProj (p, aux c)
   | GEvar _ | GPatVar _ ->
       user_err Pp.(str "Existential variables not allowed in notations.")
   ) x
@@ -376,8 +446,9 @@ let notation_constr_and_vars_of_glob_constr a =
   (* Side effect *)
   t, !found, !has_ltac
 
-let check_variables_and_reversibility nenv (found,foundrec,foundrecbinding) =
-  let injective = ref true in
+let check_variables_and_reversibility nenv
+  { vars = found; recursive_term_vars = foundrec; recursive_binders_vars = foundrecbinding } =
+  let injective = ref [] 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
@@ -385,7 +456,7 @@ let check_variables_and_reversibility 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
-      user_err  (pr_id x ++
+      user_err  (Id.print 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
@@ -400,40 +471,43 @@ let check_variables_and_reversibility nenv (found,foundrec,foundrecbinding) =
 	user_err Pp.(str
           (Id.to_string x ^
           " should not be bound in a recursive pattern of the right-hand side."))
-      else injective := false
+      else injective := x :: !injective
   in
   let check_pair s x y where =
-    if not (List.mem_f (pair_equal Id.equal Id.equal) (x,y) where) then
-      user_err  (strbrk "in the right-hand side, " ++ pr_id x ++
-	str " and " ++ pr_id y ++ strbrk " should appear in " ++ str s ++
+    if not (mem_recursive_pair (x,y) where) then
+      user_err  (strbrk "in the right-hand side, " ++ Id.print x ++
+	str " and " ++ Id.print y ++ strbrk " should appear in " ++ str s ++
 	str " position as part of a recursive pattern.") in
   let check_type x typ =
     match typ with
-    | NtnInternTypeConstr ->
+    | NtnInternTypeAny ->
 	begin
 	  try check_pair "term" x (Id.Map.find x recvars) foundrec
 	  with Not_found -> check_bound x
 	end
-    | NtnInternTypeBinder ->
+    | NtnInternTypeOnlyBinder ->
 	begin
 	  try check_pair "binding" x (Id.Map.find x recvars) foundrecbinding
 	  with Not_found -> check_bound x
-	end
-    | NtnInternTypeIdent -> check_bound x in
+        end in
   Id.Map.iter check_type vars;
-  !injective
+  List.rev !injective
 
 let notation_constr_of_glob_constr nenv a =
-  let a, found, has_ltac = notation_constr_and_vars_of_glob_constr a in
+  let recvars = Id.Map.bindings nenv.ninterp_rec_vars in
+  let a, found, has_ltac = notation_constr_and_vars_of_glob_constr recvars a in
   let injective = check_variables_and_reversibility nenv found in
-  a, not has_ltac && injective
+  let status = if has_ltac then HasLtac else match injective with
+  | [] -> APrioriReversible
+  | l -> NonInjective l in
+  a, status
 
 (**********************************************************************)
 (* Substitution of kernel names, avoiding a list of bound identifiers *)
 
 let notation_constr_of_constr avoiding t =
   let t = EConstr.of_constr t in
-  let t = Detyping.detype false avoiding (Global.env()) Evd.empty t in
+  let t = Detyping.detype Detyping.Now false avoiding (Global.env()) Evd.empty t in
   let nenv = {
     ninterp_var_type = Id.Map.empty;
     ninterp_rec_vars = Id.Map.empty;
@@ -441,13 +515,13 @@ let notation_constr_of_constr avoiding t =
   notation_constr_of_glob_constr nenv t
 
 let rec subst_pat subst pat =
-  match pat.CAst.v with
+  match DAst.get pat with
   | PatVar _ -> pat
   | PatCstr (((kn,i),j),cpl,n) ->
       let kn' = subst_mind subst kn
       and cpl' = List.smartmap (subst_pat subst) cpl in
       if kn' == kn && cpl' == cpl then pat else
-        CAst.make ?loc:pat.CAst.loc @@ PatCstr (((kn',i),j),cpl',n)
+        DAst.make ?loc:pat.CAst.loc @@ PatCstr (((kn',i),j),cpl',n)
 
 let rec subst_notation_constr subst bound raw =
   match raw with
@@ -482,11 +556,11 @@ let rec subst_notation_constr subst bound raw =
 	if r1' == r1 && r2' == r2 then raw else
 	  NProd (n,r1',r2')
 
-  | NBinderList (id1,id2,r1,r2) ->
+  | NBinderList (id1,id2,r1,r2,b) ->
       let r1' = subst_notation_constr subst bound r1
       and r2' = subst_notation_constr subst bound r2 in
 	if r1' == r1 && r2' == r2 then raw else
-	  NBinderList (id1,id2,r1',r2')
+          NBinderList (id1,id2,r1',r2',b)
 
   | NLetIn (n,r1,t,r2) ->
       let r1' = subst_notation_constr subst bound r1 in
@@ -561,8 +635,16 @@ let rec subst_notation_constr subst bound raw =
       let k' = Miscops.smartmap_cast_type (subst_notation_constr subst bound) k in
       if r1' == r1 && k' == k then raw else NCast(r1',k')
 
+  | NProj (p, c) ->
+    let kn = Projection.constant p in
+    let b = Projection.unfolded p in
+    let kn' = subst_constant subst kn in
+    let c' = subst_notation_constr subst bound c in
+    if kn' == kn && c' == c then raw else NProj(Projection.make kn' b, c')
+
+
 let subst_interpretation subst (metas,pat) =
-  let bound = List.map fst metas in
+  let bound = List.fold_left (fun accu (id, _) -> Id.Set.add id accu) Id.Set.empty metas in
   (metas,subst_notation_constr subst bound pat)
 
 (**********************************************************************)
@@ -576,21 +658,33 @@ let abstract_return_type_context pi mklam tml rtno =
     List.fold_right mklam nal rtn)
     rtno
 
-let abstract_return_type_context_glob_constr =
+let abstract_return_type_context_glob_constr tml rtn =
   abstract_return_type_context (fun (_,(_,nal)) -> nal)
-    (fun na c -> CAst.make @@
-      GLambda(na,Explicit,CAst.make @@ GHole(Evar_kinds.InternalHole,Misctypes.IntroAnonymous,None),c))
+    (fun na c -> DAst.make @@
+      GLambda(na,Explicit,DAst.make @@ GHole(Evar_kinds.InternalHole,Misctypes.IntroAnonymous,None),c)) tml rtn
 
-let abstract_return_type_context_notation_constr =
+let abstract_return_type_context_notation_constr tml rtn =
   abstract_return_type_context snd
-    (fun na c -> NLambda(na,NHole (Evar_kinds.InternalHole, Misctypes.IntroAnonymous, None),c))
+    (fun na c -> NLambda(na,NHole (Evar_kinds.InternalHole, Misctypes.IntroAnonymous, None),c)) tml rtn
 
 let is_term_meta id metas =
   try match Id.List.assoc id metas with _,(NtnTypeConstr | NtnTypeConstrList) -> true | _ -> false
   with Not_found -> false
 
+let is_onlybinding_strict_meta id metas =
+  try match Id.List.assoc id metas with _,NtnTypeBinder (NtnParsedAsPattern true) -> true | _ -> false
+  with Not_found -> false
+
 let is_onlybinding_meta id metas =
-  try match Id.List.assoc id metas with _,NtnTypeOnlyBinder -> true | _ -> false
+  try match Id.List.assoc id metas with _,NtnTypeBinder _ -> true | _ -> false
+  with Not_found -> false
+
+let is_onlybinding_pattern_like_meta isvar id metas =
+  try match Id.List.assoc id metas with
+      | _,NtnTypeBinder (NtnBinderParsedAsConstr
+                           (Extend.AsIdentOrPattern | Extend.AsStrictPattern)) -> true
+      | _,NtnTypeBinder (NtnParsedAsPattern strict) -> not (strict && isvar)
+      | _ -> false
   with Not_found -> false
 
 let is_bindinglist_meta id metas =
@@ -609,7 +703,7 @@ 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 =
+let add_env (alp,alpmetas) (terms,termlists,binders,binderlists) var v =
   (* Check that no capture of binding variables occur *)
   (* [alp] is used when matching a pattern "fun x => ... x ... ?var ... x ..."
      with an actual term "fun z => ... z ..." when "x" is not bound in the
@@ -637,64 +731,170 @@ let add_env (alp,alpmetas) (terms,onlybinders,termlists,binderlists) var v =
      refinement *)
   let v = alpha_rename alpmetas v in
   (* TODO: handle the case of multiple occs in different scopes *)
-  ((var,v)::terms,onlybinders,termlists,binderlists)
+  ((var,v)::terms,termlists,binders,binderlists)
 
-let add_termlist_env (alp,alpmetas) (terms,onlybinders,termlists,binderlists) var vl =
+let add_termlist_env (alp,alpmetas) (terms,termlists,binders,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)
+  (terms,(var,vl)::termlists,binders,binderlists)
 
-let add_binding_env alp (terms,onlybinders,termlists,binderlists) var v =
+let add_binding_env alp (terms,termlists,binders,binderlists) var v =
   (* TODO: handle the case of multiple occs in different scopes *)
-  (terms,(var,v)::onlybinders,termlists,binderlists)
+  (terms,termlists,(var,v)::binders,binderlists)
 
-let add_bindinglist_env (terms,onlybinders,termlists,binderlists) x bl =
-  (terms,onlybinders,termlists,(x,bl)::binderlists)
+let add_bindinglist_env (terms,termlists,binders,binderlists) x bl =
+  (terms,termlists,binders,(x,bl)::binderlists)
 
-let rec pat_binder_of_term t = CAst.map (function
+let rec map_cases_pattern_name_left f = DAst.map (function
+  | PatVar na -> PatVar (f na)
+  | PatCstr (c,l,na) -> PatCstr (c,List.map_left (map_cases_pattern_name_left f) l,f na)
+  )
+
+let rec fold_cases_pattern_eq f x p p' =
+  let loc = p.CAst.loc in
+  match DAst.get p, DAst.get p' with
+  | PatVar na, PatVar na' -> let x,na = f x na na' in x, DAst.make ?loc @@ PatVar na
+  | PatCstr (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, DAst.make ?loc @@ PatCstr (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 DAst.get p1, DAst.get 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 rec pat_binder_of_term t = DAst.map (function
   | GVar id -> PatVar (Name id)
-  | GApp ({ CAst.v = GRef (ConstructRef cstr,_)}, l) ->
+  | GApp (t, l) ->
+    begin match DAst.get t with
+    | GRef (ConstructRef cstr,_) ->
      let nparams = Inductiveops.inductive_nparams (fst cstr) in
      let _,l = List.chop nparams l in
      PatCstr (cstr, List.map pat_binder_of_term l, Anonymous)
+    | _ -> raise No_match
+    end
   | _ -> raise No_match
   ) t
 
-let bind_term_env alp (terms,onlybinders,termlists,binderlists as sigma) var v =
+let unify_name_upto 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'
+
+let unify_pat_upto alp p p' =
+  try fold_cases_pattern_eq unify_name_upto alp p p' with Failure _ -> raise No_match
+
+let unify_term alp v v' =
+  match DAst.get v, DAst.get v' with
+  | GHole _, _ -> v'
+  | _, GHole _ -> v
+  | _, _ -> if glob_constr_eq (alpha_rename (snd alp) v) v' then v else raise No_match
+
+let unify_opt_term alp v v' =
+  match v, v' with
+  | Some t, Some t' -> Some (unify_term alp t t')
+  | (Some _ as x), None | None, (Some _ as x) -> x
+  | None, None -> None
+
+let unify_binding_kind bk bk' = if bk == bk' then bk' else raise No_match
+
+let unify_binder_upto alp b b' =
+  let loc, loc' = CAst.(b.loc, b'.loc) in
+  match DAst.get b, DAst.get b' with
+  | GLocalAssum (na,bk,t), GLocalAssum (na',bk',t') ->
+     let alp, na = unify_name_upto alp na na' in
+     alp, DAst.make ?loc @@ GLocalAssum (na, unify_binding_kind bk bk', unify_term alp t t')
+  | GLocalDef (na,bk,c,t), GLocalDef (na',bk',c',t') ->
+     let alp, na = unify_name_upto alp na na' in
+     alp, DAst.make ?loc @@ GLocalDef (na, unify_binding_kind bk bk', unify_term alp c c', unify_opt_term alp t t')
+  | GLocalPattern ((disjpat,ids),id,bk,t), GLocalPattern ((disjpat',_),_,bk',t') when List.length disjpat = List.length disjpat' ->
+     let alp, p = List.fold_left2_map unify_pat_upto alp disjpat disjpat' in
+     alp, DAst.make ?loc @@ GLocalPattern ((p,ids), id, unify_binding_kind bk bk', unify_term alp t t')
+  | _ -> raise No_match
+
+let rec unify_terms alp vl vl' =
+  match vl, vl' with
+  | [], [] -> []
+  | v :: vl, v' :: vl' -> unify_term alp v v' :: unify_terms alp vl vl'
+  | _ -> raise No_match
+
+let rec unify_binders_upto alp bl bl' =
+  match bl, bl' with
+  | [], [] -> alp, []
+  | b :: bl, b' :: bl' ->
+     let alp,b = unify_binder_upto alp b b' in
+     let alp,bl = unify_binders_upto alp bl bl' in
+     alp, b :: bl
+  | _ -> raise No_match
+
+let unify_id alp 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
+
+let unify_pat alp p p' =
+  if cases_pattern_eq (map_cases_pattern_name_left (Name.map (rename_var (snd alp))) p) p' then p'
+  else raise No_match
+
+let unify_term_binder alp c = DAst.(map (fun b' ->
+  match DAst.get c, b' with
+  | GVar id, GLocalAssum (na', bk', t') ->
+     GLocalAssum (unify_id alp id na', bk', t')
+  | _, GLocalPattern (([p'],ids), id, bk', t') ->
+     let p = pat_binder_of_term c in
+     GLocalPattern (([unify_pat alp p p'],ids), id, bk', t')
+  | _ -> raise No_match))
+
+let rec unify_terms_binders alp cl bl' =
+  match cl, bl' with
+  | [], [] -> []
+  | c :: cl, b' :: bl' ->
+     begin match DAst.get b' with
+     | GLocalDef ( _, _, _, t) -> unify_terms_binders alp cl bl'
+     | _ -> unify_term_binder alp c b' :: unify_terms_binders alp cl bl'
+     end
+  | _ -> raise No_match
+
+let bind_term_env alp (terms,termlists,binders,binderlists as sigma) var v =
   try
+    (* If already bound to a term, unify with the new term *)
     let v' = Id.List.assoc var terms in
-    match CAst.(v.v, v'.v) with
-    | GHole _, _ -> sigma
-    | _, GHole _ ->
-        let sigma = Id.List.remove_assoc var terms,onlybinders,termlists,binderlists in
-        add_env alp sigma var v
-    | _, _ ->
-        if glob_constr_eq (alpha_rename (snd alp) v) v' then sigma
-        else raise No_match
+    let v'' = unify_term alp v v' in
+    if v'' == v' then sigma else
+      let sigma = (Id.List.remove_assoc var terms,termlists,binders,binderlists) in
+      add_env alp sigma var v
   with Not_found -> add_env alp sigma var v
 
-let bind_termlist_env alp (terms,onlybinders,termlists,binderlists as sigma) var vl =
+let bind_termlist_env alp (terms,termlists,binders,binderlists as sigma) var vl =
   try
+    (* If already bound to a list of term, unify with the new terms *)
     let vl' = Id.List.assoc var termlists in
-    let unify_term v v' =
-      match CAst.(v.v, 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
+    let vl = unify_terms alp vl vl' in
+    let sigma = (terms,Id.List.remove_assoc var termlists,binders,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 =
+let bind_term_as_binding_env alp (terms,termlists,binders,binderlists as sigma) var id =
   try
-    match Id.List.assoc var terms with
-    | { CAst.v = GVar id' } ->
+    (* If already bound to a term, unify the binder and the term *)
+    match DAst.get (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.")
@@ -702,139 +902,51 @@ let bind_term_as_binding_env alp (terms,onlybinders,termlists,binderlists as sig
     (* 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 (CAst.make @@ GVar id)
+    alp, add_env alp sigma var (DAst.make @@ GVar id)
+
+let force_cases_pattern c =
+  DAst.make ?loc:c.CAst.loc (DAst.get c)
 
-let bind_binding_as_term_env alp (terms,onlybinders,termlists,binderlists as sigma) var id =
+let bind_binding_as_term_env alp (terms,termlists,binders,binderlists as sigma) var c =
+  let pat = try force_cases_pattern (cases_pattern_of_glob_constr Anonymous c) with Not_found -> raise No_match in
   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 =
+    (* If already bound to a binder, unify the term and the binder *)
+    let patl' = Id.List.assoc var binders in
+    let patl'' = List.map2 (unify_pat alp) [pat] patl' in
+    if patl' == patl'' then sigma
+    else
+      let sigma = (terms,termlists,Id.List.remove_assoc var binders,binderlists) in
+      add_binding_env alp sigma var patl''
+  with Not_found -> add_binding_env alp sigma var [pat]
+
+let bind_binding_env alp (terms,termlists,binders,binderlists as sigma) var disjpat =
   try
-    let v' = Id.List.assoc var onlybinders in
-    match v, v' with
-    | Anonymous, _ -> alp, sigma
-    | _, Anonymous ->
-        let sigma = (terms,Id.List.remove_assoc var onlybinders,termlists,binderlists) in
-        alp, add_binding_env alp sigma var v
-    | Name id1, Name id2 ->
-        if Id.equal id1 id2 then alp,sigma
-        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 = CAst.map (function
-  | PatVar na -> PatVar (f na)
-  | PatCstr (c,l,na) -> PatCstr (c,List.map_left (map_cases_pattern_name_left f) l,f na)
-  )
-
-let rec fold_cases_pattern_eq f x p p' = let open CAst in match p, p' with
-  | { loc; v = PatVar na}, { v = PatVar na' } -> let x,na = f x na na' in x, CAst.make ?loc @@ PatVar na
-  | { loc; v = PatCstr (c,l,na)}, { v = 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, CAst.make ?loc @@ PatCstr (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 CAst.(p1.v, p2.v) 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 =
+    (* If already bound to a binder possibly *)
+    (* generating an alpha-renaming from unifying the new binder *)
+    let disjpat' = Id.List.assoc var binders in
+    let alp, disjpat = List.fold_left2_map unify_pat_upto alp disjpat disjpat' in
+    let sigma = (terms,termlists,Id.List.remove_assoc var binders,binderlists) in
+    alp, add_binding_env alp sigma var disjpat
+  with Not_found -> alp, add_binding_env alp sigma var disjpat
+
+let bind_bindinglist_env alp (terms,termlists,binders,binderlists as sigma) var bl =
   let bl = List.rev bl in
   try
+    (* If already bound to a list of binders possibly *)
+    (* generating an alpha-renaming from unifying the new binders *)
     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 CAst.(v.v, 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_opt_term alp v v' =
-      match v, v' with
-      | Some t, Some t' -> Some (unify_term alp t t')
-      | (Some _ as x), None | None, (Some _ as x) -> x
-      | None, None -> None in
-    let unify_binding_kind bk bk' = if bk == bk' then bk' else raise No_match in
-    let unify_binder alp b b' =
-      let loc, loc' = CAst.(b.loc, b'.loc) in
-      match CAst.(b.v, b'.v) with
-      | GLocalAssum (na,bk,t), GLocalAssum (na',bk',t') ->
-         let alp, na = unify_name alp na na' in
-         alp, CAst.make ?loc @@ GLocalAssum (na, unify_binding_kind bk bk', unify_term alp t t')
-      | GLocalDef (na,bk,c,t), GLocalDef (na',bk',c',t') ->
-         let alp, na = unify_name alp na na' in
-         alp, CAst.make ?loc @@ GLocalDef (na, unify_binding_kind bk bk', unify_term alp c c', unify_opt_term alp t t')
-      | GLocalPattern ((p,ids),id,bk,t), GLocalPattern ((p',_),_,bk',t') ->
-         let alp, p = unify_pat alp p p' in
-         alp, CAst.make ?loc @@ GLocalPattern ((p,ids), id, unify_binding_kind bk bk', 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
+    let alp, bl = unify_binders_upto alp bl bl' in
+    let sigma = (terms,termlists,binders,Id.List.remove_assoc var 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 =
+let bind_bindinglist_as_termlist_env alp (terms,termlists,binders,binderlists) var cl =
   try
+    (* If already bound to a list of binders, unify the terms and binders *)
     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 = CAst.(map (fun b' ->
-      match c, b' with
-      | { v = GVar id}, GLocalAssum (na', bk', t') ->
-         GLocalAssum (unify_id id na', bk', t')
-      | c, GLocalPattern ((p',ids), id, bk', t') ->
-         let p = pat_binder_of_term c in
-         GLocalPattern ((unify_pat p p',ids), id, bk', t')
-      | _ -> raise No_match )) in
-    let rec unify cl bl' =
-    match cl, bl' with
-    | [], [] -> []
-    | c :: cl, { CAst.v = GLocalDef ( _, _, _, 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
+    let bl = unify_terms_binders alp cl bl' in
+    let sigma = (terms,termlists,binders,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.")
@@ -858,8 +970,10 @@ let match_opt f sigma t1 t2 = match (t1,t2) with
   | _ -> raise No_match
 
 let match_names metas (alp,sigma) na1 na2 = match (na1,na2) with
+  | (na1,Name id2) when is_onlybinding_strict_meta id2 metas ->
+      raise No_match
   | (na1,Name id2) when is_onlybinding_meta id2 metas ->
-      bind_binding_env alp sigma id2 na1
+      bind_binding_env alp sigma id2 [DAst.make (PatVar 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 #4592)) *)
@@ -871,46 +985,42 @@ let match_names metas (alp,sigma) na1 na2 = match (na1,na2) with
   | (Anonymous,Anonymous) -> alp,sigma
   | _ -> raise No_match
 
-let rec match_cases_pattern_binders metas acc pat1 pat2 =
-  match CAst.(pat1.v, pat2.v) with
+let rec match_cases_pattern_binders allow_catchall metas (alp,sigma as acc) pat1 pat2 =
+  match DAst.get pat1, DAst.get pat2 with
+  | PatVar _, PatVar (Name id2) when is_onlybinding_pattern_like_meta true id2 metas ->
+      bind_binding_env alp sigma id2 [pat1]
+  | _, PatVar (Name id2) when is_onlybinding_pattern_like_meta false id2 metas ->
+      bind_binding_env alp sigma id2 [pat1]
   | PatVar na1, PatVar na2 -> match_names metas acc na1 na2
+  | _, PatVar Anonymous when allow_catchall -> acc
   | PatCstr (c1,patl1,na1), PatCstr (c2,patl2,na2)
       when eq_constructor c1 c2 && Int.equal (List.length patl1) (List.length patl2) ->
-      List.fold_left2 (match_cases_pattern_binders metas)
-	(match_names metas acc na1 na2) patl1 patl2
+      List.fold_left2 (match_cases_pattern_binders false metas)
+        (match_names metas acc na1 na2) patl1 patl2
   | _ -> raise No_match
 
-let glue_letin_with_decls = true
-
-let rec match_iterated_binders islambda decls bi = CAst.(with_loc_val (fun ?loc -> function
-  | GLambda (Name p,bk,t, { v = GCases (LetPatternStyle,None,[({ v = GVar e },_)],[(_,(ids,[cp],b))])})
-      when islambda && Id.equal p e ->
-      match_iterated_binders islambda ((CAst.make ?loc @@ GLocalPattern((cp,ids),p,bk,t))::decls) b
-  | GLambda (na,bk,t,b) when islambda ->
-      match_iterated_binders islambda ((CAst.make ?loc @@ GLocalAssum(na,bk,t))::decls) b
-  | GProd (Name p,bk,t, { v = GCases (LetPatternStyle,None,[({ v = GVar e },_)],[(_,(ids,[cp],b))]) } )
-      when not islambda && Id.equal p e ->
-      match_iterated_binders islambda ((CAst.make ?loc @@ GLocalPattern((cp,ids),p,bk,t))::decls) b
-  | GProd ((Name _ as na),bk,t,b) when not islambda ->
-      match_iterated_binders islambda ((CAst.make ?loc @@ GLocalAssum(na,bk,t))::decls) b
-  | GLetIn (na,c,t,b) when glue_letin_with_decls ->
-      match_iterated_binders islambda
-	((CAst.make ?loc @@ GLocalDef (na,Explicit (*?*), c,t))::decls) b
-  | b -> (decls, CAst.make ?loc b)
-  )) bi
-
-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 remove_sigma x (terms,termlists,binders,binderlists) =
+  (Id.List.remove_assoc x terms,termlists,binders,binderlists)
+
+let remove_bindinglist_sigma x (terms,termlists,binders,binderlists) =
+  (terms,termlists,binders,Id.List.remove_assoc x binderlists)
 
 let add_ldots_var metas = (ldots_var,((None,[]),NtnTypeConstr))::metas
 
 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 =
+(* This tells if letins in the middle of binders should be included in
+   the sequence of binders *)
+let glue_inner_letin_with_decls = true
+
+(* This tells if trailing letins (with no further proper binders)
+   should be included in sequence of binders *)
+let glue_trailing_letin_with_decls = false
+
+exception OnlyTrailingLetIns
+
+let match_binderlist match_fun alp metas sigma rest x y iter termin revert =
+  let rec aux trailing_letins sigma bl rest =
     try
       let metas = add_ldots_var (add_meta_bindinglist y metas) in
       let (terms,_,_,binderlists as sigma) = match_fun alp metas sigma rest iter in
@@ -919,16 +1029,32 @@ let match_binderlist_with_app match_fun alp metas sigma rest x y iter termin =
         match Id.List.assoc y binderlists with [b] -> b | _ ->assert false
       in
       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
+      (* In case y is bound not only to a binder but also to a term *)
+      let sigma = remove_sigma y sigma in
+      aux false sigma (b::bl) rest
+    with No_match ->
+    match DAst.get rest with
+    | GLetIn (na,c,t,rest') when glue_inner_letin_with_decls ->
+       let b = DAst.make ?loc:rest.CAst.loc @@ GLocalDef (na,Explicit (*?*), c,t) in
+       (* collect let-in *)
+       (try aux true sigma (b::bl) rest'
+        with OnlyTrailingLetIns
+             when not (trailing_letins && not glue_trailing_letin_with_decls) ->
+         (* renounce to take into account trailing let-ins *)
+         if not (List.is_empty bl) then bl, rest, sigma else raise No_match)
+    | _ ->
+       if trailing_letins && not glue_trailing_letin_with_decls then
+         (* Backtrack to when we tried to glue letins *)
+         raise OnlyTrailingLetIns;
+       if not (List.is_empty bl) then bl, rest, sigma else raise No_match in
+  let bl,rest,sigma = aux false sigma [] rest in
+  let bl = if revert then List.rev bl else bl 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_termlist match_fun alp metas sigma rest x y iter termin lassoc =
+let match_termlist match_fun alp metas sigma rest x y iter termin revert =
   let rec aux sigma acc rest =
     try
       let metas = add_ldots_var (add_meta_term y metas) in
@@ -939,16 +1065,29 @@ let match_termlist match_fun alp metas sigma rest x y iter termin lassoc =
       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
-  let l = if lassoc then l else List.rev l in
+  let l,(terms,termlists,binders,binderlists as sigma) = aux sigma [] rest in
+  let l = if revert 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
+    bind_bindinglist_as_termlist_env alp sigma x l
   else
     bind_termlist_env alp sigma x l
 
-let does_not_come_from_already_eta_expanded_var =
+let match_cast match_fun sigma c1 c2 =
+  match c1, c2 with
+  | CastConv t1, CastConv t2
+  | CastVM t1, CastVM t2
+  | CastNative t1, CastNative t2 ->
+    match_fun sigma t1 t2
+  | CastCoerce, CastCoerce ->
+    sigma
+  | CastConv _, _
+  | CastVM _, _
+  | CastNative _, _
+  | CastCoerce, _ -> raise No_match
+
+let does_not_come_from_already_eta_expanded_var glob =
   (* This is hack to avoid looping on a rule with rhs of the form *)
   (* "?f (fun ?x => ?g)" since otherwise, matching "F H" expands in *)
   (* "F (fun x => H x)" and "H x" is recursively matched against the same *)
@@ -958,66 +1097,27 @@ let does_not_come_from_already_eta_expanded_var =
   (* The following test is then an approximation of what can be done *)
   (* optimally (whether other looping situations can occur remains to be *)
   (* checked). *)
-  function { CAst.v = GVar _ } -> false | _ -> true
+  match DAst.get glob with GVar _ -> false | _ -> true
 
 let rec match_ inner u alp metas sigma a1 a2 =
   let open CAst in
   let loc = a1.loc in
-  match a1.v, a2 with
+  match DAst.get a1, a2 with
   (* Matching notation variable *)
   | r1, NVar id2 when is_term_meta id2 metas -> bind_term_env alp sigma id2 a1
-  | GVar id1, NVar id2 when is_onlybinding_meta id2 metas -> bind_binding_as_term_env alp sigma id2 id1
+  | GVar _, NVar id2 when is_onlybinding_pattern_like_meta true id2 metas -> bind_binding_as_term_env alp sigma id2 a1
+  | r1, NVar id2 when is_onlybinding_pattern_like_meta false id2 metas -> bind_binding_as_term_env alp sigma id2 a1
+  | GVar _, NVar id2 when is_onlybinding_strict_meta id2 metas -> raise No_match
+  | GVar _, NVar id2 when is_onlybinding_meta id2 metas -> bind_binding_as_term_env alp sigma id2 a1
   | r1, NVar id2 when is_bindinglist_meta id2 metas -> bind_term_env alp sigma id2 a1
 
   (* Matching recursive notations for terms *)
-  | r1, NList (x,y,iter,termin,lassoc) ->
-      match_termlist (match_hd u alp) alp metas sigma a1 x y iter termin lassoc
-
-  (* "λ p, let 'cp = p in t" -> "λ 'cp, t" *)
-  | GLambda (Name p,bk,t1, { v = GCases (LetPatternStyle,None,[({ v = GVar e},_)],[(_,(ids,[cp],b1))])}),
-    NBinderList (x,_,NLambda (Name _id2,_,b2),termin) when Id.equal p e ->
-      let (decls,b) = match_iterated_binders true [CAst.make ?loc @@ GLocalPattern((cp,ids),p,bk,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 [CAst.make ?loc @@ GLocalAssum (na1,bk,t1)] b1 in
-      (* TODO: address the possibility that termin is a Lambda itself *)
-      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, { v = GCases (LetPatternStyle,None,[({ v = GVar e },_)],[(_,(ids,[cp],b1))]) } ),
-    NBinderList (x,_,NProd (Name _id2,_,b2),(NVar v as termin)) when Id.equal p e ->
-      let (decls,b) = match_iterated_binders true [CAst.make ?loc @@ GLocalPattern ((cp,ids),p,bk,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 [CAst.make ?loc @@ GLocalAssum (na1,bk,t1)] b1 in
-      (* TODO: address the possibility that termin is a Prod itself *)
-      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,y,iter,termin) ->
-      match_binderlist_with_app (match_hd u) alp metas sigma a1 x y iter termin
+  | r1, NList (x,y,iter,termin,revert) ->
+      match_termlist (match_hd u alp) alp metas sigma a1 x y iter termin revert
 
-  (* Matching individual binders as part of a recursive pattern *)
-  | GLambda (Name p,bk,t, { v = GCases (LetPatternStyle,None,[({ v = GVar e },_)],[(_,(ids,[cp],b1))])}),
-    NLambda (Name id,_,b2)
-      when is_bindinglist_meta id metas ->
-      let alp,sigma = bind_bindinglist_env alp sigma id [CAst.make ?loc @@ GLocalPattern ((cp,ids),p,bk,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 ->
-      let alp,sigma = bind_bindinglist_env alp sigma id [CAst.make ?loc @@ GLocalAssum (na,bk,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 ->
-      let alp,sigma = bind_bindinglist_env alp sigma id [CAst.make ?loc @@ GLocalAssum (na,bk,t)] in
-      match_in u alp metas sigma b1 b2
+  (* Matching recursive notations for binders: general case *)
+  | _r, NBinderList (x,y,iter,termin,revert) ->
+      match_binderlist (match_hd u) alp metas sigma a1 x y iter termin revert
 
   (* Matching compositionally *)
   | GVar id1, NVar id2 when alpha_var id1 id2 (fst alp) -> sigma
@@ -1028,15 +1128,15 @@ let rec match_ inner u alp metas sigma a1 a2 =
 	if n1 < n2 then
 	  let l21,l22 = List.chop (n2-n1) l2 in f1,l1, NApp (f2,l21), l22
 	else if n1 > n2 then
-	  let l11,l12 = List.chop (n1-n2) l1 in CAst.make ?loc @@ GApp (f1,l11),l12, f2,l2
+	  let l11,l12 = List.chop (n1-n2) l1 in DAst.make ?loc @@ GApp (f1,l11),l12, f2,l2
 	else f1,l1, f2, l2 in
       let may_use_eta = does_not_come_from_already_eta_expanded_var f1 in
       List.fold_left2 (match_ may_use_eta u alp metas)
-        (match_in u alp metas sigma f1 f2) l1 l2
-  | GLambda (na1,_,t1,b1), NLambda (na2,t2,b2) ->
-     match_binders u alp metas na1 na2 (match_in u alp metas sigma t1 t2) b1 b2
-  | GProd (na1,_,t1,b1), NProd (na2,t2,b2) ->
-     match_binders u alp metas na1 na2 (match_in u alp metas sigma t1 t2) b1 b2
+        (match_hd u alp metas sigma f1 f2) l1 l2
+  | GLambda (na1,bk1,t1,b1), NLambda (na2,t2,b2) ->
+     match_extended_binders false u alp metas na1 na2 bk1 t1 (match_in u alp metas sigma t1 t2) b1 b2
+  | GProd (na1,bk1,t1,b1), NProd (na2,t2,b2) ->
+     match_extended_binders true u alp metas na1 na2 bk1 t1 (match_in u alp metas sigma t1 t2) b1 b2
   | GLetIn (na1,b1,_,c1), NLetIn (na2,b2,None,c2)
   | GLetIn (na1,b1,None,c1), NLetIn (na2,b2,_,c2) ->
      match_binders u alp metas na1 na2 (match_in u alp metas sigma b1 b2) c1 c2
@@ -1044,9 +1144,7 @@ let rec match_ inner u alp metas sigma a1 a2 =
      match_binders u alp metas na1 na2
        (match_in u alp metas (match_in u alp metas sigma b1 b2) t1 t2) c1 c2
   | GCases (sty1,rtno1,tml1,eqnl1), NCases (sty2,rtno2,tml2,eqnl2)
-      when sty1 == sty2
-	 && Int.equal (List.length tml1) (List.length tml2)
-	 && Int.equal (List.length eqnl1) (List.length eqnl2) ->
+      when sty1 == sty2 && Int.equal (List.length tml1) (List.length tml2) ->
       let rtno1' = abstract_return_type_context_glob_constr tml1 rtno1 in
       let rtno2' = abstract_return_type_context_notation_constr tml2 rtno2 in
       let sigma =
@@ -1056,7 +1154,14 @@ let rec match_ inner u alp metas sigma a1 a2 =
       let sigma = List.fold_left2
       (fun s (tm1,_) (tm2,_) ->
         match_in u alp metas s tm1 tm2) sigma tml1 tml2 in
-      List.fold_left2 (match_equations u alp metas) sigma eqnl1 eqnl2
+      (* Try two different strategies for matching clauses *)
+      (try
+        List.fold_left2_set No_match (match_equations u alp metas) sigma eqnl1 eqnl2
+      with
+        No_match ->
+        List.fold_left2_set No_match (match_disjunctive_equations u alp metas) sigma
+           (Detyping.factorize_eqns eqnl1)
+           (List.map (fun (patl,rhs) -> ([patl],rhs)) eqnl2))
   | GLetTuple (nal1,(na1,to1),b1,c1), NLetTuple (nal2,(na2,to2),b2,c2)
       when Int.equal (List.length nal1) (List.length nal2) ->
       let sigma = match_opt (match_binders u alp metas na1 na2) sigma to1 to2 in
@@ -1081,11 +1186,8 @@ let rec match_ inner u alp metas sigma a1 a2 =
       let alp,sigma = Array.fold_right2 (fun id1 id2 alsig ->
 	match_names metas alsig (Name id1) (Name id2)) idl1 idl2 (alp,sigma) in
       Array.fold_left2 (match_in u alp metas) sigma bl1 bl2
-  | GCast(c1,CastConv t1), NCast (c2,CastConv t2)
-  | GCast(c1,CastVM t1), NCast (c2,CastVM t2) ->
-      match_in u alp metas (match_in u alp metas sigma c1 c2) t1 t2
-  | GCast(c1, CastCoerce), NCast(c2, CastCoerce) ->
-      match_in u alp metas sigma c1 c2
+  | GCast(t1, c1), NCast(t2, c2) ->
+    match_cast (match_in u alp metas) (match_in u alp metas sigma t1 t2) c1 c2
   | GSort (GType _), NSort (GType _) when not u -> sigma
   | GSort s1, NSort s2 when Miscops.glob_sort_eq s1 s2 -> sigma
   | GPatVar _, NHole _ -> (*Don't hide Metas, they bind in ltac*) raise No_match
@@ -1099,66 +1201,109 @@ let rec match_ inner u alp metas sigma a1 a2 =
      to print "{x:_ & P x}" knowing that notation "{x & P x}" is not defined. *)
   | _b1, NLambda (Name id as na,(NHole _ | NVar _ as t2),b2) when inner ->
       let avoid =
-        free_glob_vars a1 @ (* as in Namegen: *) glob_visible_short_qualid a1 in
+        Id.Set.union (free_glob_vars a1) (* as in Namegen: *) (glob_visible_short_qualid a1) in
       let id' = Namegen.next_ident_away id avoid in
-      let t1 = CAst.make @@ GHole(Evar_kinds.BinderType (Name id'),Misctypes.IntroAnonymous,None) in
+      let t1 = DAst.make @@ GHole(Evar_kinds.BinderType (Name id'),Misctypes.IntroAnonymous,None) in
       let sigma = match t2 with
       | NHole _ -> sigma
       | NVar id2 -> bind_term_env alp sigma id2 t1
       | _ -> assert false in
       let (alp,sigma) =
         if is_bindinglist_meta id metas then
-          bind_bindinglist_env alp sigma id [CAst.make @@ GLocalAssum (Name id',Explicit,t1)]
+          bind_bindinglist_env alp sigma id [DAst.make @@ GLocalAssum (Name id',Explicit,t1)]
         else
           match_names metas (alp,sigma) (Name id') na in
-      match_in u alp metas sigma (mkGApp a1 (CAst.make @@ GVar id')) b2
+      match_in u alp metas sigma (mkGApp a1 (DAst.make @@ GVar id')) b2
+
+  | GProj(p1, t1), NProj(p2, t2) when Projection.equal p1 p2 ->
+    match_in u alp metas sigma t1 t2
 
-  | (GRec _ | GEvar _), _
-  | _,_ -> raise No_match
+  | (GRef _ | GVar _ | GEvar _ | GPatVar _ | GApp _ | GLambda _ | GProd _
+     | GLetIn _ | GCases _ | GLetTuple _ | GIf _ | GRec _ | GSort _ | GHole _
+     | GCast _ | GProj _ ), _ -> raise No_match
 
 and match_in u = match_ true u
 
 and match_hd u = match_ false u
 
 and match_binders u alp metas na1 na2 sigma b1 b2 =
+  (* Match binders which cannot be substituted by a pattern *)
   let (alp,sigma) = match_names metas (alp,sigma) na1 na2 in
   match_in u alp metas sigma b1 b2
 
-and match_equations u alp metas sigma (_,(_,patl1,rhs1)) (patl2,rhs2) =
+and match_extended_binders ?loc isprod u alp metas na1 na2 bk t sigma b1 b2 =
+  (* Match binders which can be substituted by a pattern *)
+  let store, get = set_temporary_memory () in
+  match na1, DAst.get b1, na2 with
+  (* Matching individual binders as part of a recursive pattern *)
+  | Name p, GCases (LetPatternStyle,None,[(e,_)],(_::_ as eqns)), Name id
+       when is_gvar p e && is_bindinglist_meta id metas && List.length (store (Detyping.factorize_eqns eqns)) = 1 ->
+    (match get () with
+     | [(_,(ids,disj_of_patl,b1))] ->
+     let disjpat = List.map (function [pat] -> pat | _ -> assert false) disj_of_patl in
+     let disjpat = if occur_glob_constr p b1 then List.map (set_pat_alias p) disjpat else disjpat in
+     let alp,sigma = bind_bindinglist_env alp sigma id [DAst.make ?loc @@ GLocalPattern ((disjpat,ids),p,bk,t)] in
+     match_in u alp metas sigma b1 b2
+     | _ -> assert false)
+  | Name p, GCases (LetPatternStyle,None,[(e,_)],(_::_ as eqns)), Name id
+       when is_gvar p e && is_onlybinding_pattern_like_meta false id metas && List.length (store (Detyping.factorize_eqns eqns)) = 1 ->
+    (match get () with
+     | [(_,(ids,disj_of_patl,b1))] ->
+     let disjpat = List.map (function [pat] -> pat | _ -> assert false) disj_of_patl in
+     let disjpat = if occur_glob_constr p b1 then List.map (set_pat_alias p) disjpat else disjpat in
+     let alp,sigma = bind_binding_env alp sigma id disjpat in
+     match_in u alp metas sigma b1 b2
+     | _ -> assert false)
+  | _, _, Name id when is_bindinglist_meta id metas && (not isprod || na1 != Anonymous)->
+      let alp,sigma = bind_bindinglist_env alp sigma id [DAst.make ?loc @@ GLocalAssum (na1,bk,t)] in
+      match_in u alp metas sigma b1 b2
+  | _, _, _ ->
+     let (alp,sigma) = match_names metas (alp,sigma) na1 na2 in
+     match_in u alp metas sigma b1 b2
+
+and match_equations u alp metas sigma (_,(ids,patl1,rhs1)) (patl2,rhs2) rest1 rest2 =
   (* patl1 and patl2 have the same length because they respectively
      correspond to some tml1 and tml2 that have the same length *)
+  let allow_catchall = (rest2 = [] && ids = []) in
   let (alp,sigma) =
-    List.fold_left2 (match_cases_pattern_binders metas)
+    List.fold_left2 (match_cases_pattern_binders allow_catchall metas)
       (alp,sigma) patl1 patl2 in
   match_in u alp metas sigma rhs1 rhs2
 
-let term_of_binder bi = CAst.make @@ match bi with
-  | Name id -> GVar id
-  | Anonymous -> GHole (Evar_kinds.InternalHole,Misctypes.IntroAnonymous,None)
+and match_disjunctive_equations u alp metas sigma (_,(ids,disjpatl1,rhs1)) (disjpatl2,rhs2) _ _ =
+  (* patl1 and patl2 have the same length because they respectively
+     correspond to some tml1 and tml2 that have the same length *)
+  let (alp,sigma) =
+    List.fold_left2_set No_match
+      (fun alp_sigma patl1 patl2 _ _ ->
+        List.fold_left2 (match_cases_pattern_binders false metas) alp_sigma patl1 patl2)
+      (alp,sigma) disjpatl1 disjpatl2 in
+  match_in u alp metas sigma rhs1 rhs2
 
 let match_notation_constr u c (metas,pat) =
-  let terms,binders,termlists,binderlists =
+  let terms,termlists,binders,binderlists =
     match_ false u ([],[]) metas ([],[],[],[]) c pat in
-  (* Reorder canonically the substitution *)
-  let find_binder x =
-    try term_of_binder (Id.List.assoc x binders)
-    with Not_found ->
-      (* Happens for binders bound to Anonymous *)
-      (* Find a better way to propagate Anonymous... *)
-      CAst.make @@GVar x in
-  List.fold_right (fun (x,(scl,typ)) (terms',termlists',binders') ->
+  (* Turning substitution based on binding/constr distinction into a
+     substitution based on entry productions *)
+  List.fold_right (fun (x,(scl,typ)) (terms',termlists',binders',binderlists') ->
     match typ with
     | NtnTypeConstr ->
       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')
+       ((term, scl)::terms',termlists',binders',binderlists')
+    | NtnTypeBinder (NtnBinderParsedAsConstr _) ->
+       (match Id.List.assoc x binders with
+        | [pat] ->
+          let v = glob_constr_of_cases_pattern pat in
+          ((v,scl)::terms',termlists',binders',binderlists')
+        | _ -> raise No_match)
+    | NtnTypeBinder (NtnParsedAsIdent | NtnParsedAsPattern _) ->
+       (terms',termlists',(Id.List.assoc x binders,scl)::binders',binderlists')
     | NtnTypeConstrList ->
-       (terms',(Id.List.assoc x termlists,scl)::termlists',binders')
+       (terms',(Id.List.assoc x termlists,scl)::termlists',binders',binderlists')
     | NtnTypeBinderList ->
       let bl = try Id.List.assoc x binderlists with Not_found -> raise No_match in
-       (terms',termlists',(bl, scl)::binders'))
-    metas ([],[],[])
+       (terms',termlists',binders',(bl, scl)::binderlists'))
+    metas ([],[],[],[])
 
 (* Matching cases pattern *)
 
@@ -1170,7 +1315,7 @@ 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 match_cases_pattern_list match_fun metas sigma rest x y iter termin lassoc =
+let match_cases_pattern_list match_fun metas sigma rest x y iter termin revert =
   let rec aux sigma acc rest =
     try
       let metas = add_ldots_var (add_meta_term y metas) in
@@ -1181,12 +1326,11 @@ let match_cases_pattern_list match_fun metas sigma rest x y iter termin lassoc =
       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,(terms,termlists,binders,binderlists as sigma) = aux sigma [] rest in
+  (terms,(x,if revert then l else List.rev l)::termlists,binders,binderlists)
 
-let rec match_cases_pattern metas (terms,(),termlists,() as sigma) a1 a2 =
- let open CAst in
- match a1.v, a2 with
+let rec match_cases_pattern metas (terms,termlists,(),() as sigma) a1 a2 =
+ match DAst.get a1, a2 with
   | r1, NVar id2 when Id.List.mem_assoc id2 metas -> (bind_env_cases_pattern sigma id2 a1),(0,[])
   | PatVar Anonymous, NHole _ -> sigma,(0,[])
   | PatCstr ((ind,_ as r1),largs,_), NRef (ConstructRef r2) when eq_constructor r1 r2 ->
@@ -1201,10 +1345,10 @@ let rec match_cases_pattern metas (terms,(),termlists,() as sigma) a1 a2 =
 	raise No_match
       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,y,iter,termin,lassoc) ->
+        (List.fold_left2 (match_cases_pattern_no_more_args metas) sigma l1' l2),(le2,more_args)
+  | r1, NList (x,y,iter,termin,revert) ->
       (match_cases_pattern_list (match_cases_pattern_no_more_args)
-	metas (terms,(),termlists,()) a1 x y iter termin lassoc),(0,[])
+        metas (terms,termlists,(),()) a1 x y iter termin revert),(0,[])
   | _ -> raise No_match
 
 and match_cases_pattern_no_more_args metas sigma a1 a2 =
@@ -1231,15 +1375,15 @@ let reorder_canonically_substitution terms termlists metas =
   List.fold_right (fun (x,(scl,typ)) (terms',termlists') ->
     match typ with
       | NtnTypeConstr -> ((Id.List.assoc x terms, scl)::terms',termlists')
-      | NtnTypeOnlyBinder -> assert false
+      | NtnTypeBinder _ -> assert false
       | NtnTypeConstrList -> (terms',(Id.List.assoc x termlists,scl)::termlists')
       | NtnTypeBinderList -> assert false)
     metas ([],[])
 
 let match_notation_constr_cases_pattern c (metas,pat) =
-  let (terms,(),termlists,()),more_args = match_cases_pattern metas ([],(),[],()) c pat in
+  let (terms,termlists,(),()),more_args = match_cases_pattern metas ([],[],(),()) c pat in
   reorder_canonically_substitution terms termlists metas, more_args
 
 let match_notation_constr_ind_pattern ind args (metas,pat) =
-  let (terms,(),termlists,()),more_args = match_ind_pattern metas ([],(),[],()) ind args pat in
+  let (terms,termlists,(),()),more_args = match_ind_pattern metas ([],[],(),()) ind args pat in
   reorder_canonically_substitution terms termlists metas, more_args
diff --git a/interp/notation_ops.mli b/interp/notation_ops.mli
index 3154fd7ad..746f52e48 100644
--- a/interp/notation_ops.mli
+++ b/interp/notation_ops.mli
@@ -29,12 +29,15 @@ val ldots_var : Id.t
     bound by the notation; also interpret recursive patterns           *)
 
 val notation_constr_of_glob_constr : notation_interp_env ->
-  glob_constr -> notation_constr * reversibility_flag
+  glob_constr -> notation_constr * reversibility_status
 
 (** Re-interpret a notation as a [glob_constr], taking care of binders *)
 
+val apply_cases_pattern : ?loc:Loc.t ->
+  (Id.t list * cases_pattern_disjunction) * Id.t -> glob_constr -> glob_constr
+
 val glob_constr_of_notation_constr_with_binders : ?loc:Loc.t ->
-  ('a -> Name.t -> 'a * Name.t) ->
+  ('a -> Name.t -> 'a * ((Id.t list * cases_pattern_disjunction) * Id.t) option * Name.t) ->
   ('a -> notation_constr -> glob_constr) ->
   'a -> notation_constr -> glob_constr
 
@@ -47,19 +50,20 @@ val glob_constr_of_notation_constr : ?loc:Loc.t -> notation_constr -> glob_const
 
 exception No_match
 
-val match_notation_constr : bool -> glob_constr -> interpretation ->
-      (glob_constr * subscopes) list * (glob_constr list * subscopes) list *
-      (extended_glob_local_binder list * subscopes) list
+val match_notation_constr : bool -> 'a glob_constr_g -> interpretation ->
+      ('a glob_constr_g * subscopes) list * ('a glob_constr_g list * subscopes) list *
+      ('a cases_pattern_disjunction_g * subscopes) list *
+      ('a extended_glob_local_binder_g list * subscopes) list
 
 val match_notation_constr_cases_pattern :
-  cases_pattern -> interpretation ->
-  ((cases_pattern * subscopes) list * (cases_pattern list * subscopes) list) *
-    (int * cases_pattern list)
+  'a cases_pattern_g -> interpretation ->
+  (('a cases_pattern_g * subscopes) list * ('a cases_pattern_g list * subscopes) list) *
+    (int * 'a cases_pattern_g list)
 
 val match_notation_constr_ind_pattern :
-  inductive -> cases_pattern  list -> interpretation ->
-  ((cases_pattern * subscopes) list * (cases_pattern list * subscopes) list) *
-    (int * cases_pattern list)
+  inductive -> 'a cases_pattern_g list -> interpretation ->
+  (('a cases_pattern_g * subscopes) list * ('a cases_pattern_g list * subscopes) list) *
+    (int * 'a cases_pattern_g list)
 
 (** {5 Matching a notation pattern against a [glob_constr]} *)
 
diff --git a/interp/ppextend.ml b/interp/ppextend.ml
index 3ebc9b71d..606196fcd 100644
--- a/interp/ppextend.ml
+++ b/interp/ppextend.ml
@@ -33,8 +33,9 @@ let ppcmd_of_cut = function
 
 type unparsing =
   | UnpMetaVar of int * parenRelation
+  | UnpBinderMetaVar of int * parenRelation
   | UnpListMetaVar of int * parenRelation * unparsing list
   | UnpBinderListMetaVar of int * bool * unparsing list
   | UnpTerminal of string
-  | UnpBox of ppbox * unparsing list
+  | UnpBox of ppbox * unparsing Loc.located list
   | UnpCut of ppcut
diff --git a/interp/ppextend.mli b/interp/ppextend.mli
index 6ff5a4272..77823e32a 100644
--- a/interp/ppextend.mli
+++ b/interp/ppextend.mli
@@ -26,8 +26,9 @@ val ppcmd_of_cut : ppcut -> Pp.t
 
 type unparsing =
   | UnpMetaVar of int * parenRelation
+  | UnpBinderMetaVar of int * parenRelation
   | UnpListMetaVar of int * parenRelation * unparsing list
   | UnpBinderListMetaVar of int * bool * unparsing list
   | UnpTerminal of string
-  | UnpBox of ppbox * unparsing list
+  | UnpBox of ppbox * unparsing Loc.located list
   | UnpCut of ppcut
diff --git a/interp/reserve.ml b/interp/reserve.ml
index b05f05283..3e1a7dd9b 100644
--- a/interp/reserve.ml
+++ b/interp/reserve.ml
@@ -71,7 +71,7 @@ let reserve_revtable = Summary.ref KeyMap.empty ~name:"reserved-type-rev"
 let notation_constr_key = function (* Rem: NApp(NRef ref,[]) stands for @ref *)
   | NApp (NRef ref,args) -> RefKey(canonical_gr ref), Some (List.length args)
   | NList (_,_,NApp (NRef ref,args),_,_)
-  | NBinderList (_,_,NApp (NRef ref,args),_) -> RefKey (canonical_gr ref), Some (List.length args)
+  | NBinderList (_,_,NApp (NRef ref,args),_,_) -> RefKey (canonical_gr ref), Some (List.length args)
   | NRef ref -> RefKey(canonical_gr ref), None
   | _ -> Oth, None
 
@@ -84,15 +84,15 @@ let in_reserved : Id.t * notation_constr -> obj =
   declare_object {(default_object "RESERVED-TYPE") with
     cache_function = cache_reserved_type }
 
-let declare_reserved_type_binding (loc,id) t =
+let declare_reserved_type_binding {CAst.loc;v=id} t =
   if not (Id.equal id (root_of_id id)) then
     user_err ?loc ~hdr:"declare_reserved_type"
-      ((pr_id id ++ str
+      ((Id.print 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 ~hdr:"declare_reserved_type"
-    ((pr_id id++str" is already bound to a type"))
+    ((Id.print id++str" is already bound to a type"))
   with Not_found -> () end;
   add_anonymous_leaf (in_reserved (id,t))
 
@@ -102,7 +102,7 @@ let declare_reserved_type idl t =
 let find_reserved_type id = Id.Map.find (root_of_id id) !reserve_table
 
 let constr_key c =
-  try RefKey (canonical_gr (global_of_constr (fst (Term.decompose_app c))))
+  try RefKey (canonical_gr (global_of_constr (fst (Constr.decompose_app c))))
   with Not_found -> Oth
 
 let revert_reserved_type t =
@@ -110,7 +110,7 @@ let revert_reserved_type t =
     let t = EConstr.Unsafe.to_constr t in
     let reserved = KeyMap.find (constr_key t) !reserve_revtable in
     let t = EConstr.of_constr t in
-    let t = Detyping.detype false [] (Global.env()) Evd.empty t in
+    let t = Detyping.detype Detyping.Now false Id.Set.empty (Global.env()) Evd.empty t in
     (* pedrot: if [Notation_ops.match_notation_constr] may raise [Failure _]
         then I've introduced a bug... *)
     let filter _ pat =
diff --git a/interp/reserve.mli b/interp/reserve.mli
index 4fcef23c5..5899cd628 100644
--- a/interp/reserve.mli
+++ b/interp/reserve.mli
@@ -6,9 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Loc
 open Names
 open Notation_term
 
-val declare_reserved_type : Id.t located list -> notation_constr -> unit
+val declare_reserved_type : Misctypes.lident list -> notation_constr -> unit
 val find_reserved_type : Id.t -> notation_constr
diff --git a/interp/stdarg.ml b/interp/stdarg.ml
index 274ea6213..65c55a584 100644
--- a/interp/stdarg.ml
+++ b/interp/stdarg.ml
@@ -28,7 +28,7 @@ let wit_string : string uniform_genarg_type =
   make0 "string"
 
 let wit_pre_ident : string uniform_genarg_type =
-  make0 ~dyn:(val_tag (topwit wit_string)) "preident"
+  make0 "preident"
 
 let loc_of_or_by_notation f = function
   | AN c -> f c
@@ -50,6 +50,8 @@ let wit_ref = make0 "ref"
 
 let wit_quant_hyp = make0 "quant_hyp"
 
+let wit_sort_family = make0 "sort_family"
+
 let wit_constr =
   make0 "constr"
 
diff --git a/interp/stdarg.mli b/interp/stdarg.mli
index 1d4a29b9c..ea1c63b89 100644
--- a/interp/stdarg.mli
+++ b/interp/stdarg.mli
@@ -41,15 +41,17 @@ val wit_intro_pattern : (constr_expr intro_pattern_expr located, glob_constr_and
 
 val wit_ident : Id.t uniform_genarg_type
 
-val wit_var : (Id.t located, Id.t located, Id.t) genarg_type
+val wit_var : (lident, lident, 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_sort_family : (Sorts.family, unit, unit) 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_uconstr : (constr_expr , glob_constr_and_expr, Ltac_pretype.closed_glob_constr) genarg_type
 
 val wit_open_constr :
   (constr_expr, glob_constr_and_expr, constr) genarg_type
@@ -74,7 +76,7 @@ val wit_red_expr :
   (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
+val wit_clause_dft_concl :  (lident Locus.clause_expr, lident Locus.clause_expr, Names.Id.t Locus.clause_expr) genarg_type
 
 (** Aliases for compatibility *)
 
@@ -82,7 +84,7 @@ 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_clause :  (lident Locus.clause_expr, lident 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 :
diff --git a/interp/syntax_def.ml b/interp/syntax_def.ml
index 84c6f4ef3..98e507309 100644
--- a/interp/syntax_def.ml
+++ b/interp/syntax_def.ml
@@ -6,16 +6,15 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open CErrors
 open Util
 open Pp
+open CErrors
 open Names
 open Libnames
-open Notation_term
 open Libobject
 open Lib
-open Nameops
 open Nametab
+open Notation_term
 
 (* Syntactic definitions. *)
 
@@ -31,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
     user_err ~hdr:"cache_syntax_constant"
-      (pr_id (basename sp) ++ str " already exists");
+      (Id.print (basename sp) ++ str " already exists");
   add_syntax_constant kn pat onlyparse;
   Nametab.push_syndef (Nametab.Until i) sp kn
 
diff --git a/interp/syntax_def.mli b/interp/syntax_def.mli
index 36a3986b5..4d2cb5b74 100644
--- a/interp/syntax_def.mli
+++ b/interp/syntax_def.mli
@@ -16,4 +16,4 @@ type syndef_interpretation = (Id.t * subscopes) list * notation_constr
 val declare_syntactic_definition : bool -> Id.t ->
   Flags.compat_version option -> syndef_interpretation -> unit
 
-val search_syntactic_definition : kernel_name -> syndef_interpretation
+val search_syntactic_definition : KerName.t -> syndef_interpretation
diff --git a/intf/tactypes.ml b/interp/tactypes.ml
index 2c42e1311..2c42e1311 100644
--- a/intf/tactypes.ml
+++ b/interp/tactypes.ml
diff --git a/interp/topconstr.ml b/interp/topconstr.ml
index 7a3c83ff9..ecfb766ff 100644
--- a/interp/topconstr.ml
+++ b/interp/topconstr.ml
@@ -6,294 +6,16 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i*)
-open Pp
-open CErrors
-open Util
-open Names
-open Nameops
-open Libnames
-open Misctypes
-open Constrexpr
 open Constrexpr_ops
-(*i*)
 
-
-let asymmetric_patterns = ref (false)
-let _ = Goptions.declare_bool_option {
-  Goptions.optdepr = false;
-  Goptions.optname = "no parameters in constructors";
-  Goptions.optkey = ["Asymmetric";"Patterns"];
-  Goptions.optread = (fun () -> !asymmetric_patterns);
-  Goptions.optwrite = (fun a -> asymmetric_patterns:=a);
-}
-
-(**********************************************************************)
-(* Miscellaneous *)
-
-let error_invalid_pattern_notation ?loc () =
-  user_err ?loc  (str "Invalid notation for pattern.")
-
-(* Legacy functions *)
-let down_located f (_l, x) = f x
-let located_fold_left f x (_l, y) = f x y
-
-(**********************************************************************)
-(* Functions on constr_expr *)
-
-let is_constructor id =
-  try Globnames.isConstructRef
-        (Smartlocate.global_of_extended_global
-           (Nametab.locate_extended (qualid_of_ident id)))
-  with Not_found -> false
-
-let rec cases_pattern_fold_names f a pt = match CAst.(pt.v) with
-  | CPatRecord l ->
-      List.fold_left (fun acc (r, cp) -> cases_pattern_fold_names f acc cp) a l
-  | CPatAlias (pat,id) -> f id a
-  | CPatOr (patl) ->
-      List.fold_left (cases_pattern_fold_names f) a patl
-  | CPatCstr (_,patl1,patl2) ->
-    List.fold_left (cases_pattern_fold_names f)
-      (Option.fold_left (List.fold_left (cases_pattern_fold_names f)) a patl1) patl2
-  | CPatNotation (_,(patl,patll),patl') ->
-      List.fold_left (cases_pattern_fold_names f)
-	(List.fold_left (cases_pattern_fold_names f) a (patl@List.flatten patll)) patl'
-  | CPatDelimiters (_,pat) -> cases_pattern_fold_names f a pat
-  | CPatAtom (Some (Ident (_,id))) when not (is_constructor id) -> f id a
-  | CPatPrim _ | CPatAtom _ -> a
-  | CPatCast ({CAst.loc},_) ->
-     CErrors.user_err ?loc ~hdr:"cases_pattern_fold_names"
-                      (Pp.strbrk "Casts are not supported here.")
-
-let ids_of_pattern =
-  cases_pattern_fold_names Id.Set.add Id.Set.empty
-
-let ids_of_pattern_list =
-  List.fold_left
-    (located_fold_left
-      (List.fold_left (cases_pattern_fold_names Id.Set.add)))
-    Id.Set.empty
-
-let ids_of_cases_indtype p =
-  cases_pattern_fold_names Id.Set.add Id.Set.empty p
-
-let ids_of_cases_tomatch tms =
-  List.fold_right
-    (fun (_, ona, indnal) l ->
-      Option.fold_right (fun t ids -> cases_pattern_fold_names Id.Set.add ids t)
-      indnal
-        (Option.fold_right (down_located (Name.fold_right Id.Set.add)) ona l))
-    tms Id.Set.empty
-
-let rec fold_constr_expr_binders g f n acc b = function
-  | (nal,bk,t)::l ->
-      let nal = snd (List.split nal) in
-      let n' = List.fold_right (Name.fold_right g) nal n in
-      f n (fold_constr_expr_binders g f n' acc b l) t
-  | [] ->
-      f n acc b
-
-let rec fold_local_binders g f n acc b = function
-  | CLocalAssum (nal,bk,t)::l ->
-      let nal = snd (List.split nal) in
-      let n' = List.fold_right (Name.fold_right g) nal n in
-      f n (fold_local_binders g f n' acc b l) t
-  | CLocalDef ((_,na),c,t)::l ->
-      Option.fold_left (f n) (f n (fold_local_binders g f (Name.fold_right g na n) acc b l) c) t
-  | CLocalPattern (_,(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
-
-let fold_constr_expr_with_binders g f n acc = CAst.with_val (function
-  | CAppExpl ((_,_,_),l) -> List.fold_left (f n) acc l
-  | CApp ((_,t),l) -> List.fold_left (f n) (f n acc t) (List.map fst l)
-  | CProdN (l,b) | CLambdaN (l,b) -> fold_constr_expr_binders g f n acc b l
-  | CLetIn (na,a,t,b) ->
-     f (Name.fold_right g (snd na) n) (Option.fold_left (f n) (f n acc a) t) b
-  | CCast (a,(CastConv b|CastVM b|CastNative b)) -> f n (f n acc a) b
-  | CCast (a,CastCoerce) -> f n acc a
-  | CNotation (_,(l,ll,bll)) ->
-      (* The following is an approximation: we don't know exactly if
-         an ident is binding nor to which subterms bindings apply *)
-      let acc = List.fold_left (f n) acc (l@List.flatten ll) in
-      List.fold_left (fun acc bl -> fold_local_binders g f n acc (CAst.make @@ CHole (None,IntroAnonymous,None)) bl) acc bll
-  | CGeneralization (_,_,c) -> f n acc c
-  | CDelimiters (_,a) -> f n acc a
-  | CHole _ | CEvar _ | CPatVar _ | CSort _ | CPrim _ | CRef _ ->
-      acc
-  | CRecord l -> List.fold_left (fun acc (id, c) -> f n acc c) acc l
-  | CCases (sty,rtnpo,al,bl) ->
-      let ids = ids_of_cases_tomatch al in
-      let acc = Option.fold_left (f (Id.Set.fold g ids n)) acc rtnpo in
-      let acc = List.fold_left (f n) acc (List.map (fun (fst,_,_) -> fst) al) in
-      List.fold_right (fun (loc,(patl,rhs)) acc ->
-	let ids = ids_of_pattern_list patl in
-	f (Id.Set.fold g ids n) acc rhs) bl acc
-  | CLetTuple (nal,(ona,po),b,c) ->
-      let n' = List.fold_right (down_located (Name.fold_right g)) nal n in
-      f (Option.fold_right (down_located (Name.fold_right g)) ona n') (f n acc b) c
-  | CIf (c,(ona,po),b1,b2) ->
-      let acc = f n (f n (f n acc b1) b2) c in
-      Option.fold_left
-	(f (Option.fold_right (down_located (Name.fold_right g)) ona n)) acc po
-  | CFix (_,l) ->
-      let n' = List.fold_right (fun ((_,id),_,_,_,_) -> g id) l n in
-      List.fold_right (fun (_,(_,o),lb,t,c) acc ->
-	fold_local_binders g f n'
-	  (fold_local_binders g f n acc t lb) c lb) l acc
-  | CCoFix (_,_) ->
-      Feedback.msg_warning (strbrk "Capture check in multiple binders not done"); acc
-  )
-
-let free_vars_of_constr_expr c =
-  let rec aux bdvars l = function
-  | { CAst.v = CRef (Ident (_,id),_) } -> if Id.List.mem id bdvars then l else Id.Set.add id l
-  | c -> fold_constr_expr_with_binders (fun a l -> a::l) aux bdvars l c
-  in aux [] Id.Set.empty c
-
-let occur_var_constr_expr id c = Id.Set.mem id (free_vars_of_constr_expr c)
-
-(* Interpret the index of a recursion order annotation *)
-
-let split_at_annot bl na =
-  let names = List.map snd (names_of_local_assums bl) in
-  match na with
-  | None ->
-      begin match names with
-      | [] -> user_err (Pp.str "A fixpoint needs at least one parameter.")
-      | _ -> ([], bl)
-      end
-  | Some (loc, id) ->
-      let rec aux acc = function
-	| CLocalAssum (bls, k, t) as x :: rest ->
-            let test (_, na) = match na with
-            | Name id' -> Id.equal id id'
-            | Anonymous -> false
-            in
-	    let l, r = List.split_when test bls in
-            begin match r with
-            | [] -> aux (x :: acc) rest
-            | _ ->
-              let ans = match l with
-              | [] -> acc
-              | _ -> CLocalAssum (l, k, t) :: acc
-              in
-              (List.rev ans, CLocalAssum (r, k, t) :: rest)
-            end
-	| CLocalDef ((_,na),_,_) as x :: rest ->
-           if Name.equal (Name id) na then
-             user_err ?loc
-               (Nameops.pr_id id ++ str" must be a proper parameter and not a local definition.")
-           else
-             aux (x :: acc) rest
-        | CLocalPattern (_,_) :: rest ->
-            Loc.raise ?loc (Stream.Error "pattern with quote not allowed after fix")
-	| [] ->
-            user_err ?loc 
-			 (str "No parameter named " ++ Nameops.pr_id id ++ str".")
-      in aux [] bl
-
-(* Used in correctness and interface *)
-
-let map_binder g e nal = List.fold_right (down_located (Name.fold_right g)) nal e
-
-let map_binders f g e bl =
-  (* TODO: avoid variable capture in [t] by some [na] in [List.tl nal] *)
-  let h (e,bl) (nal,bk,t) = (map_binder g e nal,(nal,bk,f e t)::bl) in
-  let (e,rbl) = List.fold_left h (e,[]) bl in
-  (e, List.rev rbl)
-
-let map_local_binders f g e bl =
-  (* TODO: avoid variable capture in [t] by some [na] in [List.tl nal] *)
-  let h (e,bl) = function
-      CLocalAssum(nal,k,ty) ->
-        (map_binder g e nal, CLocalAssum(nal,k,f e ty)::bl)
-    | CLocalDef((loc,na),c,ty) ->
-        (Name.fold_right g na e, CLocalDef((loc,na),f e c,Option.map (f e) ty)::bl)
-    | CLocalPattern (loc,(pat,t)) ->
-        let ids = ids_of_pattern pat in
-        (Id.Set.fold g ids e, CLocalPattern (loc,(pat,Option.map (f e) t))::bl) in
-  let (e,rbl) = List.fold_left h (e,[]) bl in
-  (e, List.rev rbl)
-
-let map_constr_expr_with_binders g f e = CAst.map (function
-  | CAppExpl (r,l) -> CAppExpl (r,List.map (f e) l)
-  | CApp ((p,a),l) ->
-      CApp ((p,f e a),List.map (fun (a,i) -> (f e a,i)) l)
-  | CProdN (bl,b) ->
-      let (e,bl) = map_binders f g e bl in CProdN (bl,f e b)
-  | CLambdaN (bl,b) ->
-      let (e,bl) = map_binders f g e bl in CLambdaN (bl,f e b)
-  | CLetIn (na,a,t,b) ->
-      CLetIn (na,f e a,Option.map (f e) t,f (Name.fold_right g (snd na) e) b)
-  | CCast (a,c) -> CCast (f e a, Miscops.map_cast_type (f e) c)
-  | CNotation (n,(l,ll,bll)) ->
-      (* This is an approximation because we don't know what binds what *)
-      CNotation (n,(List.map (f e) l,List.map (List.map (f e)) ll,
-                     List.map (fun bl -> snd (map_local_binders f g e bl)) bll))
-  | CGeneralization (b,a,c) -> CGeneralization (b,a,f e c)
-  | CDelimiters (s,a) -> CDelimiters (s,f e a)
-  | CHole _ | CEvar _ | CPatVar _ | CSort _
-  | CPrim _ | CRef _ as x -> x
-  | CRecord l -> CRecord (List.map (fun (id, c) -> (id, f e c)) l)
-  | CCases (sty,rtnpo,a,bl) ->
-      let bl = List.map (fun (loc,(patl,rhs)) ->
-        let ids = ids_of_pattern_list patl in
-        (loc,(patl,f (Id.Set.fold g ids e) rhs))) bl in
-      let ids = ids_of_cases_tomatch a in
-      let po = Option.map (f (Id.Set.fold g ids e)) rtnpo in
-      CCases (sty, po, List.map (fun (tm,x,y) -> f e tm,x,y) a,bl)
-  | CLetTuple (nal,(ona,po),b,c) ->
-      let e' = List.fold_right (down_located (Name.fold_right g)) nal e in
-      let e'' = Option.fold_right (down_located (Name.fold_right g)) ona e in
-      CLetTuple (nal,(ona,Option.map (f e'') po),f e b,f e' c)
-  | CIf (c,(ona,po),b1,b2) ->
-      let e' = Option.fold_right (down_located (Name.fold_right g)) ona e in
-      CIf (f e c,(ona,Option.map (f e') po),f e b1,f e b2)
-  | CFix (id,dl) ->
-      CFix (id,List.map (fun (id,n,bl,t,d) ->
-        let (e',bl') = map_local_binders f g e bl in
-        let t' = f e' t in
-        (* Note: fix names should be inserted before the arguments... *)
-        let e'' = List.fold_left (fun e ((_,id),_,_,_,_) -> g id e) e' dl in
-        let d' = f e'' d in
-        (id,n,bl',t',d')) dl)
-  | CCoFix (id,dl) ->
-      CCoFix (id,List.map (fun (id,bl,t,d) ->
-        let (e',bl') = map_local_binders f g e bl in
-        let t' = f e' t in
-        let e'' = List.fold_left (fun e ((_,id),_,_,_) -> g id e) e' dl in
-        let d' = f e'' d in
-        (id,bl',t',d')) dl)
-  )
-
-(* Used in constrintern *)
-let rec replace_vars_constr_expr l = function
-  | { CAst.loc; v = CRef (Ident (loc_id,id),us) } as x ->
-      (try CAst.make ?loc @@ CRef (Ident (loc_id,Id.Map.find id l),us) with Not_found -> x)
-  | c -> map_constr_expr_with_binders Id.Map.remove
-           replace_vars_constr_expr l c
-
-(* Returns the ranges of locs of the notation that are not occupied by args  *)
-(* and which are then occupied by proper symbols of the notation (or spaces) *)
-
-let locs_of_notation ?loc locs ntn =
-  let unloc loc = Option.cata Loc.unloc (0,0) loc in
-  let (bl, el) = unloc loc        in
-  let locs =  List.map unloc locs in
-  let rec aux pos = function
-    | [] -> if Int.equal pos el then [] else [(pos,el)]
-    | (ba,ea)::l -> if Int.equal pos ba then aux ea l else (pos,ba)::aux ea l
-  in aux bl (List.sort (fun l1 l2 -> fst l1 - fst l2) locs)
-
-let ntn_loc ?loc (args,argslist,binderslist) =
-  locs_of_notation ?loc
-    (List.map constr_loc (args@List.flatten argslist)@
-     List.map local_binders_loc binderslist)
-
-let patntn_loc ?loc (args,argslist) =
-  locs_of_notation ?loc
-    (List.map cases_pattern_expr_loc (args@List.flatten argslist))
+let asymmetric_patterns = asymmetric_patterns
+let error_invalid_pattern_notation = error_invalid_pattern_notation
+let split_at_annot = split_at_annot
+let ntn_loc = ntn_loc
+let patntn_loc = patntn_loc
+let map_constr_expr_with_binders = map_constr_expr_with_binders
+let fold_constr_expr_with_binders = fold_constr_expr_with_binders
+let ids_of_cases_indtype = ids_of_cases_indtype
+let occur_var_constr_expr = occur_var_constr_expr
+let free_vars_of_constr_expr = free_vars_of_constr_expr
+let replace_vars_constr_expr = replace_vars_constr_expr
diff --git a/interp/topconstr.mli b/interp/topconstr.mli
index 922f87955..66d87707c 100644
--- a/interp/topconstr.mli
+++ b/interp/topconstr.mli
@@ -6,44 +6,46 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Loc
 open Names
 open Constrexpr
 
-(** Topconstr *)
-
+(** Topconstr: This whole module is deprecated in favor of Constrexpr_ops  *)
 val asymmetric_patterns : bool ref
+[@@ocaml.deprecated "use Constrexpr_ops.asymmetric_patterns"]
 
 (** Utilities on constr_expr *)
+val split_at_annot : local_binder_expr list -> Misctypes.lident option -> local_binder_expr list * local_binder_expr list
+[@@ocaml.deprecated "use Constrexpr_ops.split_at_annot"]
+
+val ntn_loc : ?loc:Loc.t -> constr_notation_substitution -> string -> (int * int) list
+[@@ocaml.deprecated "use Constrexpr_ops.ntn_loc"]
+val patntn_loc : ?loc:Loc.t -> cases_pattern_notation_substitution -> string -> (int * int) list
+[@@ocaml.deprecated "use Constrexpr_ops.patntn_loc"]
 
-val replace_vars_constr_expr :
-  Id.t Id.Map.t -> constr_expr -> constr_expr
+(** For cases pattern parsing errors *)
+val error_invalid_pattern_notation : ?loc:Loc.t -> unit -> 'a
+[@@ocaml.deprecated "use Constrexpr_ops.error_invalid_pattern_notation"]
+
+(*************************************************************************)
+val replace_vars_constr_expr : Id.t Id.Map.t -> constr_expr -> constr_expr
+[@@ocaml.deprecated "use Constrexpr_ops.free_vars_of_constr_expr"]
 
 val free_vars_of_constr_expr : constr_expr -> Id.Set.t
+[@@ocaml.deprecated "use Constrexpr_ops.free_vars_of_constr_expr"]
+
 val occur_var_constr_expr : Id.t -> constr_expr -> bool
+[@@ocaml.deprecated "use Constrexpr_ops.occur_var_constr_expr"]
 
 (** Specific function for interning "in indtype" syntax of "match" *)
 val ids_of_cases_indtype : cases_pattern_expr -> Id.Set.t
-
-val split_at_annot : local_binder_expr list -> Id.t located option -> local_binder_expr list * local_binder_expr list
+[@@ocaml.deprecated "use Constrexpr_ops.ids_of_cases_indtype"]
 
 (** Used in typeclasses *)
-
 val fold_constr_expr_with_binders : (Id.t -> 'a -> 'a) ->
    ('a -> 'b -> constr_expr -> 'b) -> 'a -> 'b -> constr_expr -> 'b
-
-(** Used in correctness and interface; absence of var capture not guaranteed 
-   in pattern-matching clauses and in binders of the form [x,y:T(x)] *)
+[@@ocaml.deprecated "use Constrexpr_ops.fold_constr_expr_with_binders"]
 
 val map_constr_expr_with_binders :
   (Id.t -> 'a -> 'a) -> ('a -> constr_expr -> constr_expr) ->
       'a -> constr_expr -> constr_expr
-
-val ntn_loc :
-  ?loc:Loc.t -> constr_notation_substitution -> string -> (int * int) list
-val patntn_loc :
-  ?loc:Loc.t -> cases_pattern_notation_substitution -> string -> (int * int) list
-
-(** For cases pattern parsing errors *)
-
-val error_invalid_pattern_notation : ?loc:Loc.t -> unit -> 'a
+[@@ocaml.deprecated "use Constrexpr_ops.map_constr_expr_with_binders"]
diff --git a/intf/constrexpr.ml b/intf/constrexpr.ml
index 413cd9704..5b51953bb 100644
--- a/intf/constrexpr.ml
+++ b/intf/constrexpr.ml
@@ -46,7 +46,7 @@ type prim_token =
 type instance_expr = Misctypes.glob_level list
 
 type cases_pattern_expr_r =
-  | CPatAlias of cases_pattern_expr * Id.t
+  | CPatAlias of cases_pattern_expr * lname
   | CPatCstr  of reference
     * cases_pattern_expr list option * cases_pattern_expr list
   (** [CPatCstr (_, c, Some l1, l2)] represents (@c l1) l2 *)
@@ -68,25 +68,25 @@ and cases_pattern_notation_substitution =
 
 and constr_expr_r =
   | CRef     of reference * instance_expr option
-  | CFix     of Id.t Loc.located * fix_expr list
-  | CCoFix   of Id.t Loc.located * cofix_expr list
-  | CProdN   of binder_expr list * constr_expr
-  | CLambdaN of binder_expr list * constr_expr
-  | CLetIn   of Name.t Loc.located * constr_expr * constr_expr option * constr_expr
+  | CFix     of lident * fix_expr list
+  | CCoFix   of lident * cofix_expr list
+  | CProdN   of local_binder_expr list * constr_expr
+  | CLambdaN of local_binder_expr list * constr_expr
+  | CLetIn   of lname * constr_expr * constr_expr option * constr_expr
   | CAppExpl of (proj_flag * reference * instance_expr option) * constr_expr list
   | CApp     of (proj_flag * constr_expr) *
-                (constr_expr * explicitation Loc.located option) list
+                (constr_expr * explicitation CAst.t option) list
   | CRecord  of (reference * constr_expr) list
 
   (* representation of the "let" and "match" constructs *)
-  | CCases of case_style          (* determines whether this value represents "let" or "match" construct *)
+  | CCases of Constr.case_style   (* determines whether this value represents "let" or "match" construct *)
             * constr_expr option  (* return-clause *)
             * case_expr list
             * branch_expr list    (* branches *)
 
-  | CLetTuple of Name.t Loc.located list * (Name.t Loc.located option * constr_expr option) *
+  | CLetTuple of lname list * (lname option * constr_expr option) *
                  constr_expr * constr_expr
-  | CIf of constr_expr * (Name.t Loc.located option * constr_expr option)
+  | CIf of constr_expr * (lname option * constr_expr option)
          * constr_expr * constr_expr
   | CHole   of Evar_kinds.t option * intro_pattern_naming_expr * Genarg.raw_generic_argument option
   | CPatVar of patvar
@@ -97,24 +97,22 @@ and constr_expr_r =
   | CGeneralization of binding_kind * abstraction_kind option * constr_expr
   | CPrim of prim_token
   | CDelimiters of string * constr_expr
+  | CProj of reference * constr_expr
 and constr_expr = constr_expr_r CAst.t
 
 and case_expr = constr_expr                 (* expression that is being matched *)
-	      * Name.t Loc.located option   (* as-clause *)
+              * lname option                (* as-clause *)
 	      * cases_pattern_expr option   (* in-clause *)
 
 and branch_expr =
-  (cases_pattern_expr list Loc.located list * constr_expr) Loc.located
-
-and binder_expr =
-  Name.t Loc.located list * binder_kind * constr_expr
+  (cases_pattern_expr list list * constr_expr) CAst.t
 
 and fix_expr =
-    Id.t Loc.located * (Id.t Loc.located option * recursion_order_expr) *
+    lident * (lident option * recursion_order_expr) *
       local_binder_expr list * constr_expr * constr_expr
 
 and cofix_expr =
-    Id.t Loc.located * local_binder_expr list * constr_expr * constr_expr
+    lident * local_binder_expr list * constr_expr * constr_expr
 
 and recursion_order_expr =
   | CStructRec
@@ -123,18 +121,15 @@ and recursion_order_expr =
 
 (** Anonymous defs allowed ?? *)
 and local_binder_expr =
-  | CLocalAssum   of Name.t Loc.located list * binder_kind * constr_expr
-  | CLocalDef     of Name.t Loc.located * constr_expr * constr_expr option
-  | CLocalPattern of (cases_pattern_expr * constr_expr option) Loc.located
+  | CLocalAssum   of lname list * binder_kind * constr_expr
+  | CLocalDef     of lname * constr_expr * constr_expr option
+  | CLocalPattern of (cases_pattern_expr * constr_expr option) CAst.t
 
 and constr_notation_substitution =
     constr_expr list *      (** for constr subterms *)
     constr_expr list list * (** for recursive notations *)
-    local_binder_expr list list (** for binders subexpressions *)
-
-type typeclass_constraint = (Name.t Loc.located * Id.t Loc.located list option) * binding_kind * constr_expr
-
-and typeclass_context = typeclass_constraint list
+    cases_pattern_expr list *   (** for binders *)
+    local_binder_expr list list (** for binder lists (recursive notations) *)
 
 type constr_pattern_expr = constr_expr
 
diff --git a/intf/decl_kinds.ml b/intf/decl_kinds.ml
index a97758833..b9a3f0c21 100644
--- a/intf/decl_kinds.ml
+++ b/intf/decl_kinds.ml
@@ -8,6 +8,8 @@
 
 (** Informal mathematical status of declarations *)
 
+type discharge = DoDischarge | NoDischarge
+
 type locality = Discharge | Local | Global
 
 type binding_kind = Explicit | Implicit
@@ -40,6 +42,7 @@ type definition_object_kind =
   | IdentityCoercion
   | Instance
   | Method
+  | Let
 
 type assumption_object_kind = Definitional | Logical | Conjectural
 
@@ -72,7 +75,11 @@ type logical_kind =
 
 (** Recursive power of type declarations *)
 
-type recursivity_kind =
+type recursivity_kind = Declarations.recursivity_kind =
   | Finite (** = inductive *)
+      [@ocaml.deprecated "Please use [Declarations.Finite"]
   | CoFinite (** = coinductive *)
+      [@ocaml.deprecated "Please use [Declarations.CoFinite"]
   | BiFinite (** = non-recursive, like in "Record" definitions *)
+      [@ocaml.deprecated "Please use [Declarations.BiFinite"]
+[@@ocaml.deprecated "Please use [Declarations.recursivity_kind"]
diff --git a/intf/evar_kinds.ml b/intf/evar_kinds.ml
index 36c421c6c..428d6b678 100644
--- a/intf/evar_kinds.ml
+++ b/intf/evar_kinds.ml
@@ -32,4 +32,4 @@ type t =
   | ImpossibleCase
   | MatchingVar of matching_var_kind
   | VarInstance of Id.t
-  | SubEvar of Constr.existential_key
+  | SubEvar of Evar.t
diff --git a/intf/extend.ml b/intf/extend.ml
index 5552bed55..78f0aa117 100644
--- a/intf/extend.ml
+++ b/intf/extend.ml
@@ -29,29 +29,48 @@ type production_level =
   | NextLevel
   | NumLevel of int
 
-type ('lev,'pos) constr_entry_key_gen =
-  | ETName | ETReference | ETBigint
-  | ETBinder of bool
-  | ETConstr of ('lev * 'pos)
-  | ETPattern
+type constr_as_binder_kind =
+  | AsIdent
+  | AsIdentOrPattern
+  | AsStrictPattern
+
+(** User-level types used to tell how to parse or interpret of the non-terminal *)
+
+type 'a constr_entry_key_gen =
+  | ETName
+  | ETReference
+  | ETBigint
+  | ETBinder of bool  (* open list of binders if true, closed list of binders otherwise *)
+  | ETConstr of 'a
+  | ETConstrAsBinder of constr_as_binder_kind * 'a
+  | ETPattern of bool * int option (* true = strict pattern, i.e. not a single variable *)
   | ETOther of string * string
-  | ETConstrList of ('lev * 'pos) * Tok.t list
-  | ETBinderList of bool * Tok.t list
 
-(** Entries level (left-hand-side of grammar rules) *)
+(** Entries level (left-hand side of grammar rules) *)
 
 type constr_entry_key =
-    (int,unit) constr_entry_key_gen
-
-(** Entries used in productions (in right-hand-side of grammar rules) *)
-
-type constr_prod_entry_key =
-    (production_level,production_position) constr_entry_key_gen
+    (production_level * production_position) constr_entry_key_gen
 
 (** Entries used in productions, vernac side (e.g. "x bigint" or "x ident") *)
 
 type simple_constr_prod_entry_key =
-    (production_level,unit) constr_entry_key_gen
+    production_level option constr_entry_key_gen
+
+(** Entries used in productions (in right-hand-side of grammar rules), to parse non-terminals *)
+
+type binder_entry_kind = ETBinderOpen | ETBinderClosed of Tok.t list
+
+type binder_target = ForBinder | ForTerm
+
+type constr_prod_entry_key =
+  | ETProdName            (* Parsed as a name (ident or _) *)
+  | ETProdReference       (* Parsed as a global reference *)
+  | ETProdBigint          (* Parsed as an (unbounded) integer *)
+  | ETProdConstr of (production_level * production_position) (* Parsed as constr or pattern *)
+  | ETProdPattern of int  (* Parsed as pattern as a binder (as subpart of a constr) *)
+  | ETProdOther of string * string (* Intended for embedding custom entries in constr or pattern *)
+  | ETProdConstrList of (production_level * production_position) * Tok.t list (* Parsed as non-empty list of constr *)
+  | ETProdBinderList of binder_entry_kind  (* Parsed as non-empty list of local binders *)
 
 (** {5 AST for user-provided entries} *)
 
diff --git a/intf/genredexpr.ml b/intf/genredexpr.ml
index a8c37c620..bdf3242ca 100644
--- a/intf/genredexpr.ml
+++ b/intf/genredexpr.ml
@@ -8,8 +8,6 @@
 
 (** Reduction expressions *)
 
-open Names
-
 (** The parsing produces initially a list of [red_atom] *)
 
 type 'a red_atom =
@@ -52,7 +50,7 @@ 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 Id.t Loc.located * 'a
+  | ConstrContext of Misctypes.lident * 'a
   | ConstrTypeOf of 'a
 
 open Libnames
diff --git a/intf/glob_term.ml b/intf/glob_term.ml
index dd122b972..3f48fa547 100644
--- a/intf/glob_term.ml
+++ b/intf/glob_term.ml
@@ -24,90 +24,88 @@ type existential_name = Id.t
 (**  The kind of patterns that occurs in "match ... with ... end"
 
      locs here refers to the ident's location, not whole pat *)
-type cases_pattern_r =
+type 'a cases_pattern_r =
   | PatVar  of Name.t
-  | PatCstr of constructor * cases_pattern list * Name.t
+  | PatCstr of constructor * 'a cases_pattern_g list * Name.t
       (** [PatCstr(p,C,l,x)] = "|'C' 'l' as 'x'" *)
-and cases_pattern = cases_pattern_r CAst.t
+and 'a cases_pattern_g = ('a cases_pattern_r, 'a) DAst.t
+
+type cases_pattern = [ `any ] cases_pattern_g
 
 (** Representation of an internalized (or in other words globalized) term. *)
-type glob_constr_r =
+type 'a glob_constr_r =
   | GRef of global_reference * glob_level list option
       (** An identifier that represents a reference to an object defined
           either in the (global) environment or in the (local) context. *)
   | GVar of Id.t
       (** An identifier that cannot be regarded as "GRef".
           Bound variables are typically represented this way. *)
-  | GEvar   of existential_name * (Id.t * glob_constr) list
+  | GEvar   of existential_name * (Id.t * 'a glob_constr_g) list
   | GPatVar of Evar_kinds.matching_var_kind (** Used for patterns only *)
-  | GApp    of glob_constr * glob_constr list
-  | GLambda of Name.t * binding_kind *  glob_constr * glob_constr
-  | GProd   of Name.t * binding_kind * glob_constr * glob_constr
-  | GLetIn  of Name.t * glob_constr * glob_constr option * glob_constr
-  | GCases  of case_style * glob_constr option * tomatch_tuples * cases_clauses
+  | GApp    of 'a glob_constr_g * 'a glob_constr_g list
+  | GLambda of Name.t * binding_kind *  'a glob_constr_g * 'a glob_constr_g
+  | GProd   of Name.t * binding_kind * 'a glob_constr_g * 'a glob_constr_g
+  | GLetIn  of Name.t * 'a glob_constr_g * 'a glob_constr_g option * 'a glob_constr_g
+  | GCases  of Constr.case_style * 'a glob_constr_g option * 'a tomatch_tuples_g * 'a cases_clauses_g
       (** [GCases(style,r,tur,cc)] = "match 'tur' return 'r' with 'cc'" (in [MatchStyle]) *)
-  | GLetTuple of Name.t list * (Name.t * glob_constr option) * glob_constr * glob_constr
-  | GIf   of glob_constr * (Name.t * glob_constr option) * glob_constr * glob_constr
-  | GRec  of fix_kind * Id.t array * glob_decl list array *
-             glob_constr array * glob_constr array
+  | GLetTuple of Name.t list * (Name.t * 'a glob_constr_g option) * 'a glob_constr_g * 'a glob_constr_g
+  | GIf   of 'a glob_constr_g * (Name.t * 'a glob_constr_g option) * 'a glob_constr_g * 'a glob_constr_g
+  | GRec  of 'a fix_kind_g * Id.t array * 'a glob_decl_g list array *
+             'a glob_constr_g array * 'a glob_constr_g array
   | GSort of glob_sort
   | GHole of Evar_kinds.t * intro_pattern_naming_expr * Genarg.glob_generic_argument option
-  | GCast of glob_constr * glob_constr cast_type
-and glob_constr = glob_constr_r CAst.t
+  | GCast of 'a glob_constr_g * 'a glob_constr_g cast_type
+  | GProj of Projection.t * 'a glob_constr_g
+and 'a glob_constr_g = ('a glob_constr_r, 'a) DAst.t
 
-and glob_decl = Name.t * binding_kind * glob_constr option * glob_constr
+and 'a glob_decl_g = Name.t * binding_kind * 'a glob_constr_g option * 'a glob_constr_g
 
-and fix_recursion_order =
+and 'a fix_recursion_order_g =
   | GStructRec
-  | GWfRec of glob_constr
-  | GMeasureRec of glob_constr * glob_constr option
+  | GWfRec of 'a glob_constr_g
+  | GMeasureRec of 'a glob_constr_g * 'a glob_constr_g option
 
-and fix_kind =
-  | GFix of ((int option * fix_recursion_order) array * int)
+and 'a fix_kind_g =
+  | GFix of ((int option * 'a fix_recursion_order_g) array * int)
   | GCoFix of int
 
-and predicate_pattern =
+and 'a predicate_pattern_g =
     Name.t * (inductive * Name.t list) Loc.located option
       (** [(na,id)] = "as 'na' in 'id'" where if [id] is [Some(l,I,k,args)]. *)
 
-and tomatch_tuple = (glob_constr * predicate_pattern)
+and 'a tomatch_tuple_g = ('a glob_constr_g * 'a predicate_pattern_g)
 
-and tomatch_tuples = tomatch_tuple list
+and 'a tomatch_tuples_g = 'a tomatch_tuple_g list
 
-and cases_clause = (Id.t list * cases_pattern list * glob_constr) Loc.located
+and 'a cases_clause_g = (Id.t list * 'a cases_pattern_g list * 'a glob_constr_g) Loc.located
 (** [(p,il,cl,t)] = "|'cl' => 't'". Precondition: the free variables
     of [t] are members of [il]. *)
-and cases_clauses = cases_clause list
-
-type extended_glob_local_binder_r =
-  | GLocalAssum   of Name.t * binding_kind * glob_constr
-  | GLocalDef     of Name.t * binding_kind * glob_constr * glob_constr option
-  | GLocalPattern of (cases_pattern * Id.t list) * Id.t * binding_kind * glob_constr
-and extended_glob_local_binder = extended_glob_local_binder_r CAst.t
-
-(** A globalised term together with a closure representing the value
-    of its free variables. Intended for use when these variables are taken
-    from the Ltac environment. *)
-type closure = {
-  idents:Id.t Id.Map.t;
-  typed: Pattern.constr_under_binders Id.Map.t ;
-  untyped:closed_glob_constr Id.Map.t }
-and closed_glob_constr = {
-  closure: closure;
-  term: glob_constr }
-
-(** Ltac variable maps *)
-type var_map = Pattern.constr_under_binders Id.Map.t
-type uconstr_var_map = closed_glob_constr Id.Map.t
-type unbound_ltac_var_map = Geninterp.Val.t Id.Map.t
-
-type ltac_var_map = {
-  ltac_constrs : var_map;
-  (** Ltac variables bound to constrs *)
-  ltac_uconstrs : uconstr_var_map;
-  (** Ltac variables bound to untyped constrs *)
-  ltac_idents: Id.t Id.Map.t;
-  (** Ltac variables bound to identifiers *)
-  ltac_genargs : unbound_ltac_var_map;
-  (** Ltac variables bound to other kinds of arguments *)
-}
+and 'a cases_clauses_g = 'a cases_clause_g list
+
+type glob_constr = [ `any ] glob_constr_g
+type tomatch_tuple = [ `any ] tomatch_tuple_g
+type tomatch_tuples = [ `any ] tomatch_tuples_g
+type cases_clause = [ `any ] cases_clause_g
+type cases_clauses = [ `any ] cases_clauses_g
+type glob_decl = [ `any ] glob_decl_g
+type fix_kind = [ `any ] fix_kind_g
+type predicate_pattern = [ `any ] predicate_pattern_g
+type fix_recursion_order = [ `any ] fix_recursion_order_g
+
+type any_glob_constr = AnyGlobConstr : 'r glob_constr_g -> any_glob_constr
+
+type 'a disjunctive_cases_clause_g = (Id.t list * 'a cases_pattern_g list list * 'a glob_constr_g) Loc.located
+type 'a disjunctive_cases_clauses_g = 'a disjunctive_cases_clause_g list
+type 'a cases_pattern_disjunction_g = 'a cases_pattern_g list
+
+type disjunctive_cases_clause = [ `any ] disjunctive_cases_clause_g
+type disjunctive_cases_clauses = [ `any ] disjunctive_cases_clauses_g
+type cases_pattern_disjunction = [ `any ] cases_pattern_disjunction_g
+
+type 'a extended_glob_local_binder_r =
+  | GLocalAssum   of Name.t * binding_kind * 'a glob_constr_g
+  | GLocalDef     of Name.t * binding_kind * 'a glob_constr_g * 'a glob_constr_g option
+  | GLocalPattern of ('a cases_pattern_disjunction_g * Id.t list) * Id.t * binding_kind * 'a glob_constr_g
+and 'a extended_glob_local_binder_g = ('a extended_glob_local_binder_r, 'a) DAst.t
+
+type extended_glob_local_binder = [ `any ] extended_glob_local_binder_g
diff --git a/intf/intf.mllib b/intf/intf.mllib
index 523e4b265..2b8960d3f 100644
--- a/intf/intf.mllib
+++ b/intf/intf.mllib
@@ -2,10 +2,9 @@ Constrexpr
 Evar_kinds
 Genredexpr
 Locus
+Extend
 Notation_term
-Tactypes
 Decl_kinds
-Extend
 Glob_term
 Misctypes
 Pattern
diff --git a/intf/misctypes.ml b/intf/misctypes.ml
index 807882b42..aafd61b3c 100644
--- a/intf/misctypes.ml
+++ b/intf/misctypes.ml
@@ -8,7 +8,13 @@
 
 open Names
 
-(** Basic types used both in [constr_expr] and in [glob_constr] *)
+(** Basic types used both in [constr_expr], [glob_constr], and [vernacexpr] *)
+
+(** Located identifiers and objects with syntax. *)
+
+type lident = Id.t CAst.t
+type lname = Name.t CAst.t
+type lstring = string CAst.t
 
 (** Cases pattern variables *)
 
@@ -48,11 +54,18 @@ type 'a glob_sort_gen =
   | GProp (** representation of [Prop] literal *)
   | GSet  (** representation of [Set] literal *)
   | GType of 'a (** representation of [Type] literal *)
-type sort_info = Name.t Loc.located list
-type level_info = Name.t Loc.located option
 
-type glob_sort = sort_info glob_sort_gen
+type 'a universe_kind =
+  | UAnonymous
+  | UUnknown
+  | UNamed of 'a
+
+type level_info = Libnames.reference universe_kind
 type glob_level = level_info glob_sort_gen
+type glob_constraint = glob_level * Univ.constraint_type * glob_level
+
+type sort_info = (Libnames.reference * int) option list
+type glob_sort = sort_info glob_sort_gen
 
 (** A synonym of [Evar.t], also defined in Term *)
 
@@ -60,12 +73,13 @@ type existential_key = Evar.t
 
 (** Case style, shared with Term *)
 
-type case_style = Term.case_style =
+type case_style = Constr.case_style =
   | LetStyle
   | IfStyle
   | LetPatternStyle
   | MatchStyle
   | RegularStyle (** infer printing form from number of constructor *)
+[@@ocaml.deprecated "Alias for Constr.case_style"]
 
 (** Casts *)
 
@@ -93,9 +107,9 @@ type 'a with_bindings = 'a * 'a bindings
 
 type 'a or_var =
   | ArgArg of 'a
-  | ArgVar of Names.Id.t Loc.located
+  | ArgVar of lident
 
-type 'a and_short_name = 'a * Id.t Loc.located option
+type 'a and_short_name = 'a * lident option
 
 type 'a or_by_notation =
   | AN of 'a
@@ -126,7 +140,7 @@ type multi =
 
 type 'a core_destruction_arg =
   | ElimOnConstr of 'a
-  | ElimOnIdent of Id.t Loc.located
+  | ElimOnIdent of lident
   | ElimOnAnonHyp of int
 
 type 'a destruction_arg =
@@ -136,3 +150,9 @@ type inversion_kind =
   | SimpleInversion
   | FullInversion
   | FullInversionClear
+
+type ('a, 'b) gen_universe_decl = {
+  univdecl_instance : 'a; (* Declared universes *)
+  univdecl_extensible_instance : bool; (* Can new universes be added *)
+  univdecl_constraints : 'b; (* Declared constraints *)
+  univdecl_extensible_constraints : bool (* Can new constraints be added *) }
diff --git a/intf/notation_term.ml b/intf/notation_term.ml
index c342da3dc..86f5adbd7 100644
--- a/intf/notation_term.ml
+++ b/intf/notation_term.ml
@@ -25,13 +25,13 @@ type notation_constr =
   | NVar of Id.t
   | NApp of notation_constr * notation_constr list
   | NHole of Evar_kinds.t * Misctypes.intro_pattern_naming_expr * Genarg.glob_generic_argument option
-  | NList of Id.t * Id.t * notation_constr * notation_constr * bool
+  | NList of Id.t * Id.t * notation_constr * notation_constr * (* associativity: *) bool
   (** Part only in [glob_constr] *)
   | NLambda of Name.t * notation_constr * notation_constr
   | NProd of Name.t * notation_constr * notation_constr
-  | NBinderList of Id.t * Id.t * notation_constr * notation_constr
+  | NBinderList of Id.t * Id.t * notation_constr * notation_constr * (* associativity: *) bool
   | NLetIn of Name.t * notation_constr * notation_constr option * notation_constr
-  | NCases of case_style * notation_constr option *
+  | NCases of Constr.case_style * notation_constr option *
       (notation_constr * (Name.t * (inductive * Name.t list) option)) list *
       (cases_pattern list * notation_constr) list
   | NLetTuple of Name.t list * (Name.t * notation_constr option) *
@@ -43,6 +43,7 @@ type notation_constr =
       notation_constr array * notation_constr array
   | NSort of glob_sort
   | NCast of notation_constr * notation_constr cast_type
+  | NProj of Projection.t * notation_constr
 
 (** Note concerning NList: first constr is iterator, second is terminator;
     first id is where each argument of the list has to be substituted
@@ -59,21 +60,31 @@ type subscopes = tmp_scope_name option * scope_name list
 
 (** Type of the meta-variables of an notation_constr: in a recursive pattern x..y,
     x carries the sequence of objects bound to the list x..y  *)
+
+type notation_binder_source =
+  (* This accepts only pattern *)
+  (* NtnParsedAsPattern true means only strict pattern (no single variable) at printing *)
+  | NtnParsedAsPattern of bool
+  (* This accepts only ident *)
+  | NtnParsedAsIdent
+  (* This accepts ident, or pattern, or both *)
+  | NtnBinderParsedAsConstr of Extend.constr_as_binder_kind
+
 type notation_var_instance_type =
-  | NtnTypeConstr | NtnTypeOnlyBinder | NtnTypeConstrList | NtnTypeBinderList
+  | NtnTypeConstr | NtnTypeBinder of notation_binder_source | NtnTypeConstrList | NtnTypeBinderList
 
-(** Type of variables when interpreting a constr_expr as an notation_constr:
+(** Type of variables when interpreting a constr_expr as a notation_constr:
     in a recursive pattern x..y, both x and y carry the individual type
     of each element of the list x..y *)
 type notation_var_internalization_type =
-  | NtnInternTypeConstr | NtnInternTypeBinder | NtnInternTypeIdent
+  | NtnInternTypeAny | NtnInternTypeOnlyBinder
 
 (** This characterizes to what a notation is interpreted to *)
 type interpretation =
     (Id.t * (subscopes * notation_var_instance_type)) list *
     notation_constr
 
-type reversibility_flag = bool
+type reversibility_status = APrioriReversible | HasLtac | NonInjective of Id.t list
 
 type notation_interp_env = {
   ninterp_var_type : notation_var_internalization_type Id.Map.t;
@@ -94,7 +105,7 @@ type precedence = int
 type parenRelation = L | E | Any | Prec of precedence
 type tolerability = precedence * parenRelation
 
-type level = precedence * tolerability list * notation_var_internalization_type list
+type level = precedence * tolerability list * Extend.constr_entry_key list
 
 (** Grammar rules for a notation *)
 
diff --git a/intf/pattern.ml b/intf/pattern.ml
index 2ab526984..64873a039 100644
--- a/intf/pattern.ml
+++ b/intf/pattern.ml
@@ -8,52 +8,13 @@
 
 open Names
 open Globnames
-open Term
+open Constr
 open Misctypes
 
-(** {5 Maps of pattern variables} *)
-
-(** Type [constr_under_binders] is for representing the term resulting
-    of a matching. Matching can return terms defined in a some context
-    of named binders; in the context, variable names are ordered by
-    (<) and referred to by index in the term Thanks to the canonical
-    ordering, a matching problem like
-
-    [match ... with [(fun x y => ?p,fun y x => ?p)] => [forall x y => p]]
-
-    will be accepted. Thanks to the reference by index, a matching
-    problem like
-
-    [match ... with [(fun x => ?p)] => [forall x => p]]
-
-    will work even if [x] is also the name of an existing goal
-    variable.
-
-    Note: we do not keep types in the signature. Besides simplicity,
-    the main reason is that it would force to close the signature over
-    binders that occur only in the types of effective binders but not
-    in the term itself (e.g. for a term [f x] with [f:A -> True] and
-    [x:A]).
-
-    On the opposite side, by not keeping the types, we loose
-    opportunity to propagate type informations which otherwise would
-    not be inferable, as e.g. when matching [forall x, x = 0] with
-    pattern [forall x, ?h = 0] and using the solution "x|-h:=x" in
-    expression [forall x, h = x] where nothing tells how the type of x
-    could be inferred. We also loose the ability of typing ltac
-    variables before calling the right-hand-side of ltac matching clauses. *)
-
-type constr_under_binders = Id.t list * EConstr.constr
-
-(** Types of substitutions with or w/o bound variables *)
-
-type patvar_map = EConstr.constr Id.Map.t
-type extended_patvar_map = constr_under_binders Id.Map.t
-
 (** {5 Patterns} *)
 
 type case_info_pattern =
-    { cip_style : case_style;
+    { cip_style : Constr.case_style;
       cip_ind : inductive option;
       cip_ind_tags : bool list option; (** indicates LetIn/Lambda in arity *)
       cip_extensible : bool (** does this match end with _ => _ ? *) }
@@ -65,7 +26,7 @@ type constr_pattern =
   | PRel of int
   | PApp of constr_pattern * constr_pattern array
   | PSoApp of patvar * constr_pattern list
-  | PProj of projection * constr_pattern
+  | PProj of Projection.t * constr_pattern
   | PLambda of Name.t * constr_pattern * constr_pattern
   | PProd of Name.t * constr_pattern * constr_pattern
   | PLetIn of Name.t * constr_pattern * constr_pattern option * constr_pattern
diff --git a/intf/vernacexpr.ml b/intf/vernacexpr.ml
index 2adf522b7..ba28eacea 100644
--- a/intf/vernacexpr.ml
+++ b/intf/vernacexpr.ml
@@ -6,19 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Loc
 open Names
 open Misctypes
 open Constrexpr
-open Decl_kinds
 open Libnames
 
 (** Vernac expressions, produced by the parser *)
-
-type lident = Id.t located
-type lname = Name.t located
-type lstring = string located
-
 type class_rawexpr = FunClass | SortClass | RefClass of reference or_by_notation
 
 (* spiwack: I'm choosing, for now, to have [goal_selector] be a
@@ -39,7 +32,9 @@ type goal_reference =
   | OpenSubgoals
   | NthGoal of int
   | GoalId of Id.t
-  | GoalUid of goal_identifier
+
+type univ_name_list = Universes.univ_name_list
+[@@ocaml.deprecated "Use [Universes.univ_name_list]"]
 
 type printable =
   | PrintTables
@@ -55,7 +50,7 @@ type printable =
   | PrintMLLoadPath
   | PrintMLModules
   | PrintDebugGC
-  | PrintName of reference or_by_notation
+  | PrintName of reference or_by_notation * Universes.univ_name_list option
   | PrintGraph
   | PrintClasses
   | PrintTypeClasses
@@ -71,7 +66,7 @@ type printable =
   | PrintScopes
   | PrintScope of string
   | PrintVisibility of string option
-  | PrintAbout of reference or_by_notation * goal_selector option
+  | PrintAbout of reference or_by_notation * Universes.univ_name_list option * goal_selector option
   | PrintImplicit of reference or_by_notation
   | PrintAssumptions of bool * bool * reference or_by_notation
   | PrintStrategy of reference or_by_notation option
@@ -91,7 +86,7 @@ type locatable =
   | LocateTerm of reference or_by_notation
   | LocateLibrary of reference
   | LocateModule of reference
-  | LocateTactic of reference
+  | LocateOther of string * reference
   | LocateFile of string
 
 type showable =
@@ -139,22 +134,17 @@ type search_restriction =
 
 type rec_flag       = bool (* true = Rec;           false = NoRec          *)
 type verbose_flag   = bool (* true = Verbose;       false = Silent         *)
-                           (*   list of idents for qed exporting           *)
-type opacity_flag   = Opaque of lident list option | Transparent
+type opacity_flag   = Opaque | Transparent
 type coercion_flag  = bool (* true = AddCoercion    false = NoCoercion     *)
 type instance_flag  = bool option
   (* Some true = Backward instance; Some false = Forward instance, None = NoInstance *)
 type export_flag    = bool (* true = Export;        false = Import         *)
-type inductive_flag = Decl_kinds.recursivity_kind
+type inductive_flag = Declarations.recursivity_kind
 type onlyparsing_flag = Flags.compat_version option
  (* Some v = Parse only;  None = Print also.
     If v<>Current, it contains the name of the coq version
     which this notation is trying to be compatible with *)
 type locality_flag  = bool (* true = Local *)
-type obsolete_locality = bool
-(* Some grammar entries use obsolete_locality.  This bool is to be backward
- * compatible.  If the grammar is fixed removing deprecated syntax, this
- * bool should go away too *)
 
 type option_value = Goptions.option_value =
   | BoolValue of bool
@@ -166,10 +156,14 @@ type option_ref_value =
   | StringRefValue of string
   | QualidRefValue of reference
 
-(** Identifier and optional list of bound universes. *)						 
-type plident = lident * lident list option
+(** Identifier and optional list of bound universes and constraints. *)
+
+type universe_decl_expr = (lident list, glob_constraint list) gen_universe_decl
 
-type sort_expr = glob_sort
+type ident_decl = lident * universe_decl_expr option
+type name_decl = lname * universe_decl_expr option
+
+type sort_expr = Sorts.family
 
 type definition_expr =
   | ProveBody of local_binder_expr list * constr_expr
@@ -177,10 +171,10 @@ type definition_expr =
       * constr_expr option
 
 type fixpoint_expr =
-    plident * (Id.t located option * recursion_order_expr) * local_binder_expr list * constr_expr * constr_expr option
+    ident_decl * (lident option * recursion_order_expr) * local_binder_expr list * constr_expr * constr_expr option
 
 type cofixpoint_expr =
-    plident * local_binder_expr list * constr_expr * constr_expr option
+    ident_decl * local_binder_expr list * constr_expr * constr_expr option
 
 type local_decl_expr =
   | AssumExpr of lname * constr_expr
@@ -199,24 +193,29 @@ type constructor_list_or_record_decl_expr =
   | Constructors of constructor_expr list
   | RecordDecl of lident option * local_decl_expr with_instance with_priority with_notation list
 type inductive_expr =
-  plident with_coercion * local_binder_expr list * constr_expr option * inductive_kind *
+  ident_decl with_coercion * local_binder_expr list * constr_expr option * inductive_kind *
     constructor_list_or_record_decl_expr
 
 type one_inductive_expr =
-  plident * local_binder_expr list * constr_expr option * constructor_expr list
+  ident_decl * local_binder_expr list * constr_expr option * constructor_expr list
+
+type typeclass_constraint = name_decl * Decl_kinds.binding_kind * constr_expr
+
+and typeclass_context = typeclass_constraint list
 
 type proof_expr =
-  plident option * (local_binder_expr list * constr_expr)
+  ident_decl * (local_binder_expr list * constr_expr)
 
 type syntax_modifier =
   | SetItemLevel of string list * Extend.production_level
+  | SetItemLevelAsBinder of string list * Extend.constr_as_binder_kind * Extend.production_level option
   | SetLevel of int
   | SetAssoc of Extend.gram_assoc
   | SetEntryType of string * Extend.simple_constr_prod_entry_key
   | SetOnlyParsing
   | SetOnlyPrinting
   | SetCompatVersion of Flags.compat_version
-  | SetFormat of string * string located
+  | SetFormat of string * lstring
 
 type proof_end =
   | Admitted
@@ -230,6 +229,7 @@ type scheme =
 
 type section_subset_expr =
   | SsEmpty
+  | SsType
   | SsSingl of lident
   | SsCompl of section_subset_expr
   | SsUnion of section_subset_expr * section_subset_expr
@@ -280,11 +280,6 @@ type bullet =
     | Star of int
     | Plus of int
 
-(** {6 Types concerning Stm} *)
-type stm_vernac =
-  | JoinDocument
-  | Wait
-
 (** {6 Types concerning the module layer} *)
 
 (** Rigid / flexible module signature *)
@@ -315,44 +310,44 @@ type cumulative_inductive_parsing_flag =
 
 (** {6 The type of vernacular expressions} *)
 
-type vernac_expr =
-  (* Control *)
-  | VernacLoad of verbose_flag * string
-  | VernacTime of vernac_expr located
-  | VernacRedirect of string * vernac_expr located
-  | VernacTimeout of int * vernac_expr
-  | VernacFail of vernac_expr
+type vernac_implicit_status = Implicit | MaximallyImplicit | NotImplicit
 
+type vernac_argument_status = {
+  name : Name.t;
+  recarg_like : bool;
+  notation_scope : string CAst.t option;
+  implicit_status : vernac_implicit_status;
+}
+
+type nonrec vernac_expr =
+
+  | VernacLoad of verbose_flag * string
   (* Syntax *)
-  | VernacSyntaxExtension of
-      obsolete_locality * (lstring * syntax_modifier list)
-  | VernacOpenCloseScope of obsolete_locality * (bool * scope_name)
+  | VernacSyntaxExtension of bool * (lstring * syntax_modifier list)
+  | VernacOpenCloseScope of bool * scope_name
   | VernacDelimiters of scope_name * string option
   | VernacBindScope of scope_name * class_rawexpr list
-  | VernacInfix of obsolete_locality * (lstring * syntax_modifier list) *
+  | VernacInfix of (lstring * syntax_modifier list) *
       constr_expr * scope_name option
   | VernacNotation of
-      obsolete_locality * constr_expr * (lstring * syntax_modifier list) *
+      constr_expr * (lstring * syntax_modifier list) *
       scope_name option
   | VernacNotationAddFormat of string * string * string
 
   (* Gallina *)
-  | VernacDefinition of
-      (locality option * definition_object_kind) * plident * definition_expr
-  | VernacStartTheoremProof of theorem_kind * proof_expr list
+  | VernacDefinition of (Decl_kinds.discharge * Decl_kinds.definition_object_kind) * name_decl * definition_expr
+  | VernacStartTheoremProof of Decl_kinds.theorem_kind * proof_expr list
   | VernacEndProof of proof_end
   | VernacExactProof of constr_expr
-  | VernacAssumption of (locality option * assumption_object_kind) *
-      inline * (plident list * constr_expr) with_coercion list
-  | VernacInductive of cumulative_inductive_parsing_flag * private_flag * inductive_flag * (inductive_expr * decl_notation list) list
-  | VernacFixpoint of
-      locality option * (fixpoint_expr * decl_notation list) list
-  | VernacCoFixpoint of
-      locality option * (cofixpoint_expr * decl_notation list) list
+  | VernacAssumption of (Decl_kinds.discharge * Decl_kinds.assumption_object_kind) *
+      inline * (ident_decl list * constr_expr) with_coercion list
+  | VernacInductive of cumulative_inductive_parsing_flag * Decl_kinds.private_flag * inductive_flag * (inductive_expr * decl_notation list) list
+  | VernacFixpoint of Decl_kinds.discharge * (fixpoint_expr * decl_notation list) list
+  | VernacCoFixpoint of Decl_kinds.discharge * (cofixpoint_expr * decl_notation list) list
   | VernacScheme of (lident option * scheme) list
   | VernacCombinedScheme of lident * lident list
   | VernacUniverse of lident list
-  | VernacConstraint of (glob_level * Univ.constraint_type * glob_level) list
+  | VernacConstraint of glob_constraint list
 
   (* Gallina extensions *)
   | VernacBeginSection of lident
@@ -361,10 +356,9 @@ type vernac_expr =
       reference option * export_flag option * reference list
   | VernacImport of export_flag * reference list
   | VernacCanonical of reference or_by_notation
-  | VernacCoercion of obsolete_locality * reference or_by_notation *
-      class_rawexpr * class_rawexpr
-  | VernacIdentityCoercion of obsolete_locality * lident *
+  | VernacCoercion of reference or_by_notation *
       class_rawexpr * class_rawexpr
+  | VernacIdentityCoercion of lident * class_rawexpr * class_rawexpr
   | VernacNameSectionHypSet of lident * section_subset_expr 
 
   (* Type classes *)
@@ -415,9 +409,9 @@ type vernac_expr =
   (* Commands *)
   | VernacCreateHintDb of string * bool
   | VernacRemoveHints of string list * reference list
-  | VernacHints of obsolete_locality * string list * hints_expr
-  | VernacSyntacticDefinition of Id.t located * (Id.t list * constr_expr) *
-      obsolete_locality * onlyparsing_flag
+  | VernacHints of string list * hints_expr
+  | VernacSyntacticDefinition of lident * (Id.t list * constr_expr) *
+      onlyparsing_flag
   | VernacDeclareImplicits of reference or_by_notation *
       (explicitation * bool * bool) list list
   | VernacArguments of reference or_by_notation *
@@ -450,12 +444,7 @@ type vernac_expr =
   | VernacRegister of lident * register_kind
   | VernacComments of comment list
 
-  (* Stm backdoor: used in fake_id, will be removed when fake_ide
-     becomes aware of feedback about completed jobs. *)
-  | VernacStm of stm_vernac
-
   (* Proof management *)
-  | VernacGoal of constr_expr
   | VernacAbort of lident option
   | VernacAbortAll
   | VernacRestart
@@ -466,7 +455,7 @@ type vernac_expr =
   | VernacUnfocus
   | VernacUnfocused
   | VernacBullet of bullet
-  | VernacSubproof of int option
+  | VernacSubproof of goal_selector option
   | VernacEndSubproof
   | VernacShow of showable
   | VernacCheckGuard
@@ -478,42 +467,59 @@ type vernac_expr =
   (* For extension *)
   | VernacExtend of extend_name * Genarg.raw_generic_argument list
 
-  (* Flags *)
-  | VernacProgram of vernac_expr
-  | VernacPolymorphic of bool * vernac_expr
-  | VernacLocal of bool * vernac_expr
+type nonrec vernac_flag =
+  | VernacProgram
+  | VernacPolymorphic of bool
+  | VernacLocal of bool
 
-and vernac_implicit_status = Implicit | MaximallyImplicit | NotImplicit
+type vernac_control =
+  | VernacExpr of vernac_flag list * vernac_expr
+  (* boolean is true when the `-time` batch-mode command line flag was set.
+     the flag is used to print differently in `-time` vs `Time foo` *)
+  | VernacTime of bool * vernac_control CAst.t
+  | VernacRedirect of string * vernac_control CAst.t
+  | VernacTimeout of int * vernac_control
+  | VernacFail of vernac_control
 
-and vernac_argument_status = {
-  name : Name.t;
-  recarg_like : bool;
-  notation_scope : string Loc.located option;
-  implicit_status : vernac_implicit_status;
-}
+(* A vernac classifier provides information about the exectuion of a
+   command:
 
-(* A vernac classifier has to tell if a command:
-   vernac_when: has to be executed now (alters the parser) or later
-   vernac_type: if it is starts, ends, continues a proof or
+   - vernac_when: encodes if the vernac may alter the parser [thus
+     forcing immediate execution], or if indeed it is pure and parsing
+     can continue without its execution.
+
+   - vernac_type: if it is starts, ends, continues a proof or
      alters the global state or is a control command like BackTo or is
-     a query like Check *)
+     a query like Check.
+
+   The classification works on the assumption that we have 3 states:
+   parsing, execution (global enviroment, etc...), and proof
+   state. For example, commands that only alter the proof state are
+   considered safe to delegate to a worker.
+
+*)
 type vernac_type =
+  (* Start of a proof *)
   | VtStartProof of vernac_start
+  (* Command altering the global state, bad for parallel
+     processing. *)
   | VtSideff of vernac_sideff_type
+  (* End of a proof *)
   | VtQed of vernac_qed_type
+  (* A proof step *)
   | VtProofStep of proof_step
+  (* To be removed *)
   | VtProofMode of string
+  (* Queries are commands assumed to be "pure", that is to say, they
+     don't modify the interpretation state. *)
   | VtQuery of vernac_part_of_script * Feedback.route_id
-  | VtStm of vernac_control * vernac_part_of_script
+  (* To be removed *)
+  | VtMeta
   | VtUnknown
 and vernac_qed_type = VtKeep | VtKeepAsAxiom | VtDrop (* Qed/Admitted, Abort *)
 and vernac_start = string * opacity_guarantee * Id.t list
 and vernac_sideff_type = Id.t list
 and vernac_part_of_script = bool
-and vernac_control =
-  | VtWait
-  | VtJoinDocument
-  | VtBack of Stateid.t
 and opacity_guarantee =
   | GuaranteesOpacity (** Only generates opaque terms at [Qed] *)
   | Doesn'tGuaranteeOpacity (** May generate transparent terms even with [Qed].*)
diff --git a/kernel/cClosure.ml b/kernel/cClosure.ml
index 7e193ef82..219ea5b24 100644
--- a/kernel/cClosure.ml
+++ b/kernel/cClosure.ml
@@ -23,7 +23,7 @@ open CErrors
 open Util
 open Pp
 open Names
-open Term
+open Constr
 open Vars
 open Environ
 open Esubst
@@ -85,12 +85,13 @@ module type RedFlagsSig = sig
   val fFIX : red_kind
   val fCOFIX : red_kind
   val fZETA : red_kind
-  val fCONST : constant -> red_kind
+  val fCONST : Constant.t -> red_kind
   val fVAR : Id.t -> red_kind
   val no_red : reds
   val red_add : reds -> red_kind -> reds
   val red_sub : reds -> red_kind -> reds
   val red_add_transparent : reds -> transparent_state -> reds
+  val red_transparent : reds -> transparent_state
   val mkflags : red_kind list -> reds
   val red_set : reds -> red_kind -> bool
   val red_projection : reds -> projection -> bool
@@ -114,7 +115,7 @@ module RedFlags = (struct
 
   type red_kind = BETA | DELTA | ETA | MATCH | FIX
               | COFIX | ZETA
-	      | CONST of constant | VAR of Id.t
+	      | CONST of Constant.t | VAR of Id.t
   let fBETA = BETA
   let fDELTA = DELTA
   let fETA = ETA
@@ -164,6 +165,8 @@ module RedFlags = (struct
 	let (l1,l2) = red.r_const in
 	{ red with r_const = Id.Pred.remove id l1, l2 }
 
+  let red_transparent red = red.r_const
+
   let red_add_transparent red tr =
     { red with r_const = tr }
 
@@ -234,7 +237,7 @@ let unfold_red kn =
  * instantiations (cbv or lazy) are.
  *)
 
-type table_key = constant puniverses tableKey
+type table_key = Constant.t Univ.puniverses tableKey
 
 let eq_pconstant_key (c,u) (c',u') =
   eq_constant_key c c' && Univ.Instance.equal u u'
@@ -258,7 +261,7 @@ type 'a infos_cache = {
   i_repr : 'a infos -> constr -> 'a;
   i_env : env;
   i_sigma : existential -> constr option;
-  i_rels : constr option array;
+  i_rels : (Context.Rel.Declaration.t * Pre_env.lazy_val) Range.t;
   i_tab : 'a KeyTable.t }
 
 and 'a infos = {
@@ -282,13 +285,16 @@ let ref_value_cache ({i_cache = cache} as infos)  ref =
     let body =
       match ref with
 	| RelKey n ->
-            let len = Array.length cache.i_rels in
-            let i = n - 1 in
-            let () = if i < 0 || len <= i then raise Not_found in
-            begin match Array.unsafe_get cache.i_rels i with
-            | None -> raise Not_found
-            | Some t -> lift n t
-            end
+          let open Context.Rel.Declaration in
+          let i = n - 1 in
+          let (d, _) =
+            try Range.get cache.i_rels i
+            with Invalid_argument _ -> raise Not_found
+          in
+          begin match d with
+          | LocalAssum _ -> raise Not_found
+          | LocalDef (_, t, _) -> lift n t
+          end
 	| VarKey id -> assoc_defined id cache.i_env
 	| ConstKey cst -> constant_value_in cache.i_env cst
     in
@@ -303,26 +309,13 @@ let ref_value_cache ({i_cache = cache} as infos)  ref =
 let evar_value cache ev =
   cache.i_sigma ev
 
-let defined_rels flags env =
-(*  if red_local_const (snd flags) then*)
-  let ctx = rel_context env in
-  let len = List.length ctx in
-  let ans = Array.make len None in
-  let open Context.Rel.Declaration in
-  let iter i = function
-    | LocalAssum _ -> ()
-    | LocalDef (_,b,_) -> Array.unsafe_set ans i (Some b)
-  in
-  let () = List.iteri iter ctx in
-  ans
-(*  else (0,[])*)
-
 let create mk_cl flgs env evars =
+  let open Pre_env in
   let cache =
     { i_repr = mk_cl;
       i_env = env;
       i_sigma = evars;
-      i_rels = defined_rels flgs env;
+      i_rels = (Environ.pre_env env).env_rel_context.env_rel_map;
       i_tab = KeyTable.create 17 }
   in { i_flags = flgs; i_cache = cache }
 
@@ -401,7 +394,7 @@ let update v1 no t =
 type stack_member =
   | Zapp of fconstr array
   | ZcaseT of case_info * constr * constr array * fconstr subs
-  | Zproj of int * int * constant
+  | Zproj of int * int * Constant.t
   | Zfix of fconstr * stack
   | Zshift of int
   | Zupdate of fconstr
@@ -480,7 +473,8 @@ let rec lft_fconstr n ft =
     | FCoFix(cfx,e) -> {norm=Cstr; term=FCoFix(cfx,subs_shft(n,e))}
     | FLIFT(k,m) -> lft_fconstr (n+k) m
     | FLOCKED -> assert false
-    | _ -> {norm=ft.norm; term=FLIFT(n,ft)}
+    | FFlex _ | FAtom _ | FCast _ | FApp _ | FProj _ | FCaseT _ | FProd _
+      | FLetIn _ | FEvar _ | FCLOS _ -> {norm=ft.norm; term=FLIFT(n,ft)}
 let lift_fconstr k f =
   if Int.equal k 0 then f else lft_fconstr k f
 let lift_fconstr_vect k v =
@@ -516,7 +510,7 @@ let zupdate m s =
   else s
 
 let mk_lambda env t =
-  let (rvars,t') = decompose_lam t in
+  let (rvars,t') = Term.decompose_lam t in
   FLambda(List.length rvars, List.rev rvars, t', env)
 
 let destFLambda clos_fun t =
@@ -530,7 +524,7 @@ let destFLambda clos_fun t =
 (* Optimization: do not enclose variables in a closure.
    Makes variable access much faster *)
 let mk_clos e t =
-  match kind_of_term t with
+  match kind t with
     | Rel i -> clos_rel e i
     | Var x -> { norm = Red; term = FFlex (VarKey x) }
     | Const c -> { norm = Red; term = FFlex (ConstKey c) }
@@ -556,7 +550,7 @@ let mk_clos_vect env v = match v with
    subterms.
    Could be used insted of mk_clos. *)
 let mk_clos_deep clos_fun env t =
-  match kind_of_term t with
+  match kind t with
     | (Rel _|Ind _|Const _|Construct _|Var _|Meta _ | Sort _) ->
         mk_clos env t
     | Cast (a,k,b) ->
@@ -655,7 +649,7 @@ let term_of_fconstr =
     match v.term with
       | FCLOS(t,env) when is_subs_id env && is_lift_id lfts -> t
       | FLambda(_,tys,f,e) when is_subs_id e && is_lift_id lfts ->
-          compose_lam (List.rev tys) f
+          Term.compose_lam (List.rev tys) f
       | FFix(fx,e) when is_subs_id e && is_lift_id lfts -> mkFix fx
       | FCoFix(cfx,e) when is_subs_id e && is_lift_id lfts -> mkCoFix cfx
       | _ -> to_constr term_of_fconstr_lift lfts v in
@@ -809,7 +803,7 @@ 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 == Declarations.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
@@ -856,6 +850,14 @@ let contract_fix_vect fix =
   in
   (subs_cons(Array.init nfix make_body, env), thisbody)
 
+let unfold_projection info p =
+  if red_projection info.i_flags p
+  then
+    let open Declarations in
+    let pb = lookup_projection p (info_env info) in
+    Some (Zproj (pb.proj_npars, pb.proj_arg, Projection.constant p))
+  else None
+
 (*********************************************************************)
 (* A machine that inspects the head of a term until it finds an
    atom or a subterm that may produce a redex (abstraction,
@@ -874,15 +876,9 @@ let rec knh info m stk =
            | (None, stk') -> (m,stk'))
     | FCast(t,_,_) -> knh info t stk
     | FProj (p,c) ->
-      let unf = Projection.unfolded p in
-        if unf || red_set info.i_flags (fCONST (Projection.constant p)) then
-          (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,
-				Projection.constant p)
-			 :: zupdate m stk))
-	else (m,stk)
+      (match unfold_projection info p with
+       | None -> (m, stk)
+       | Some s -> knh info c (s :: zupdate m stk))
 
 (* cases where knh stops *)
     | (FFlex _|FLetIn _|FConstruct _|FEvar _|
@@ -891,7 +887,7 @@ let rec knh info m stk =
 
 (* The same for pure terms *)
 and knht info e t stk =
-  match kind_of_term t with
+  match kind t with
     | App(a,b) ->
         knht info e a (append_stack (mk_clos_vect e b) stk)
     | Case(ci,p,t,br) ->
@@ -958,7 +954,10 @@ let rec knr info m stk =
       (match evar_value info.i_cache ev with
           Some c -> knit info env c stk
         | None -> (m,stk))
-  | _ -> (m,stk)
+  | FLOCKED | FRel _ | FAtom _ | FCast _ | FFlex _ | FInd _ | FApp _ | FProj _
+    | FFix _ | FCoFix _ | FCaseT _ | FLambda _ | FProd _ | FLetIn _ | FLIFT _
+    | FCLOS _ -> (m, stk)
+
 
 (* Computes the weak head normal form of a term *)
 and kni info m stk =
@@ -1034,7 +1033,8 @@ and norm_head info m =
           mkEvar(i, Array.map (fun a -> kl info (mk_clos env a)) args)
       | FProj (p,c) ->
           mkProj (p, kl info c)
-      | t -> term_of_fconstr m
+      | FLOCKED | FRel _ | FAtom _ | FCast _ | FFlex _ | FInd _ | FConstruct _
+        | FApp _ | FCaseT _ | FLIFT _ | FCLOS _ -> term_of_fconstr m
 
 (* Initialization and then normalization *)
 
diff --git a/kernel/cClosure.mli b/kernel/cClosure.mli
index 9e5cb48a4..c43fc4623 100644
--- a/kernel/cClosure.mli
+++ b/kernel/cClosure.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
 open Esubst
 
@@ -29,7 +29,7 @@ val all_opaque      : transparent_state
 val all_transparent : transparent_state
 
 val is_transparent_variable : transparent_state -> variable -> bool
-val is_transparent_constant : transparent_state -> constant -> bool
+val is_transparent_constant : transparent_state -> Constant.t -> bool
 
 (** Sets of reduction kinds. *)
 module type RedFlagsSig = sig
@@ -46,7 +46,7 @@ module type RedFlagsSig = sig
   val fFIX : red_kind
   val fCOFIX : red_kind
   val fZETA : red_kind
-  val fCONST : constant -> red_kind
+  val fCONST : Constant.t -> red_kind
   val fVAR : Id.t -> red_kind
 
   (** No reduction at all *)
@@ -61,6 +61,9 @@ module type RedFlagsSig = sig
   (** Adds a reduction kind to a set *)
   val red_add_transparent : reds -> transparent_state -> reds
 
+  (** Retrieve the transparent state of the reduction flags *)
+  val red_transparent : reds -> transparent_state
+
   (** Build a reduction set from scratch = iter [red_add] on [no_red] *)
   val mkflags : red_kind list -> reds
 
@@ -92,7 +95,7 @@ val unfold_side_red : reds
 val unfold_red : evaluable_global_reference -> reds
 
 (***********************************************************************)
-type table_key = constant puniverses tableKey
+type table_key = Constant.t Univ.puniverses tableKey
 
 type 'a infos_cache
 type 'a infos = {
@@ -122,8 +125,8 @@ type fterm =
   | FAtom of constr (** Metas and Sorts *)
   | FCast of fconstr * cast_kind * fconstr
   | FFlex of table_key
-  | FInd of inductive puniverses
-  | FConstruct of constructor puniverses
+  | FInd of inductive Univ.puniverses
+  | FConstruct of constructor Univ.puniverses
   | FApp of fconstr * fconstr array
   | FProj of projection * fconstr
   | FFix of fixpoint * fconstr subs
@@ -145,7 +148,7 @@ type fterm =
 type stack_member =
   | Zapp of fconstr array
   | ZcaseT of case_info * constr * constr array * fconstr subs
-  | Zproj of int * int * constant
+  | Zproj of int * int * Constant.t
   | Zfix of fconstr * stack
   | Zshift of int
   | Zupdate of fconstr
@@ -163,6 +166,7 @@ val stack_tail : int -> stack -> stack
 val stack_nth : stack -> int -> fconstr
 val zip_term : (fconstr -> constr) -> constr -> stack -> constr
 val eta_expand_stack : stack -> stack
+val unfold_projection : 'a infos -> Projection.t -> stack_member option
 
 (** To lazy reduce a constr, create a [clos_infos] with
    [create_clos_infos], inject the term to reduce with [inject]; then use
diff --git a/kernel/cbytecodes.ml b/kernel/cbytecodes.ml
index 25f61c7aa..aa6c49bc7 100644
--- a/kernel/cbytecodes.ml
+++ b/kernel/cbytecodes.ml
@@ -13,7 +13,7 @@
 (* This file defines the type of bytecode instructions *)
 
 open Names
-open Term
+open Constr
 
 type tag = int
 
@@ -32,19 +32,68 @@ let cofix_evaluated_tag = 7
 let last_variant_tag = 245 
 
 type structured_constant =
-  | Const_sorts of sorts
+  | Const_sorts of Sorts.t
   | Const_ind of inductive
   | Const_proj of Constant.t
   | Const_b0 of tag
   | Const_bn of tag * structured_constant array
-  | Const_univ_level of Univ.universe_level
-  | Const_type of Univ.universe
+  | Const_univ_level of Univ.Level.t
+  | Const_type of Univ.Universe.t
 
 type reloc_table = (tag * int) array
 
 type annot_switch =
    {ci : case_info; rtbl : reloc_table; tailcall : bool; max_stack_size : int}
 
+let rec eq_structured_constant c1 c2 = match c1, c2 with
+| Const_sorts s1, Const_sorts s2 -> Sorts.equal s1 s2
+| Const_sorts _, _ -> false
+| Const_ind i1, Const_ind i2 -> eq_ind i1 i2
+| Const_ind _, _ -> false
+| Const_proj p1, Const_proj p2 -> Constant.equal p1 p2
+| Const_proj _, _ -> false
+| Const_b0 t1, Const_b0 t2 -> Int.equal t1 t2
+| Const_b0 _, _ -> false
+| Const_bn (t1, a1), Const_bn (t2, a2) ->
+  Int.equal t1 t2 && CArray.equal eq_structured_constant a1 a2
+| Const_bn _, _ -> false
+| Const_univ_level l1 , Const_univ_level l2 -> Univ.Level.equal l1 l2
+| Const_univ_level _ , _ -> false
+| Const_type u1 , Const_type u2 -> Univ.Universe.equal u1 u2
+| Const_type _ , _ -> false
+
+let rec hash_structured_constant c =
+  let open Hashset.Combine in
+  match c with
+  | Const_sorts s -> combinesmall 1 (Sorts.hash s)
+  | Const_ind i -> combinesmall 2 (ind_hash i)
+  | Const_proj p -> combinesmall 3 (Constant.hash p)
+  | Const_b0 t -> combinesmall 4 (Int.hash t)
+  | Const_bn (t, a) ->
+    let fold h c = combine h (hash_structured_constant c) in
+    let h = Array.fold_left fold 0 a in
+    combinesmall 5 (combine (Int.hash t) h)
+  | Const_univ_level l -> combinesmall 6 (Univ.Level.hash l)
+  | Const_type u -> combinesmall 7 (Univ.Universe.hash u)
+
+let eq_annot_switch asw1 asw2 =
+  let eq_ci ci1 ci2 =
+    eq_ind ci1.ci_ind ci2.ci_ind &&
+    Int.equal ci1.ci_npar ci2.ci_npar &&
+    CArray.equal Int.equal ci1.ci_cstr_ndecls ci2.ci_cstr_ndecls
+  in
+  let eq_rlc (i1, j1) (i2, j2) = Int.equal i1 i2 && Int.equal j1 j2 in
+  eq_ci asw1.ci asw2.ci &&
+  CArray.equal eq_rlc asw1.rtbl asw2.rtbl &&
+  (asw1.tailcall : bool) == asw2.tailcall
+
+let hash_annot_switch asw =
+  let open Hashset.Combine in
+  let h1 = Constr.case_info_hash asw.ci in
+  let h2 = Array.fold_left (fun h (t, i) -> combine3 h t i) 0 asw.rtbl in
+  let h3 = if asw.tailcall then 1 else 0 in
+  combine3 h1 h2 h3
+
 module Label =
   struct
     type t = int
@@ -74,7 +123,7 @@ type instruction =
   | Kclosurerec of int * int * Label.t array * Label.t array
   | Kclosurecofix of int * int * Label.t array * Label.t array
                    (* nb fv, init, lbl types, lbl bodies *)
-  | Kgetglobal of constant
+  | Kgetglobal of Constant.t
   | Kconst of structured_constant
   | Kmakeblock of int * tag
   | Kmakeprod
@@ -186,14 +235,15 @@ open Pp
 open Util
 
 let pp_sort s =
-  match family_of_sort s with
+  let open Sorts in
+  match family s with
   | InSet -> str "Set"
   | InProp -> str "Prop"
   | InType -> str "Type"
 
 let rec pp_struct_const = function
   | Const_sorts s -> pp_sort s
-  | Const_ind (mind, i) -> pr_mind mind ++ str"#" ++ int i
+  | Const_ind (mind, i) -> MutInd.print mind ++ str"#" ++ int i
   | Const_proj p -> Constant.print p
   | Const_b0 i -> int i
   | Const_bn (i,t) ->
@@ -241,7 +291,7 @@ let rec pp_instr i =
 	     prlist_with_sep spc pp_lbl (Array.to_list lblt) ++
 	     str " bodies = " ++
 	     prlist_with_sep spc pp_lbl (Array.to_list lblb))
-  | Kgetglobal idu -> str "getglobal " ++ pr_con idu
+  | Kgetglobal idu -> str "getglobal " ++ Constant.print idu
   | Kconst sc ->
       str "const " ++ pp_struct_const sc
   | Kmakeblock(n, m) ->
@@ -300,16 +350,3 @@ and pp_bytecodes c =
       pp_bytecodes l1 ++ pp_bytecodes l2 ++  pp_bytecodes c
   | i :: c ->
       pp_instr i ++ fnl () ++ pp_bytecodes c
-
-(*spiwack: moved this type in this file  because I needed it for
-  retroknowledge which can't depend from cbytegen *)
-type block =
-  | Bconstr of constr
-  | Bstrconst of structured_constant
-  | Bmakeblock of int * block array
-  | Bconstruct_app of int * int * int * block array
-                  (* tag , nparams, arity *)
-  | Bspecial of (comp_env -> block array -> int -> bytecodes -> bytecodes) * block array
-                (* spiwack: compilation given by a function *)
-                (* compilation function (see get_vm_constant_dynamic_info in
-                   retroknowledge.mli for more info) , argument array  *)
diff --git a/kernel/cbytecodes.mli b/kernel/cbytecodes.mli
index 718917ab3..c8fbb27a9 100644
--- a/kernel/cbytecodes.mli
+++ b/kernel/cbytecodes.mli
@@ -9,7 +9,7 @@
 (* $Id$ *)
 
 open Names
-open Term
+open Constr
 
 type tag = int
 
@@ -26,13 +26,13 @@ val cofix_evaluated_tag : tag
 val last_variant_tag : tag
 
 type structured_constant =
-  | Const_sorts of sorts
+  | Const_sorts of Sorts.t
   | Const_ind of inductive
   | Const_proj of Constant.t
   | Const_b0 of tag
   | Const_bn of tag * structured_constant array
-  | Const_univ_level of Univ.universe_level
-  | Const_type of Univ.universe
+  | Const_univ_level of Univ.Level.t
+  | Const_type of Univ.Universe.t
 
 val pp_struct_const : structured_constant -> Pp.t
 
@@ -41,6 +41,12 @@ type reloc_table = (tag * int) array
 type annot_switch =
    {ci : case_info; rtbl : reloc_table; tailcall : bool; max_stack_size : int}
 
+val eq_structured_constant : structured_constant -> structured_constant -> bool
+val hash_structured_constant : structured_constant -> int
+
+val eq_annot_switch : annot_switch -> annot_switch -> bool
+val hash_annot_switch : annot_switch -> int
+
 module Label :
   sig
     type t = int
@@ -69,7 +75,7 @@ type instruction =
                    (** nb fv, init, lbl types, lbl bodies *)
   | Kclosurecofix of int * int * Label.t array * Label.t array
                    (** nb fv, init, lbl types, lbl bodies *)
-  | Kgetglobal of constant
+  | Kgetglobal of Constant.t
   | Kconst of structured_constant
   | Kmakeblock of (* size: *) int * tag (** allocate an ocaml block. Index 0
                                          ** is accu, all others are popped from
@@ -165,14 +171,3 @@ type comp_env = {
 
 val pp_bytecodes : bytecodes -> Pp.t
 val pp_fv_elem : fv_elem -> Pp.t
-
-(*spiwack: moved this here because I needed it for retroknowledge *)
-type block =
-  | Bconstr of constr
-  | Bstrconst of structured_constant
-  | Bmakeblock of int * block array
-  | Bconstruct_app of int * int * int * block array
-                  (** tag , nparams, arity *)
-  | Bspecial of (comp_env -> block array -> int -> bytecodes -> bytecodes) * block array
-                (** compilation function (see get_vm_constant_dynamic_info in
-                   retroknowledge.mli for more info) , argument array  *)
diff --git a/kernel/cbytegen.ml b/kernel/cbytegen.ml
index d63fcffa2..3104d5751 100644
--- a/kernel/cbytegen.ml
+++ b/kernel/cbytegen.ml
@@ -14,7 +14,9 @@ open Util
 open Names
 open Cbytecodes
 open Cemitcodes
-open Term
+open Cinstr
+open Clambda
+open Constr
 open Declarations
 open Pre_env
 
@@ -96,7 +98,7 @@ module Config = struct
   let stack_safety_margin = 15
 end
 
-type argument = ArgConstr of Constr.t | ArgUniv of Univ.Level.t
+type argument = ArgLambda of lambda | ArgUniv of Univ.Level.t
 
 let empty_fv = { size= 0;  fv_rev = []; fv_fwd = FvMap.empty }
 let push_fv d e = {
@@ -356,13 +358,6 @@ let cont_cofix arity =
     Kreturn (arity+2) ]
 
 
-(*i Global environment *)
-
-let global_env = ref empty_env
-
-let set_global_env env = global_env := env
-
-
 (* Code of closures *)
 let fun_code = ref []
 
@@ -370,31 +365,8 @@ let init_fun_code () = fun_code := []
 
 (* Compilation of constructors and inductive types *)
 
-
-(* Limitation due to OCaml's representation of non-constant
-  constructors: limited to 245 + 1 (0 tag) cases. *)
-
-exception TooLargeInductive of Id.t
-
-let max_nb_const = 0x1000000 
-let max_nb_block = 0x1000000 + last_variant_tag - 1
-
-let str_max_constructors = 
-  Format.sprintf 
-    " which has more than %i constant constructors or more than %i non-constant constructors" max_nb_const max_nb_block
-
-let check_compilable ib = 
-  
-  if not (ib.mind_nb_args <= max_nb_block && ib.mind_nb_constant <= max_nb_const) then 
-    raise (TooLargeInductive ib.mind_typename)
-
 (* Inv: arity > 0 *)
 
-let const_bn tag args = 
-  if tag < last_variant_tag then Const_bn(tag, args)
-  else
-    Const_bn(last_variant_tag, Array.append [|Const_b0 (tag - last_variant_tag) |] args)
-
 (*
 If [tag] hits the OCaml limitation for non constant constructors, we switch to
 another representation for the remaining constructors:
@@ -415,126 +387,9 @@ let code_makeblock ~stack_size ~arity ~tag cont =
     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 =
-      add_pop nparams
-      (if Int.equal arity 0 then
-	[Kconst (Const_b0 tag); Kreturn 0]
-       else if tag < last_variant_tag then
-         [Kacc 0; Kpop 1; Kmakeblock(arity, 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
-
-let get_strcst = function
-  | Bstrconst sc -> sc
-  | _ -> raise Not_found
-
-let rec str_const c =
-  match kind_of_term c with
-  | Sort s -> Bstrconst (Const_sorts s)
-  | Cast(c,_,_) -> str_const c
-  | App(f,args) ->
-      begin
-	match kind_of_term f with
-	| Construct(((kn,j),i),u) -> 
-            begin
-	    let oib = lookup_mind kn !global_env in
-	    let oip = oib.mind_packets.(j) in
-	    let () = check_compilable oip in
-	    let tag,arity = oip.mind_reloc_tbl.(i-1) in
-	    let nparams = oib.mind_nparams in
-	    if Int.equal (nparams + arity) (Array.length args) then
-              (* spiwack: *)
-              (* 1/ tries to compile the constructor in an optimal way,
-                    it is supposed to work only if the arguments are
-                    all fully constructed, fails with Cbytecodes.NotClosed.
-                    it can also raise Not_found when there is no special
-                    treatment for this constructor
-                    for instance: tries to to compile an integer of the
-                        form I31 D1 D2 ... D31 to [D1D2...D31] as
-                        a processor number (a caml number actually) *)
-              try
-		try
-		  Bstrconst (Retroknowledge.get_vm_constant_static_info
-                                              (!global_env).retroknowledge
-                                              f args)
-                with NotClosed ->
-		  (* 2/ if the arguments are not all closed (this is
-                        expectingly (and it is currently the case) the only
-                        reason why this exception is raised) tries to
-                        give a clever, run-time behavior to the constructor.
-                        Raises Not_found if there is no special treatment
-                        for this integer.
-                        this is done in a lazy fashion, using the constructor
-                        Bspecial because it needs to know the continuation
-                        and such, which can't be done at this time.
-                        for instance, for int31: if one of the digit is
-                            not closed, it's not impossible that the number
-                            gets fully instanciated at run-time, thus to ensure
-                            uniqueness of the representation in the vm
-                            it is necessary to try and build a caml integer
-                            during the execution *)
-		  let rargs = Array.sub args nparams arity in
-		  let b_args = Array.map str_const rargs in
-		  Bspecial ((Retroknowledge.get_vm_constant_dynamic_info
-                                           (!global_env).retroknowledge
-                                           f),
-                           b_args)
-              with Not_found ->
-		(* 3/ if no special behavior is available, then the compiler
-		      falls back to the normal behavior *)
-		if Int.equal arity 0 then Bstrconst(Const_b0 tag)
-		else
-		  let rargs = Array.sub args nparams arity in
-		  let b_args = Array.map str_const rargs in
-		  try
-		    let sc_args = Array.map get_strcst b_args in
-		    Bstrconst(const_bn tag sc_args)
-		  with Not_found ->
-		    Bmakeblock(tag,b_args)
-	    else
-              let b_args = Array.map str_const args in
-	     (* spiwack: tries first to apply the run-time compilation
-                behavior of the constructor, as in 2/ above *)
-	      try
-		Bspecial ((Retroknowledge.get_vm_constant_dynamic_info
-                                           (!global_env).retroknowledge
-                                           f),
-                         b_args)
-	      with Not_found ->
-	        Bconstruct_app(tag, nparams, arity, b_args)
-              end
-	| _ -> Bconstr c
-      end
-  | Ind (ind,u) when Univ.Instance.is_empty u ->
-    Bstrconst (Const_ind ind)
-  | Construct (((kn,j),i),_) ->
-      begin
-      (* spiwack: tries first to apply the run-time compilation
-           behavior of the constructor, as in 2/ above *)
-      try
-	Bspecial ((Retroknowledge.get_vm_constant_dynamic_info
-                                           (!global_env).retroknowledge
-                                           c),
-                         [| |])
-      with Not_found ->
-	let oib = lookup_mind kn !global_env in
-	let oip = oib.mind_packets.(j) in
-	let () = check_compilable oip in
-	let num,arity = oip.mind_reloc_tbl.(i-1) in
-	let nparams = oib.mind_nparams in
-	if Int.equal (nparams + arity) 0 then Bstrconst(Const_b0 num)
-	else Bconstruct_app(num,nparams,arity,[||])
-      end
-  | _ -> Bconstr c
+let compile_structured_constant reloc sc sz cont =
+  set_max_stack_size sz;
+  Kconst sc :: cont
 
 (* compiling application *)
 let comp_args comp_expr reloc args sz cont =
@@ -545,9 +400,10 @@ 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
+  if Int.equal nargs 0 then comp_fun reloc f sz cont
+  else
   match is_tailcall cont with
   | Some k ->
       comp_args comp_arg reloc args sz
@@ -593,112 +449,105 @@ let rec get_alias env kn =
 	| BCalias kn' -> get_alias env kn'
 	| _ -> kn)
 
+(* spiwack: additional function which allow different part of compilation of the
+      31-bit integers *)
+
+let make_areconst n else_lbl cont =
+  if n <= 0 then
+    cont
+  else
+    Kareconst (n, else_lbl)::cont
+
 (* sz is the size of the local stack *)
-let rec compile_constr reloc c sz cont =
+let rec compile_lam env reloc lam 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"
-  | Proj (p,c) ->
-     let kn = Projection.constant p in
-     let cb = lookup_constant kn !global_env in
-     let pb = Option.get cb.const_proj in
-     let n = pb.proj_arg in
-     compile_constr reloc c sz (Kproj (n,kn) :: cont)
-
-  | Cast(c,_,_) -> compile_constr reloc c sz cont
-
-  | Rel i -> pos_rel i reloc sz :: cont
-  | Var id -> pos_named id reloc :: cont
-  | Const (kn,u) -> compile_const reloc kn u [||] sz cont
-  | Ind (ind,u) ->
-     let bcst = Bstrconst (Const_ind ind) in
+  match lam with
+  | Lrel(_, i) -> pos_rel i reloc sz :: cont
+
+  | Lval v -> compile_structured_constant reloc v sz cont
+
+  | Lproj (n,kn,arg) ->
+     compile_lam env reloc arg sz (Kproj (n,kn) :: cont)
+
+  | Lvar id -> pos_named id reloc :: cont
+
+  | Lconst (kn,u) -> compile_constant env reloc kn u [||] sz cont
+
+  | Lind (ind,u) ->
     if Univ.Instance.is_empty u then
-      compile_str_cst reloc bcst sz cont
-    else
-      comp_app compile_str_cst compile_universe reloc
-	   bcst
-	   (Univ.Instance.to_array u)
-	   sz
-	   cont
-  | Sort (Prop _) | Construct _ ->
-      compile_str_cst reloc (str_const c) sz cont
-  | Sort (Type u) ->
+      compile_structured_constant reloc (Const_ind ind) sz cont
+    else comp_app compile_structured_constant compile_universe reloc
+        (Const_ind ind) (Univ.Instance.to_array u) sz cont
+
+  | Lsort (Sorts.Prop _ as s) ->
+    compile_structured_constant reloc (Const_sorts s) sz cont
+  | Lsort (Sorts.Type u) ->
      (* We separate global and local universes in [u]. The former will be part
         of the structured constant, while the later (if any) will be applied as
         arguments. *)
      let open Univ in begin
-      let levels = Universe.levels u in
-      let global_levels =
-	LSet.filter (fun x -> Level.var_index x = None) levels
-      in
-      let local_levels =
-	List.map_filter (fun x -> Level.var_index x)
-	  (LSet.elements levels)
-      in
+      let u,s = Universe.compact u in
       (* We assume that [Universe.type0m] is a neutral element for [Universe.sup] *)
-      let uglob =
-	LSet.fold (fun lvl u -> Universe.sup u (Universe.make lvl)) global_levels Universe.type0m
-      in
-      if local_levels = [] then
-	compile_str_cst reloc (Bstrconst (Const_sorts (Type uglob))) sz cont
+      if List.is_empty s then
+        compile_structured_constant reloc (Const_sorts (Sorts.Type u)) 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
-	  (Bstrconst (Const_type u)) (Array.of_list local_levels) sz cont
+        comp_app compile_structured_constant compile_get_univ reloc
+          (Const_type u) (Array.of_list s) sz cont
     end
-  | LetIn(_,xb,_,body) ->
-      compile_constr reloc xb sz
-	(Kpush ::
-	(compile_constr (push_local sz reloc) body (sz+1) (add_pop 1 cont)))
-  | Prod(id,dom,codom) ->
-      let cont1 =
-	Kpush :: compile_constr reloc dom (sz+1) (Kmakeprod :: cont) in
-      compile_constr reloc (mkLambda(id,dom,codom)) sz cont1
-  | Lambda _ ->
-      let params, body = decompose_lam c in
-      let arity = List.length params in
-      let r_fun = comp_env_fun arity in
-      let lbl_fun = Label.create() in
-      let cont_fun =
-        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)
-
-  | App(f,args) ->
-      begin
-	match kind_of_term f with
-	| Construct _ -> compile_str_cst reloc (str_const c) sz cont
-        | Const (kn,u) -> compile_const reloc kn u args sz cont
-	| _ -> comp_app compile_constr compile_constr reloc f args sz cont
-      end
-  | Fix ((rec_args,init),(_,type_bodies,rec_bodies)) ->
-      let ndef = Array.length type_bodies in
+
+  | Llet (id,def,body) ->
+      compile_lam env reloc def sz
+        (Kpush ::
+         compile_lam env (push_local sz reloc) body (sz+1) (add_pop 1 cont))
+
+  | Lprod (dom,codom) ->
+     let cont1 =
+       Kpush :: compile_lam env reloc dom (sz+1) (Kmakeprod :: cont) in
+     compile_lam env reloc codom sz cont1
+
+  | Llam (ids,body) ->
+     let arity = Array.length ids in
+     let r_fun = comp_env_fun arity in
+     let lbl_fun = Label.create() in
+     let cont_fun =
+       ensure_stack_capacity (compile_lam env 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)
+
+  | Lapp (f, args) ->
+    begin match f with
+    | Lconst (kn,u) -> compile_constant env reloc kn u args sz cont
+    | _ -> comp_app (compile_lam env) (compile_lam env) reloc f args sz cont
+    end
+
+  | Lfix ((rec_args, init), (decl, types, bodies)) ->
+      let ndef = Array.length types in
       let rfv = ref empty_fv in
       let lbl_types = Array.make ndef Label.no in
       let lbl_bodies = Array.make ndef Label.no in
-      (* Compilation des types *)
+      (* Compiling types *)
       let env_type = comp_env_fix_type rfv in
       for i = 0 to ndef - 1 do
         let fcode =
-          ensure_stack_capacity (compile_constr env_type type_bodies.(i) 0) [Kstop]
+          ensure_stack_capacity (compile_lam env env_type types.(i) 0) [Kstop]
         in
-	let lbl,fcode = label_code fcode in
-	lbl_types.(i) <- lbl;
+        let lbl,fcode = label_code fcode in
+        lbl_types.(i) <- lbl;
 	fun_code := [Ksequence(fcode,!fun_code)]
       done;
       (* Compiling bodies *)
       for i = 0 to ndef - 1 do
-	let params,body = decompose_lam rec_bodies.(i) in
-	let arity = List.length params in
+        let params,body = decompose_Llam bodies.(i) in
+        let arity = Array.length params in
 	let env_body = comp_env_fix ndef i arity rfv in
-	let cont1 =
-	  ensure_stack_capacity (compile_constr env_body body arity) [Kreturn arity]
+        let cont1 =
+          ensure_stack_capacity (compile_lam env env_body body arity) [Kreturn arity]
         in
 	let lbl = Label.create () in
 	lbl_bodies.(i) <- lbl;
@@ -709,8 +558,9 @@ let rec compile_constr reloc c sz cont =
       compile_fv reloc fv.fv_rev sz
 	(Kclosurerec(fv.size,init,lbl_types,lbl_bodies) :: cont)
 
-  | CoFix(init,(_,type_bodies,rec_bodies)) ->
-      let ndef = Array.length type_bodies in
+
+  | Lcofix(init, (decl,types,bodies)) ->
+      let ndef = Array.length types in
       let lbl_types = Array.make ndef Label.no in
       let lbl_bodies = Array.make ndef Label.no in
       (* Compiling types *)
@@ -718,22 +568,22 @@ let rec compile_constr reloc c sz cont =
       let env_type = comp_env_cofix_type ndef rfv in
       for i = 0 to ndef - 1 do
         let fcode =
-          ensure_stack_capacity (compile_constr env_type type_bodies.(i) 0) [Kstop]
+          ensure_stack_capacity (compile_lam env env_type types.(i) 0) [Kstop]
         in
-	let lbl,fcode = label_code fcode in
-	lbl_types.(i) <- lbl;
+        let lbl,fcode = label_code fcode in
+        lbl_types.(i) <- lbl;
 	fun_code := [Ksequence(fcode,!fun_code)]
       done;
       (* Compiling bodies *)
       for i = 0 to ndef - 1 do
-	let params,body = decompose_lam rec_bodies.(i) in
-	let arity = List.length params in
+        let params,body = decompose_Llam bodies.(i) in
+        let arity = Array.length params in
 	let env_body = comp_env_cofix ndef arity rfv in
 	let lbl = Label.create () 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)
+          compile_lam env env_body body (arity+1) (cont_cofix arity)
         in
 	let cont = ensure_stack_capacity comp arity in
 	lbl_bodies.(i) <- lbl;
@@ -744,33 +594,34 @@ let rec compile_constr reloc c sz cont =
       compile_fv reloc fv.fv_rev sz
 	(Kclosurecofix(fv.size, init, lbl_types, lbl_bodies) :: cont)
 
-  | Case(ci,t,a,branchs) ->
+
+  | Lcase(ci,rtbl,t,a,branches) ->
       let ind = ci.ci_ind in
-      let mib = lookup_mind (fst ind) !global_env in
+      let mib = lookup_mind (fst ind) env in
       let oib = mib.mind_packets.(snd ind) in
-      let () = check_compilable oib in
-      let tbl = oib.mind_reloc_tbl in
       let lbl_consts = Array.make oib.mind_nb_constant Label.no in
       let nallblock = oib.mind_nb_args + 1 in (* +1 : accumulate *)
+      let nconst = Array.length branches.constant_branches in
       let nblock = min nallblock (last_variant_tag + 1) in
       let lbl_blocks = Array.make nblock Label.no in
       let neblock = max 0 (nallblock - last_variant_tag) in
       let lbl_eblocks = Array.make neblock Label.no in 
-      let branch1,cont = make_branch cont in
-      (* Compiling return type *)
+      let branch1, cont = make_branch cont in
+      (* Compilation of the return type *)
       let fcode =
-        ensure_stack_capacity (compile_constr reloc t sz) [Kpop sz; Kstop]
+        ensure_stack_capacity (compile_lam env reloc t sz) [Kpop sz; Kstop]
       in
       let lbl_typ,fcode = label_code fcode in
       fun_code := [Ksequence(fcode,!fun_code)];
-      (* Compiling branches *)
+      (* Compilation of the branches *)
       let lbl_sw = Label.create () in
       let sz_b,branch,is_tailcall =
-	match branch1 with
-	| Kreturn k ->
-	  assert (Int.equal k sz) ;
-	  sz, branch1, true
-	| _ -> sz+3, Kjump, false
+        match branch1 with
+        | Kreturn k ->
+          assert (Int.equal k sz) ;
+          sz, branch1, true
+        | Kbranch _ -> sz+3, Kjump, false
+        | _ -> assert false
       in
 
       let c = ref cont in
@@ -781,29 +632,26 @@ let rec compile_constr reloc c sz cont =
             Kpush :: Kfield 0 :: Kswitch(lbl_eblocks, [||]) :: !c) in
         lbl_blocks.(last_variant_tag) <- lbl_b;
         c := code_b
-      end;  
-      
-      (* Compiling regular constructor branches *)
-      for i = 0 to Array.length tbl - 1 do
-	let tag, arity = tbl.(i) in
-	if Int.equal arity 0 then
-	  let lbl_b,code_b =
-	    label_code(compile_constr reloc branchs.(i) sz_b (branch :: !c)) in
-	  lbl_consts.(tag) <- lbl_b;
-	  c := code_b
-	else
-	  let args, body = decompose_lam branchs.(i) in
-	  let nargs = List.length args in
-         
-          let code_b =  
-            if Int.equal nargs arity then
-	      compile_constr (push_param arity sz_b reloc)
-		body (sz_b+arity) (add_pop arity (branch :: !c))
-	    else
-	      let sz_appterm = if is_tailcall then sz_b + arity else arity in
-	      compile_constr reloc branchs.(i) (sz_b+arity)
-		(Kappterm(arity,sz_appterm) :: !c) in
-          let code_b = 
+      end;
+
+      (* Compilation of constant branches *)
+      for i = nconst - 1 downto 0 do
+        let aux =
+          compile_lam env reloc branches.constant_branches.(i) sz_b (branch::!c)
+        in
+        let lbl_b,code_b = label_code aux in
+        lbl_consts.(i) <- lbl_b;
+        c := code_b
+      done;
+      (* -1 for accu branch *)
+      for i = nallblock - 2 downto 0 do
+        let tag = i + 1 in
+        let (ids, body) = branches.nonconstant_branches.(i) in
+        let arity = Array.length ids in
+        let code_b =
+          compile_lam env (push_param arity sz_b reloc)
+            body (sz_b+arity) (add_pop arity (branch::!c)) in
+        let code_b =
             if tag < last_variant_tag then begin
                 set_max_stack_size (sz_b + arity);
                 Kpushfields arity :: code_b
@@ -812,15 +660,15 @@ let rec compile_constr reloc c sz cont =
                 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
+        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
+        c := code_b
       done;
 
       let annot =
-        {ci = ci; rtbl = tbl; tailcall = is_tailcall;
+        {ci = ci; rtbl = rtbl; tailcall = is_tailcall;
          max_stack_size = !max_stack_size - sz}
       in
 
@@ -839,38 +687,50 @@ let rec compile_constr reloc c sz cont =
         | Kbranch lbl -> Kpush_retaddr lbl ::  !c
 	| _ -> !c
       in
-      compile_constr reloc a sz
-      (try
-	let entry = mkInd ind in
-	Retroknowledge.get_vm_before_match_info (!global_env).retroknowledge
-	                                       entry code_sw
-      with Not_found ->
-	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 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
-      else
-	comp_app
-	  (fun _ _ _ cont -> code_construct tag nparams arity cont)
-	  compile_str_cst reloc () args sz cont
-  | Bspecial (comp_fx, args) -> comp_fx reloc args sz cont
+      compile_lam env reloc a sz code_sw
+
+  | Lmakeblock (tag,args) ->
+    let arity = Array.length args in
+    let cont = code_makeblock ~stack_size:(sz+arity-1) ~arity ~tag cont in
+    comp_args (compile_lam env) reloc args sz cont
+
+  | Lprim (kn, ar, op, args) ->
+    op_compilation env ar op kn reloc args sz cont
+
+  | Luint v ->
+     (match v with
+     | UintVal i -> compile_structured_constant reloc (Const_b0 (Uint31.to_int i)) sz cont
+     | UintDigits ds ->
+       let nargs = Array.length ds in
+       if Int.equal nargs 31 then
+         let (escape,labeled_cont) = make_branch cont in
+         let else_lbl = Label.create() in
+         comp_args (compile_lam env) reloc ds sz
+           ( Kisconst else_lbl::Kareconst(30,else_lbl)::Kcompint31::escape::Klabel else_lbl::Kmakeblock(31, 1)::labeled_cont)
+       else
+         let code_construct cont = (* spiwack: variant of the global code_construct
+                                             which handles dynamic compilation of
+                                             integers *)
+           let f_cont =
+             let else_lbl = Label.create () in
+             [Kacc 0; Kpop 1; Kisconst else_lbl; Kareconst(30,else_lbl);
+              Kcompint31; Kreturn 0; Klabel else_lbl; Kmakeblock(31, 1); Kreturn 0]
+           in
+           let lbl = Label.create() in
+           fun_code := [Ksequence (add_grab 31 lbl f_cont,!fun_code)];
+           Kclosure(lbl,0) :: cont
+         in
+         comp_app (fun _ _ _ cont -> code_construct cont)
+           (compile_lam env) reloc () ds sz cont
+     | UintDecomp t ->
+       let escape_lbl, labeled_cont = label_code cont in
+       compile_lam env  reloc t sz ((Kisconst escape_lbl)::Kdecompint31::labeled_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
   else
@@ -880,41 +740,67 @@ and compile_get_global reloc (kn,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
+  | None -> compile_structured_constant reloc (Const_univ_level uni) sz cont
   | Some idx -> pos_universe_var idx reloc sz :: cont
 
-and compile_const reloc kn u args sz cont =
+and compile_constant env reloc kn u args sz cont =
   set_max_stack_size sz;
+  if Univ.Instance.is_empty u then
+    (* normal compilation *)
+    comp_app (fun _ _ sz cont ->
+        compile_get_global reloc (kn,u) sz cont)
+      (compile_lam env) reloc () args sz cont
+  else
+    let compile_arg reloc constr_or_uni sz cont =
+      match constr_or_uni with
+      | ArgLambda t -> compile_lam env reloc t sz cont
+      | ArgUniv uni -> compile_universe reloc uni sz cont
+    in
+    let u = Univ.Instance.to_array u in
+    let lu = Array.length u in
+    let all =
+      Array.init (lu + Array.length args)
+        (fun i -> if i < lu then ArgUniv u.(i) else ArgLambda args.(i-lu))
+    in
+    comp_app (fun _ _ _ cont -> Kgetglobal kn :: cont)
+      compile_arg reloc () all sz cont
+
+(*template for n-ary operation, invariant: n>=1,
+  the operations does the following :
+  1/ checks if all the arguments are constants (i.e. non-block values)
+  2/ if they are, uses the "op" instruction to execute
+  3/ if at least one is not, branches to the normal behavior:
+      Kgetglobal (get_alias !global_env kn) *)
+and op_compilation env n op =
+  let code_construct reloc kn sz cont =
+     let f_cont =
+         let else_lbl = Label.create () in
+         Kareconst(n, else_lbl):: Kacc 0:: Kpop 1::
+          op:: Kreturn 0:: Klabel else_lbl::
+         (* works as comp_app with nargs = n and tailcall cont [Kreturn 0]*)
+          compile_get_global reloc kn sz (
+            Kappterm(n, n):: []) (* = discard_dead_code [Kreturn 0] *)
+     in
+     let lbl = Label.create () in
+     fun_code := [Ksequence (add_grab n lbl f_cont, !fun_code)];
+     Kclosure(lbl, 0)::cont
+  in
+  fun kn reloc args sz cont ->
   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
-              falls back on its normal behavior *)
-  try
-    Retroknowledge.get_vm_compiling_info (!global_env).retroknowledge
-                  (mkConstU (kn,u)) reloc args sz cont
-  with Not_found ->
-    if Int.equal nargs 0 then
-      compile_get_global reloc (kn,u) sz cont
-    else
-      if Univ.Instance.is_empty u then
-        (* normal compilation *)
-        comp_app (fun _ _ sz cont ->
-            compile_get_global reloc (kn,u) sz cont)
-          compile_constr reloc () args sz cont
-      else
-        let compile_arg reloc constr_or_uni sz cont =
-          match constr_or_uni with
-          | ArgConstr cst -> compile_constr reloc cst sz cont
-          | ArgUniv uni -> compile_universe reloc uni sz cont
-        in
-	let u = Univ.Instance.to_array u in
-	let lu = Array.length u in
-	let all =
-	  Array.init (lu + Array.length args) 
-	    (fun i -> if i < lu then ArgUniv u.(i) else ArgConstr args.(i-lu))
-	in
-        comp_app (fun _ _ _ cont -> Kgetglobal kn :: cont)
-          compile_arg reloc () all sz cont
+  if Int.equal nargs n then (*if it is a fully applied addition*)
+    let (escape, labeled_cont) = make_branch cont in
+    let else_lbl = Label.create () in
+    assert (n < 4);
+    comp_args (compile_lam env) reloc args sz
+      (Kisconst else_lbl::(make_areconst (n-1) else_lbl
+         (*Kaddint31::escape::Klabel else_lbl::Kpush::*)
+         (op::escape::Klabel else_lbl::Kpush::
+         (* works as comp_app with nargs < 4 and non-tailcall cont*)
+         compile_get_global reloc kn (sz+n) (Kapply n::labeled_cont))))
+  else
+    comp_app (fun reloc _ sz cont -> code_construct reloc kn sz cont)
+      (compile_lam env) reloc () args sz cont
+
 
 let is_univ_copy max u =
   let u = Univ.Instance.to_array u in
@@ -937,33 +823,29 @@ let dump_bytecodes init code fvs =
      prlist_with_sep (fun () -> str "; ") pp_fv_elem fvs ++
      fnl ())
 
-let compile fail_on_error ?universes:(universes=0) env c =
-  set_global_env env;
+let compile ~fail_on_error ?universes:(universes=0) env c =
   init_fun_code ();
   Label.reset_label_counter ();
   let cont = [Kstop] in
   try
     let reloc, init_code =
       if Int.equal universes 0 then
+        let lam = lambda_of_constr ~optimize:true env c in
         let reloc = empty_comp_env () in
-        reloc, ensure_stack_capacity (compile_constr reloc c 0) cont
+        reloc, ensure_stack_capacity (compile_lam env reloc lam 0) cont
       else
         (* We are going to generate a lambda, but merge the universe closure
          * with the function closure if it exists.
          *)
+        let lam = lambda_of_constr ~optimize:true env c in
+        let params, body = decompose_Llam lam in
+        let arity = Array.length params in
         let reloc = empty_comp_env () in
-        let arity , body =
-          match kind_of_term c with
-          | Lambda _ ->
-            let params, body = decompose_lam c in
-            List.length params , body
-          | _ -> 0 , c
-        in
         let full_arity = arity + universes in
         let r_fun = comp_env_fun ~univs:universes arity in
         let lbl_fun = Label.create () in
         let cont_fun =
-          ensure_stack_capacity (compile_constr r_fun body full_arity)
+          ensure_stack_capacity (compile_lam env r_fun body full_arity)
                          [Kreturn full_arity]
         in
         fun_code := [Ksequence(add_grab full_arity lbl_fun cont_fun,!fun_code)];
@@ -978,15 +860,12 @@ let compile fail_on_error ?universes:(universes=0) env c =
     (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 ->
+  with TooLargeInductive msg ->
     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));
-       None)
+        (fun x -> Feedback.msg_warning x) in
+    fn msg; None
 
-let compile_constant_body fail_on_error env univs = function
+let compile_constant_body ~fail_on_error env univs = function
   | Undef _ | OpaqueDef _ -> Some BCconstant
   | Def sb ->
       let body = Mod_subst.force_constr sb in
@@ -995,70 +874,18 @@ let compile_constant_body fail_on_error env univs = function
         | Monomorphic_const _ -> 0
         | Polymorphic_const univ -> Univ.AUContext.size univ
       in
-      match kind_of_term body with
+      match kind body with
 	| Const (kn',u) when is_univ_copy instance_size u ->
 	    (* we use the canonical name of the constant*)
-	    let con= constant_of_kn (canonical_con kn') in
+	    let con= Constant.make1 (Constant.canonical kn') in
 	      Some (BCalias (get_alias env con))
 	| _ ->
-	    let res = compile fail_on_error ~universes:instance_size env body in
+            let res = compile ~fail_on_error ~universes:instance_size env body in
 	      Option.map (fun x -> BCdefined (to_memory x)) res
 
 (* Shortcut of the previous function used during module strengthening *)
 
-let compile_alias kn = BCalias (constant_of_kn (canonical_con kn))
-
-(* spiwack: additional function which allow different part of compilation of the
-      31-bit integers *)
-
-let make_areconst n else_lbl cont =
-  if n <= 0 then
-    cont
-  else
-    Kareconst (n, else_lbl)::cont
-
-
-(* try to compile int31 as a const_b0. Succeed if all the arguments are closed
-   fails otherwise by raising NotClosed*)
-let compile_structured_int31 fc args =
-  if not fc then raise Not_found else
-  Const_b0
-    (Array.fold_left
-       (fun temp_i -> fun t -> match kind_of_term t with
-          | Construct ((_,d),_) -> 2*temp_i+d-1
-          | _ -> raise NotClosed)
-       0 args
-    )
-
-(* this function is used for the compilation of the constructor of
-   the int31, it is used when it appears not fully applied, or
-   applied to at least one non-closed digit *)
-let dynamic_int31_compilation fc reloc args sz cont =
-  if not fc then raise Not_found else
-    let nargs = Array.length args in
-      if Int.equal nargs 31 then
-	let (escape,labeled_cont) = make_branch cont in
-	let else_lbl = Label.create() in
-	  comp_args compile_str_cst reloc args sz
-            ( Kisconst else_lbl::Kareconst(30,else_lbl)::Kcompint31::escape::Klabel else_lbl::Kmakeblock(31, 1)::labeled_cont)
-      else
-	let code_construct cont = (* spiwack: variant of the global code_construct
-                                     which handles dynamic compilation of
-                                     integers *)
-          let f_cont =
-            let else_lbl = Label.create () in
-	      [Kacc 0; Kpop 1; Kisconst else_lbl; Kareconst(30,else_lbl);
-               Kcompint31; Kreturn 0; Klabel else_lbl; Kmakeblock(31, 1); Kreturn 0]
-	  in
-	  let lbl = Label.create() in
-	    fun_code := [Ksequence (add_grab 31 lbl f_cont,!fun_code)];
-	    Kclosure(lbl,0) :: cont
-	in
-	  if Int.equal nargs 0 then
-	    code_construct cont
-	  else
-	    comp_app (fun _ _ _ cont -> code_construct cont)
-              compile_str_cst reloc () args sz cont
+let compile_alias kn = BCalias (Constant.make1 (Constant.canonical kn))
 
 (*(* template compilation for 2ary operation, it probably possible
    to make a generic such function with arity abstracted *)
@@ -1097,47 +924,3 @@ let op2_compilation op =
     comp_app (fun _ _ _ cont -> code_construct normal cont)
       compile_constr reloc () args sz cont *)
 
-(*template for n-ary operation, invariant: n>=1,
-  the operations does the following :
-  1/ checks if all the arguments are constants (i.e. non-block values)
-  2/ if they are, uses the "op" instruction to execute
-  3/ if at least one is not, branches to the normal behavior:
-      Kgetglobal (get_alias !global_env kn) *)
-let op_compilation n op =
-  let code_construct reloc kn sz cont =
-     let f_cont =
-         let else_lbl = Label.create () in
-         Kareconst(n, else_lbl):: Kacc 0:: Kpop 1::
-          op:: Kreturn 0:: Klabel else_lbl::
-         (* works as comp_app with nargs = n and tailcall cont [Kreturn 0]*)
-          compile_get_global reloc kn sz (
-            Kappterm(n, n):: []) (* = discard_dead_code [Kreturn 0] *)
-     in
-     let lbl = Label.create () in
-     fun_code := [Ksequence (add_grab n lbl f_cont, !fun_code)];
-     Kclosure(lbl, 0)::cont
-  in
-  fun kn fc reloc args sz cont ->
-  if not fc then raise Not_found else
-  let nargs = Array.length args in
-  if Int.equal nargs n then (*if it is a fully applied addition*)
-    let (escape, labeled_cont) = make_branch cont in
-    let else_lbl = Label.create () in
-      comp_args compile_constr reloc args sz
-	(Kisconst else_lbl::(make_areconst (n-1) else_lbl
-           (*Kaddint31::escape::Klabel else_lbl::Kpush::*)
-           (op::escape::Klabel else_lbl::Kpush::
-           (* works as comp_app with nargs = n and non-tailcall cont*)
-           compile_get_global reloc kn sz (Kapply n::labeled_cont))))
-  else if Int.equal nargs 0 then
-    code_construct reloc kn sz cont
-  else
-    comp_app (fun reloc _ sz cont -> code_construct reloc kn sz cont)
-      compile_constr reloc () args sz cont
-
-let int31_escape_before_match fc cont =
-  if not fc then
-    raise Not_found
-  else
-    let escape_lbl, labeled_cont = label_code cont in
-      (Kisconst escape_lbl)::Kdecompint31::labeled_cont
diff --git a/kernel/cbytegen.mli b/kernel/cbytegen.mli
index 48c2e4533..99f2a3c01 100644
--- a/kernel/cbytegen.mli
+++ b/kernel/cbytegen.mli
@@ -1,42 +1,25 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
 open Cbytecodes
 open Cemitcodes
-open Term
+open Constr
 open Declarations
 open Pre_env
 
 (** Should only be used for monomorphic terms *)
-val compile : bool -> (* Fail on error with a nice user message, otherwise simply a warning *)
+val compile : fail_on_error:bool ->
 	      ?universes:int -> env -> constr -> (bytecodes * bytecodes * fv) option
 (** init, fun, fv *)
 
-val compile_constant_body : bool ->
+val compile_constant_body : fail_on_error:bool ->
 			    env -> constant_universes -> constant_def -> body_code option
 
 (** Shortcut of the previous function used during module strengthening *)
 
-val compile_alias : Names.constant -> body_code
-
-(** spiwack: this function contains the information needed to perform
-            the static compilation of int31 (trying and obtaining
-            a 31-bit integer in processor representation at compile time) *)
-val compile_structured_int31 : bool -> constr array ->
-                               structured_constant
-
-(** this function contains the information needed to perform
-        the dynamic compilation of int31 (trying and obtaining a
-        31-bit integer in processor representation at runtime when
-        it failed at compile time *)
-val dynamic_int31_compilation : bool -> comp_env ->
-                                block array ->
-                                int -> bytecodes -> bytecodes
-
-(*spiwack: template for the compilation n-ary operation, invariant: n>=1.
-           works as follow: checks if all the arguments are non-pointers
-           if they are applies the operation (second argument) if not
-           all of them are, returns to a coq definition (third argument) *)
-val op_compilation : int -> instruction -> pconstant -> bool -> comp_env ->
-                             constr array -> int -> bytecodes-> bytecodes
-
-(*spiwack: compiling function to insert dynamic decompilation before
-           matching integers (in case they are in processor representation) *)
-val int31_escape_before_match : bool -> bytecodes -> bytecodes
+val compile_alias : Names.Constant.t -> body_code
diff --git a/kernel/cemitcodes.ml b/kernel/cemitcodes.ml
index 092bcecc3..856b0b465 100644
--- a/kernel/cemitcodes.ml
+++ b/kernel/cemitcodes.ml
@@ -10,18 +10,51 @@
    machine, Oct 2004 *)
 (* Extension: Arnaud Spiwack (support for native arithmetic), May 2005 *)
 
+open Names
 open Term
 open Cbytecodes
 open Copcodes
 open Mod_subst
 
+type emitcodes = String.t
+
+external tcode_of_code : Bytes.t -> int -> Vmvalues.tcode = "coq_tcode_of_code"
+
 (* Relocation information *)
 type reloc_info =
   | Reloc_annot of annot_switch
   | Reloc_const of structured_constant
-  | Reloc_getglobal of Names.constant
-
-type patch = reloc_info * int
+  | Reloc_getglobal of Names.Constant.t
+
+let eq_reloc_info r1 r2 = match r1, r2 with
+| Reloc_annot sw1, Reloc_annot sw2 -> eq_annot_switch sw1 sw2
+| Reloc_annot _, _ -> false
+| Reloc_const c1, Reloc_const c2 -> eq_structured_constant c1 c2
+| Reloc_const _, _ -> false
+| Reloc_getglobal c1, Reloc_getglobal c2 -> Constant.equal c1 c2
+| Reloc_getglobal _, _ -> false
+
+let hash_reloc_info r =
+  let open Hashset.Combine in
+  match r with
+  | Reloc_annot sw -> combinesmall 1 (hash_annot_switch sw)
+  | Reloc_const c -> combinesmall 2 (hash_structured_constant c)
+  | Reloc_getglobal c -> combinesmall 3 (Constant.hash c)
+
+module RelocTable = Hashtbl.Make(struct
+  type t = reloc_info
+  let equal = eq_reloc_info
+  let hash = hash_reloc_info
+end)
+
+(** We use arrays for on-disk representation. On 32-bit machines, this means we
+    can only have a maximum amount of about 4.10^6 relocations, which seems
+    quite a lot, but potentially reachable if e.g. compiling big proofs. This
+    would prevent VM computing with these terms on 32-bit architectures. Maybe
+    we should use a more robust data structure? *)
+type patches = {
+  reloc_infos : (reloc_info * int array) array;
+}
 
 let patch_char4 buff pos c1 c2 c3 c4 = 
   Bytes.unsafe_set buff pos       c1;
@@ -29,40 +62,48 @@ let patch_char4 buff pos c1 c2 c3 c4 =
   Bytes.unsafe_set buff (pos + 2) c3;
   Bytes.unsafe_set buff (pos + 3) c4 
   
-let patch buff (pos, n) =
+let patch1 buff pos n =
   patch_char4 buff pos 
     (Char.unsafe_chr n) (Char.unsafe_chr (n asr 8))  (Char.unsafe_chr (n asr 16))
     (Char.unsafe_chr (n asr 24))
 
-(* val patch_int : emitcodes -> ((\*pos*\)int * int) list -> emitcodes *)
-let patch_int buff patches =
+let patch_int buff reloc =
   (* copy code *before* patching because of nested evaluations:
      the code we are patching might be called (and thus "concurrently" patched)
      and results in wrong results. Side-effects... *)
   let buff = Bytes.of_string buff in
-  let () = List.iter (fun p -> patch buff p) patches in
-  (* Note: we follow the apporach suggested by Gabriel Scherer in
-     PR#136 here, and use unsafe as we own buff.
-
-     The crux of the question that avoids defining emitcodes just as a
-     Byte.t is the call to hcons in to_memory below. Even if disabling
-     this optimization has no visible time impact, test data shows
-     that the optimization is indeed triggered quite often so we
-     choose ugliness over altering the semantics.
+  let iter (reloc, npos) = Array.iter (fun pos -> patch1 buff pos reloc) npos in
+  let () = CArray.iter iter reloc in
+  buff
 
-     Handle with care.
-  *)
-  Bytes.unsafe_to_string buff
+let patch buff pl f =
+  (** Order seems important here? *)
+  let reloc = CArray.map (fun (r, pos) -> (f r, pos)) pl.reloc_infos in
+  let buff = patch_int buff reloc in
+  tcode_of_code buff (Bytes.length buff)
 
 (* Buffering of bytecode *)
 
-let out_buffer = ref(Bytes.create 1024)
-and out_position = ref 0
+type label_definition =
+    Label_defined of int
+  | Label_undefined of (int * int) list
 
-let out_word b1 b2 b3 b4 =
-  let p = !out_position in
-  if p >= Bytes.length !out_buffer then begin
-    let len = Bytes.length !out_buffer in
+type env = {
+  mutable out_buffer : Bytes.t;
+  mutable out_position : int;
+  mutable label_table : label_definition array;
+  (* le ieme element de la table = Label_defined n signifie que l'on a
+    deja rencontrer le label i et qu'il est a l'offset n.
+                                = Label_undefined l signifie que l'on a
+    pas encore rencontrer ce label, le premier entier indique ou est l'entier
+    a patcher dans la string, le deuxieme son origine  *)
+  reloc_info : int list RelocTable.t;
+}
+
+let out_word env b1 b2 b3 b4 =
+  let p = env.out_position in
+  if p >= Bytes.length env.out_buffer then begin
+    let len = Bytes.length env.out_buffer in
     let new_len =
       if len <= Sys.max_string_length / 2
       then 2 * len
@@ -71,260 +112,240 @@ let out_word b1 b2 b3 b4 =
 	then invalid_arg "String.create"  (* Pas la bonne exception .... *)
 	else Sys.max_string_length in
     let new_buffer = Bytes.create new_len in
-    Bytes.blit !out_buffer 0 new_buffer 0 len;
-    out_buffer := new_buffer
+    Bytes.blit env.out_buffer 0 new_buffer 0 len;
+    env.out_buffer <- new_buffer
   end;
-  patch_char4 !out_buffer p (Char.unsafe_chr b1)
+  patch_char4 env.out_buffer p (Char.unsafe_chr b1)
    (Char.unsafe_chr b2) (Char.unsafe_chr b3) (Char.unsafe_chr b4);
-  out_position := p + 4
+  env.out_position <- p + 4
 
-let out opcode =
-  out_word opcode 0 0 0
+let out env opcode =
+  out_word env opcode 0 0 0
 
-let out_int n =
-  out_word n (n asr 8) (n asr 16) (n asr 24)
+let out_int env n =
+  out_word env n (n asr 8) (n asr 16) (n asr 24)
 
 (* Handling of local labels and backpatching *)
 
-type label_definition =
-    Label_defined of int
-  | Label_undefined of (int * int) list
-
-let label_table  = ref ([| |] : label_definition array)
-(* le ieme element de la table = Label_defined n signifie que l'on a
-   deja rencontrer le label i et qu'il est a l'offset n.
-                               = Label_undefined l signifie que l'on a
-   pas encore rencontrer ce label, le premier entier indique ou est l'entier
-   a patcher dans la string, le deuxieme son origine  *)
-
-let extend_label_table needed =
-  let new_size = ref(Array.length !label_table) in
+let extend_label_table env needed =
+  let new_size = ref(Array.length env.label_table) in
   while needed >= !new_size do new_size := 2 * !new_size done;
   let new_table = Array.make !new_size (Label_undefined []) in
-  Array.blit !label_table 0 new_table 0 (Array.length !label_table);
-  label_table := new_table
-
-let backpatch (pos, orig) =
-  let displ = (!out_position - orig) asr 2 in
-  Bytes.set !out_buffer  pos    @@ Char.unsafe_chr displ;
-  Bytes.set !out_buffer (pos+1) @@ Char.unsafe_chr (displ asr 8);
-  Bytes.set !out_buffer (pos+2) @@ Char.unsafe_chr (displ asr 16);
-  Bytes.set !out_buffer (pos+3) @@ Char.unsafe_chr (displ asr 24)
-
-let define_label lbl =
-  if lbl >= Array.length !label_table then extend_label_table lbl;
-  match (!label_table).(lbl) with
+  Array.blit env.label_table 0 new_table 0 (Array.length env.label_table);
+  env.label_table <- new_table
+
+let backpatch env (pos, orig) =
+  let displ = (env.out_position - orig) asr 2 in
+  Bytes.set env.out_buffer  pos    @@ Char.unsafe_chr displ;
+  Bytes.set env.out_buffer (pos+1) @@ Char.unsafe_chr (displ asr 8);
+  Bytes.set env.out_buffer (pos+2) @@ Char.unsafe_chr (displ asr 16);
+  Bytes.set env.out_buffer (pos+3) @@ Char.unsafe_chr (displ asr 24)
+
+let define_label env lbl =
+  if lbl >= Array.length env.label_table then extend_label_table env lbl;
+  match (env.label_table).(lbl) with
     Label_defined _ ->
       raise(Failure "CEmitcode.define_label")
   | Label_undefined patchlist ->
-      List.iter backpatch patchlist;
-      (!label_table).(lbl) <- Label_defined !out_position
+      List.iter (fun p -> backpatch env p) patchlist;
+      (env.label_table).(lbl) <- Label_defined env.out_position
 
-let out_label_with_orig orig lbl =
-  if lbl >= Array.length !label_table then extend_label_table lbl;
-  match (!label_table).(lbl) with
+let out_label_with_orig env orig lbl =
+  if lbl >= Array.length env.label_table then extend_label_table env lbl;
+  match (env.label_table).(lbl) with
     Label_defined def ->
-      out_int((def - orig) asr 2)
+      out_int env ((def - orig) asr 2)
   | Label_undefined patchlist ->
       (* spiwack: patchlist is supposed to be non-empty all the time
          thus I commented that out. If there is no problem I suggest
          removing it for next release (cur: 8.1) *)
       (*if patchlist = [] then *)
-	(!label_table).(lbl) <-
-          Label_undefined((!out_position, orig) :: patchlist);
-      out_int 0
+        (env.label_table).(lbl) <-
+          Label_undefined((env.out_position, orig) :: patchlist);
+      out_int env 0
 
-let out_label l = out_label_with_orig !out_position l
+let out_label env l = out_label_with_orig env env.out_position l
 
 (* Relocation information *)
 
-let reloc_info = ref ([] : (reloc_info * int) list)
+let enter env info =
+  let pos = env.out_position in
+  let old = try RelocTable.find env.reloc_info info with Not_found -> [] in
+  RelocTable.replace env.reloc_info info (pos :: old)
 
-let enter info =
-  reloc_info := (info, !out_position) :: !reloc_info
+let slot_for_const env c =
+  enter env (Reloc_const c);
+  out_int env 0
 
-let slot_for_const c =
-  enter (Reloc_const c);
-  out_int 0
+let slot_for_annot env a =
+  enter env (Reloc_annot a);
+  out_int env 0
 
-let slot_for_annot a =
-  enter (Reloc_annot a);
-  out_int 0
-
-let slot_for_getglobal p =
-  enter (Reloc_getglobal p);
-  out_int 0
+let slot_for_getglobal env p =
+  enter env (Reloc_getglobal p);
+  out_int env 0
 
 
 (* Emission of one instruction *)
 
 
-let emit_instr = function
-  | Klabel lbl -> define_label lbl
+let emit_instr env = function
+  | Klabel lbl -> define_label env lbl
   | Kacc n ->
-      if n < 8 then out(opACC0 + n) else (out opACC; out_int n)
+      if n < 8 then out env(opACC0 + n) else (out env opACC; out_int env n)
   | Kenvacc n ->
       if n >= 1 && n <= 4
-      then out(opENVACC1 + n - 1)
-      else (out opENVACC; out_int n)
+      then out env(opENVACC1 + n - 1)
+      else (out env opENVACC; out_int env n)
   | Koffsetclosure ofs ->
       if Int.equal ofs (-2) || Int.equal ofs 0 || Int.equal ofs 2
-      then out (opOFFSETCLOSURE0 + ofs / 2)
-      else (out opOFFSETCLOSURE; out_int ofs)
+      then out env (opOFFSETCLOSURE0 + ofs / 2)
+      else (out env opOFFSETCLOSURE; out_int env ofs)
   | Kpush ->
-      out opPUSH
+      out env opPUSH
   | Kpop n ->
-      out opPOP; out_int n
+      out env opPOP; out_int env n
   | Kpush_retaddr lbl ->
-      out opPUSH_RETADDR; out_label lbl
+      out env opPUSH_RETADDR; out_label env lbl
   | Kapply n ->
-      if n < 4 then out(opAPPLY1 + n - 1) else (out opAPPLY; out_int n)
+      if n < 4 then out env(opAPPLY1 + n - 1) else (out env opAPPLY; out_int env n)
   | Kappterm(n, sz) ->
-      if n < 4 then (out(opAPPTERM1 + n - 1); out_int sz)
-               else (out opAPPTERM; out_int n; out_int sz)
+      if n < 4 then (out env(opAPPTERM1 + n - 1); out_int env sz)
+               else (out env opAPPTERM; out_int env n; out_int env sz)
   | Kreturn n ->
-      out opRETURN; out_int n
+      out env opRETURN; out_int env n
   | Kjump ->
-      out opRETURN; out_int 0
+      out env opRETURN; out_int env 0
   | Krestart ->
-      out opRESTART
+      out env opRESTART
   | Kgrab n ->
-      out opGRAB; out_int n
+      out env opGRAB; out_int env n
   | Kgrabrec(rec_arg) ->
-      out opGRABREC; out_int rec_arg
+      out env opGRABREC; out_int env rec_arg
   | Kclosure(lbl, n) ->
-      out opCLOSURE; out_int n; out_label lbl
+      out env opCLOSURE; out_int env n; out_label env lbl
   | Kclosurerec(nfv,init,lbl_types,lbl_bodies) ->
-      out opCLOSUREREC;out_int (Array.length lbl_bodies);
-      out_int nfv; out_int init;
-      let org = !out_position in
-      Array.iter (out_label_with_orig org) lbl_types;
-      let org = !out_position in
-      Array.iter (out_label_with_orig org) lbl_bodies
+      out env opCLOSUREREC;out_int env (Array.length lbl_bodies);
+      out_int env nfv; out_int env init;
+      let org = env.out_position in
+      Array.iter (out_label_with_orig env org) lbl_types;
+      let org = env.out_position in
+      Array.iter (out_label_with_orig env org) lbl_bodies
   | Kclosurecofix(nfv,init,lbl_types,lbl_bodies) ->
-      out opCLOSURECOFIX;out_int (Array.length lbl_bodies);
-      out_int nfv; out_int init;
-      let org = !out_position in
-      Array.iter (out_label_with_orig org) lbl_types;
-      let org = !out_position in
-      Array.iter (out_label_with_orig org) lbl_bodies
+      out env opCLOSURECOFIX;out_int env (Array.length lbl_bodies);
+      out_int env nfv; out_int env init;
+      let org = env.out_position in
+      Array.iter (out_label_with_orig env org) lbl_types;
+      let org = env.out_position in
+      Array.iter (out_label_with_orig env org) lbl_bodies
   | Kgetglobal q ->
-      out opGETGLOBAL; slot_for_getglobal q
+      out env opGETGLOBAL; slot_for_getglobal env q
   | Kconst (Const_b0 i) ->
       if i >= 0 && i <= 3
-          then out (opCONST0 + i)
-          else (out opCONSTINT; out_int i)
+          then out env (opCONST0 + i)
+          else (out env opCONSTINT; out_int env i)
   | Kconst c ->
-      out opGETGLOBAL; slot_for_const c
+      out env opGETGLOBAL; slot_for_const env c
   | Kmakeblock(n, t) ->
       if Int.equal n 0 then invalid_arg "emit_instr : block size = 0"
-      else if n < 4 then (out(opMAKEBLOCK1 + n - 1); out_int t)
-      else (out opMAKEBLOCK; out_int n; out_int t)
+      else if n < 4 then (out env(opMAKEBLOCK1 + n - 1); out_int env t)
+      else (out env opMAKEBLOCK; out_int env n; out_int env t)
   | Kmakeprod ->
-      out opMAKEPROD
+      out env opMAKEPROD
   | Kmakeswitchblock(typlbl,swlbl,annot,sz) ->
-      out opMAKESWITCHBLOCK;
-      out_label typlbl; out_label swlbl;
-      slot_for_annot annot;out_int sz
+      out env opMAKESWITCHBLOCK;
+      out_label env typlbl; out_label env swlbl;
+      slot_for_annot env annot;out_int env sz
   | Kswitch (tbl_const, tbl_block) ->
       let lenb = Array.length tbl_block in
       let lenc = Array.length tbl_const in
       assert (lenb < 0x100 && lenc < 0x1000000);
-      out opSWITCH;
-      out_word lenc (lenc asr 8) (lenc asr 16) (lenb);
-(*      out_int (Array.length tbl_const + (Array.length tbl_block lsl 23)); *)
-      let org = !out_position in
-      Array.iter (out_label_with_orig org) tbl_const;
-      Array.iter (out_label_with_orig org) tbl_block
+      out env opSWITCH;
+      out_word env lenc (lenc asr 8) (lenc asr 16) (lenb);
+(*      out_int env (Array.length tbl_const + (Array.length tbl_block lsl 23)); *)
+      let org = env.out_position in
+      Array.iter (out_label_with_orig env org) tbl_const;
+      Array.iter (out_label_with_orig env org) tbl_block
   | Kpushfields n ->
-      out opPUSHFIELDS;out_int n
+      out env opPUSHFIELDS;out_int env n
   | Kfield n ->
-      if n <= 1 then out (opGETFIELD0+n)
-      else (out opGETFIELD;out_int n)
+      if n <= 1 then out env (opGETFIELD0+n)
+      else (out env opGETFIELD;out_int env n)
   | Ksetfield n ->
-      if n <= 1 then out (opSETFIELD0+n)
-      else (out opSETFIELD;out_int n)
+      if n <= 1 then out env (opSETFIELD0+n)
+      else (out env opSETFIELD;out_int env 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
+  | Kproj (n,p) -> out env opPROJ; out_int env n; slot_for_const env (Const_proj p)
+  | Kensurestackcapacity size -> out env opENSURESTACKCAPACITY; out_int env size
   (* spiwack *)
-  | Kbranch lbl -> out opBRANCH; out_label lbl
-  | Kaddint31 -> out opADDINT31
-  | Kaddcint31 -> out opADDCINT31
-  | Kaddcarrycint31 -> out opADDCARRYCINT31
-  | Ksubint31 -> out opSUBINT31
-  | Ksubcint31 -> out opSUBCINT31
-  | Ksubcarrycint31 -> out opSUBCARRYCINT31
-  | Kmulint31 -> out opMULINT31
-  | Kmulcint31 -> out opMULCINT31
-  | Kdiv21int31 -> out opDIV21INT31
-  | Kdivint31 -> out opDIVINT31
-  | Kaddmuldivint31 -> out opADDMULDIVINT31
-  | Kcompareint31 -> out opCOMPAREINT31
-  | Khead0int31 -> out opHEAD0INT31
-  | Ktail0int31 -> out opTAIL0INT31
-  | Kisconst lbl -> out opISCONST; out_label lbl
-  | Kareconst(n,lbl) -> out opARECONST; out_int n; out_label lbl
-  | Kcompint31 -> out opCOMPINT31
-  | Kdecompint31 -> out opDECOMPINT31
-  | Klorint31 -> out opORINT31
-  | Klandint31 -> out opANDINT31
-  | Klxorint31 -> out opXORINT31
+  | Kbranch lbl -> out env opBRANCH; out_label env lbl
+  | Kaddint31 -> out env opADDINT31
+  | Kaddcint31 -> out env opADDCINT31
+  | Kaddcarrycint31 -> out env opADDCARRYCINT31
+  | Ksubint31 -> out env opSUBINT31
+  | Ksubcint31 -> out env opSUBCINT31
+  | Ksubcarrycint31 -> out env opSUBCARRYCINT31
+  | Kmulint31 -> out env opMULINT31
+  | Kmulcint31 -> out env opMULCINT31
+  | Kdiv21int31 -> out env opDIV21INT31
+  | Kdivint31 -> out env opDIVINT31
+  | Kaddmuldivint31 -> out env opADDMULDIVINT31
+  | Kcompareint31 -> out env opCOMPAREINT31
+  | Khead0int31 -> out env opHEAD0INT31
+  | Ktail0int31 -> out env opTAIL0INT31
+  | Kisconst lbl -> out env opISCONST; out_label env lbl
+  | Kareconst(n,lbl) -> out env opARECONST; out_int env n; out_label env lbl
+  | Kcompint31 -> out env opCOMPINT31
+  | Kdecompint31 -> out env opDECOMPINT31
+  | Klorint31 -> out env opORINT31
+  | Klandint31 -> out env opANDINT31
+  | Klxorint31 -> out env opXORINT31
   (*/spiwack *)
   | Kstop ->
-      out opSTOP
+      out env opSTOP
 
 (* Emission of a current list and remaining lists of instructions. Include some peephole optimization. *)
 
-let rec emit insns remaining = match insns with
+let rec emit env insns remaining = match insns with
   | [] -> 
      (match remaining with 
        [] -> () 
-     | (first::rest) -> emit first rest)
+     | (first::rest) -> emit env first rest)
   (* Peephole optimizations *)
   | Kpush :: Kacc n :: c ->
-      if n < 8 then out(opPUSHACC0 + n) else (out opPUSHACC; out_int n);
-      emit c remaining
+      if n < 8 then out env(opPUSHACC0 + n) else (out env opPUSHACC; out_int env n);
+      emit env c remaining
   | Kpush :: Kenvacc n :: c ->
       if n >= 1 && n <= 4
-      then out(opPUSHENVACC1 + n - 1)
-      else (out opPUSHENVACC; out_int n);
-      emit c remaining
+      then out env(opPUSHENVACC1 + n - 1)
+      else (out env opPUSHENVACC; out_int env n);
+      emit env c remaining
   | Kpush :: Koffsetclosure ofs :: c ->
       if Int.equal ofs (-2) || Int.equal ofs 0 || Int.equal ofs 2
-      then out(opPUSHOFFSETCLOSURE0 + ofs / 2)
-      else (out opPUSHOFFSETCLOSURE; out_int ofs);
-      emit c remaining
+      then out env(opPUSHOFFSETCLOSURE0 + ofs / 2)
+      else (out env opPUSHOFFSETCLOSURE; out_int env ofs);
+      emit env c remaining
   | Kpush :: Kgetglobal id :: c ->
-      out opPUSHGETGLOBAL; slot_for_getglobal id; emit c remaining
+      out env opPUSHGETGLOBAL; slot_for_getglobal env id; emit env c remaining
   | Kpush :: Kconst (Const_b0 i) :: c ->
       if i >= 0 && i <= 3
-      then out (opPUSHCONST0 + i)
-      else (out opPUSHCONSTINT; out_int i);
-      emit c remaining
+      then out env (opPUSHCONST0 + i)
+      else (out env opPUSHCONSTINT; out_int env i);
+      emit env c remaining
   | Kpush :: Kconst const :: c ->
-      out opPUSHGETGLOBAL; slot_for_const const;
-      emit c remaining
+      out env opPUSHGETGLOBAL; slot_for_const env const;
+      emit env c remaining
   | Kpop n :: Kjump :: c ->
-      out opRETURN; out_int n; emit c remaining
+      out env opRETURN; out_int env n; emit env c remaining
   | Ksequence(c1,c2)::c ->
-      emit c1 (c2::c::remaining)
+      emit env c1 (c2::c::remaining)
   (* Default case *)
   | instr :: c ->
-      emit_instr instr; emit c remaining
+      emit_instr env instr; emit env c remaining
 
 (* Initialization *)
 
-let init () =
-  out_position := 0;
-  label_table := Array.make 16 (Label_undefined []);
-  reloc_info := []
-
-type emitcodes = String.t
-
-let length = String.length
-
-type to_patch = emitcodes * (patch list) * fv
+type to_patch = emitcodes * patches * fv
 
 (* Substitution *)
 let rec subst_strcst s sc =
@@ -334,26 +355,30 @@ let rec subst_strcst s sc =
   | Const_bn(tag,args) -> Const_bn(tag,Array.map (subst_strcst s) args)
   | Const_ind ind -> let kn,i = ind in Const_ind (subst_mind s kn, i)
 
-let subst_patch s (ri,pos) =
+let subst_reloc s ri =
   match ri with
   | Reloc_annot a ->
       let (kn,i) = a.ci.ci_ind in
       let ci = {a.ci with ci_ind = (subst_mind s kn,i)} in
-      (Reloc_annot {a with ci = ci},pos)
-  | Reloc_const sc -> (Reloc_const (subst_strcst s sc), pos)
-  | Reloc_getglobal kn -> (Reloc_getglobal (subst_constant s kn), pos)
+      Reloc_annot {a with ci = ci}
+  | Reloc_const sc -> Reloc_const (subst_strcst s sc)
+  | Reloc_getglobal kn -> Reloc_getglobal (subst_constant s kn)
+
+let subst_patches subst p =
+  let infos = CArray.map (fun (r, pos) -> (subst_reloc subst r, pos)) p.reloc_infos in
+  { reloc_infos = infos; }
 
 let subst_to_patch s (code,pl,fv) =
-  code,List.rev_map (subst_patch s) pl,fv
+  code, subst_patches s pl, fv
 
 type body_code =
   | BCdefined of to_patch
-  | BCalias of Names.constant
+  | BCalias of Names.Constant.t
   | BCconstant
 
 type to_patch_substituted =
 | PBCdefined of to_patch substituted
-| PBCalias of Names.constant substituted
+| PBCalias of Names.Constant.t substituted
 | PBCconstant
 
 let from_val = function
@@ -381,16 +406,23 @@ let repr_body_code = function
 | PBCconstant -> (None, BCconstant)
 
 let to_memory (init_code, fun_code, fv) =
-  init();
-  emit init_code [];
-  emit fun_code [];
+  let env = {
+    out_buffer = Bytes.create 1024;
+    out_position = 0;
+    label_table = Array.make 16 (Label_undefined []);
+    reloc_info = RelocTable.create 91;
+  } in
+  emit env init_code [];
+  emit env fun_code [];
   (** Later uses of this string are all purely functional *)
-  let code = Bytes.sub_string !out_buffer 0 !out_position in
+  let code = Bytes.sub_string env.out_buffer 0 env.out_position in
   let code = CString.hcons code in
-  let reloc = List.rev !reloc_info in
+  let fold reloc npos accu = (reloc, Array.of_list npos) :: accu in
+  let reloc = RelocTable.fold fold env.reloc_info [] in
+  let reloc = { reloc_infos = CArray.of_list reloc } in
   Array.iter (fun lbl ->
     (match lbl with
       Label_defined _ -> assert true
     | Label_undefined patchlist ->
-	assert (patchlist = []))) !label_table;
+        assert (patchlist = []))) env.label_table;
   (code, reloc, fv)
diff --git a/kernel/cemitcodes.mli b/kernel/cemitcodes.mli
index c80edd596..03920dc1a 100644
--- a/kernel/cemitcodes.mli
+++ b/kernel/cemitcodes.mli
@@ -4,26 +4,18 @@ open Cbytecodes
 type reloc_info =
   | Reloc_annot of annot_switch
   | Reloc_const of structured_constant
-  | Reloc_getglobal of constant
-
-type patch = reloc_info * int
-
-(* A virer *)
-val subst_patch : Mod_subst.substitution -> patch -> patch
+  | Reloc_getglobal of Constant.t
 
+type patches
 type emitcodes
 
-val length : emitcodes -> int
-
-val patch_int : emitcodes -> ((*pos*)int * int) list -> emitcodes
-
-type to_patch = emitcodes * (patch list) * fv
+val patch : emitcodes -> patches -> (reloc_info -> int) -> Vmvalues.tcode
 
-val subst_to_patch : Mod_subst.substitution -> to_patch -> to_patch
+type to_patch = emitcodes * patches * fv
 
 type body_code =
   | BCdefined of to_patch
-  | BCalias of constant
+  | BCalias of Constant.t
   | BCconstant
 
 
diff --git a/kernel/cinstr.mli b/kernel/cinstr.mli
new file mode 100644
index 000000000..2d9ec6050
--- /dev/null
+++ b/kernel/cinstr.mli
@@ -0,0 +1,43 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+open Names
+open Constr
+open Cbytecodes
+
+(** This file defines the lambda code for the bytecode compiler. It has been
+extracted from Clambda.ml because of the retroknowledge architecture. *)
+
+type uint =
+  | UintVal of Uint31.t
+  | UintDigits of lambda array
+  | UintDecomp of lambda
+
+and lambda =
+  | Lrel          of Name.t * int
+  | Lvar          of Id.t
+  | Lprod         of lambda * lambda
+  | Llam          of Name.t array * lambda
+  | Llet          of Name.t * lambda * lambda
+  | Lapp          of lambda * lambda array
+  | Lconst        of pconstant
+  | Lprim         of pconstant * int (* arity *) * instruction * lambda array
+  | Lcase         of case_info * reloc_table * lambda * lambda * lam_branches
+  | Lfix          of (int array * int) * fix_decl
+  | Lcofix        of int * fix_decl
+  | Lmakeblock    of int * lambda array
+  | Lval          of structured_constant
+  | Lsort         of Sorts.t
+  | Lind          of pinductive
+  | Lproj         of int * Constant.t * lambda
+  | Luint         of uint
+
+and lam_branches =
+  { constant_branches : lambda array;
+    nonconstant_branches : (Name.t array * lambda) array }
+
+and fix_decl =  Name.t array * lambda array * lambda array
diff --git a/kernel/clambda.ml b/kernel/clambda.ml
new file mode 100644
index 000000000..636ed3510
--- /dev/null
+++ b/kernel/clambda.ml
@@ -0,0 +1,853 @@
+open Util
+open Names
+open Esubst
+open Term
+open Constr
+open Declarations
+open Cbytecodes
+open Cinstr
+open Pre_env
+open Pp
+
+let pr_con sp = str(Names.Label.to_string (Constant.label sp))
+
+(** Printing **)
+
+let pp_names ids =
+  prlist_with_sep (fun _ -> brk(1,1)) Name.print (Array.to_list ids)
+
+let pp_rel name n =
+  Name.print name ++  str "##" ++ int n
+
+let pp_sort s =
+  match Sorts.family s with
+  | InSet -> str "Set"
+  | InProp -> str "Prop"
+  | InType -> str "Type"
+
+let rec pp_lam lam =
+  match lam with
+  | Lrel (id,n) -> pp_rel id n
+  | Lvar id -> Id.print id
+  | Lprod(dom,codom) -> hov 1
+                          (str "forall(" ++
+                           pp_lam dom ++
+                           str "," ++ spc() ++
+                           pp_lam codom ++
+                           str ")")
+  | Llam(ids,body) -> hov 1
+                        (str "(fun " ++
+                         pp_names ids ++
+                         str " =>" ++
+                         spc() ++
+                         pp_lam body ++
+                         str ")")
+  | Llet(id,def,body) -> hov 0
+                           (str "let " ++
+                            Name.print id ++
+                            str ":=" ++
+                            pp_lam def  ++
+                            str " in" ++
+                            spc() ++
+                            pp_lam body)
+  | Lapp(f, args) -> hov 1
+                       (str "(" ++ pp_lam f ++ spc() ++
+                        prlist_with_sep spc pp_lam (Array.to_list args) ++
+                        str")")
+  | Lconst (kn,_) -> pr_con kn
+  | Lcase(_ci, _rtbl, t, a, branches) ->
+    let ic = ref (-1) in
+    let ib = ref 0 in
+    v 0 (str"<" ++ pp_lam t ++ str">" ++ cut() ++
+         str "Case" ++ spc () ++ pp_lam a ++ spc() ++ str "of" ++ cut() ++
+         v 0
+           ((prlist_with_sep (fun _ -> str "")
+               (fun c ->
+                  cut () ++ str "| " ++
+                  int (incr ic; !ic) ++ str " => " ++ pp_lam c)
+               (Array.to_list branches.constant_branches)) ++
+            (prlist_with_sep (fun _ -> str "")
+               (fun (ids,c) ->
+                  cut () ++ str "| " ++
+                  int (incr ib; !ib) ++ str " " ++
+                  pp_names ids ++ str " => " ++ pp_lam c)
+               (Array.to_list branches.nonconstant_branches)))
+         ++ cut() ++ str "end")
+  | Lfix((t,i),(lna,tl,bl)) ->
+    let fixl = Array.mapi (fun i id -> (id,t.(i),tl.(i),bl.(i))) lna in
+    hov 1
+      (str"fix " ++ int i ++ spc() ++  str"{" ++
+       v 0
+         (prlist_with_sep spc
+            (fun (na,i,ty,bd) ->
+               Name.print na ++ str"/" ++ int i ++ str":" ++
+               pp_lam ty ++ cut() ++ str":=" ++
+               pp_lam bd) (Array.to_list fixl)) ++
+       str"}")
+
+  | Lcofix (i,(lna,tl,bl)) ->
+    let fixl = Array.mapi (fun i na -> (na,tl.(i),bl.(i))) lna in
+    hov 1
+      (str"cofix " ++ int i ++ spc() ++  str"{" ++
+       v 0
+         (prlist_with_sep spc
+            (fun (na,ty,bd) ->
+               Name.print na ++ str":" ++ pp_lam ty ++
+               cut() ++ str":=" ++ pp_lam bd) (Array.to_list fixl)) ++
+       str"}")
+  | Lmakeblock(tag, args) ->
+    hov 1
+      (str "(makeblock " ++ int tag ++ spc() ++
+       prlist_with_sep spc pp_lam (Array.to_list args) ++
+       str")")
+  | Lval _ -> str "values"
+  | Lsort s -> pp_sort s
+  | Lind ((mind,i), _) -> MutInd.print mind ++ str"#" ++ int i
+  | Lprim((kn,_u),ar,op,args) ->
+    hov 1
+      (str "(PRIM " ++ pr_con kn ++  spc() ++
+       prlist_with_sep spc pp_lam  (Array.to_list args) ++
+       str")")
+  | Lproj(i,kn,arg) ->
+    hov 1
+      (str "(proj#" ++ int i ++ spc() ++ pr_con kn ++ str "(" ++ pp_lam arg
+       ++ str ")")
+  | Luint _ ->
+    str "(uint)"
+
+(*s Constructors *)
+
+let mkLapp f args =
+  if Array.length args = 0 then f
+  else
+    match f with
+    | Lapp(f', args') -> Lapp (f', Array.append args' args)
+    | _ -> Lapp(f, args)
+
+let mkLlam ids body =
+  if Array.length ids = 0 then body
+  else
+    match body with
+    | Llam(ids', body) -> Llam(Array.append ids ids', body)
+    | _ -> Llam(ids, body)
+
+let decompose_Llam lam =
+  match lam with
+  | Llam(ids,body) -> ids, body
+  | _ -> [||], lam
+
+(*s Operators on substitution *)
+let subst_id = subs_id 0
+let lift = subs_lift
+let liftn = subs_liftn
+let cons v subst = subs_cons([|v|], subst)
+let shift subst = subs_shft (1, subst)
+
+(* A generic map function *)
+
+let rec map_lam_with_binders g f n lam =
+  match lam with
+  | Lrel _ | Lvar _  | Lconst _ | Lval _ | Lsort _ | Lind _ -> lam
+  | Lprod(dom,codom) ->
+    let dom' = f n dom in
+    let codom' = f n codom in
+    if dom == dom' && codom == codom' then lam else Lprod(dom',codom')
+  | Llam(ids,body) ->
+    let body' = f (g (Array.length ids) n) body in
+    if body == body' then lam else mkLlam ids body'
+  | Llet(id,def,body) ->
+    let def' = f n def in
+    let body' = f (g 1 n) body in
+    if body == body' && def == def' then lam else Llet(id,def',body')
+  | Lapp(fct,args) ->
+    let fct' = f n fct in
+    let args' = Array.smartmap (f n) args in
+    if fct == fct' && args == args' then lam else mkLapp fct' args'
+  | Lcase(ci,rtbl,t,a,branches) ->
+    let const = branches.constant_branches in
+    let nonconst = branches.nonconstant_branches in
+    let t' = f n t in
+    let a' = f n a in
+    let const' = Array.smartmap (f n) const in
+    let on_b b =
+      let (ids,body) = b in
+      let body' = f (g (Array.length ids) n) body in
+      if body == body' then b else (ids,body') in
+    let nonconst' = Array.smartmap on_b nonconst in
+    let branches' =
+      if const == const' && nonconst == nonconst' then
+        branches
+      else
+        { constant_branches = const';
+          nonconstant_branches = nonconst' }
+    in
+    if t == t' && a == a' && branches == branches' then lam else
+      Lcase(ci,rtbl,t',a',branches')
+  | Lfix(init,(ids,ltypes,lbodies)) ->
+    let ltypes' = Array.smartmap (f n) ltypes in
+    let lbodies' = Array.smartmap (f (g (Array.length ids) n)) lbodies in
+    if ltypes == ltypes' && lbodies == lbodies' then lam
+    else Lfix(init,(ids,ltypes',lbodies'))
+  | Lcofix(init,(ids,ltypes,lbodies)) ->
+    let ltypes' = Array.smartmap (f n) ltypes in
+    let lbodies' = Array.smartmap (f (g (Array.length ids) n)) lbodies in
+    if ltypes == ltypes' && lbodies == lbodies' then lam
+    else Lcofix(init,(ids,ltypes',lbodies'))
+  | Lmakeblock(tag,args) ->
+    let args' = Array.smartmap (f n) args in
+    if args == args' then lam else Lmakeblock(tag,args')
+  | Lprim(kn,ar,op,args) ->
+    let args' = Array.smartmap (f n) args in
+    if args == args' then lam else Lprim(kn,ar,op,args')
+  | Lproj(i,kn,arg) ->
+    let arg' = f n arg in
+    if arg == arg' then lam else Lproj(i,kn,arg')
+  | Luint u ->
+    let u' = map_uint g f n u in
+    if u == u' then lam else Luint u'
+
+and map_uint g f n u =
+  match u with
+  | UintVal _ -> u
+  | UintDigits(args) ->
+    let args' = Array.smartmap (f n) args in
+    if args == args' then u else UintDigits(args')
+  | UintDecomp(a) ->
+    let a' = f n a in
+    if a == a' then u else UintDecomp(a')
+
+(*s Lift and substitution *)
+
+
+let rec lam_exlift el lam =
+  match lam with
+  | Lrel(id,i) ->
+    let i' = reloc_rel i el in
+    if i == i' then lam else Lrel(id,i')
+  | _ -> map_lam_with_binders el_liftn lam_exlift el lam
+
+let lam_lift k lam =
+  if k = 0 then lam
+  else lam_exlift (el_shft k el_id) lam
+
+let lam_subst_rel lam id n subst =
+  match expand_rel n subst with
+  | Inl(k,v) -> lam_lift k v
+  | Inr(n',_) ->
+    if n == n' then lam
+    else Lrel(id, n')
+
+let rec lam_exsubst subst lam =
+  match lam with
+  | Lrel(id,i) -> lam_subst_rel lam id i subst
+  | _ -> map_lam_with_binders liftn lam_exsubst subst lam
+
+let lam_subst_args subst args =
+  if is_subs_id subst then args
+  else Array.smartmap (lam_exsubst subst) args
+
+(** Simplification of lambda expression *)
+
+(* [simplify subst lam] simplify the expression [lam_subst subst lam] *)
+(* that is :                                                          *)
+(* - Reduce [let] is the definition can be substituted i.e:           *)
+(*    - a variable (rel or identifier)                                *)
+(*    - a constant                                                    *)
+(*    - a structured constant                                         *)
+(*    - a function                                                    *)
+(* - Transform beta redex into [let] expression                       *)
+(* - Move arguments under [let]                                       *)
+(* Invariant : Terms in [subst] are already simplified and can be     *)
+(*             substituted                                            *)
+
+let can_subst lam =
+  match lam with
+  | Lrel _ | Lvar _ | Lconst _
+  | Lval _ | Lsort _ | Lind _ | Llam _ -> true
+  | _ -> false
+
+let rec simplify subst lam =
+  match lam with
+  | Lrel(id,i) -> lam_subst_rel lam id i subst
+
+  | Llet(id,def,body) ->
+    let def' = simplify subst def in
+    if can_subst def' then simplify (cons def' subst) body
+    else
+      let body' = simplify (lift subst) body in
+      if def == def' && body == body' then lam
+      else Llet(id,def',body')
+
+  | Lapp(f,args) ->
+    begin match simplify_app subst f subst args with
+      | Lapp(f',args') when f == f' && args == args' -> lam
+      | lam' -> lam'
+    end
+
+  | _ -> map_lam_with_binders liftn simplify subst lam
+
+and simplify_app substf f substa args =
+  match f with
+  | Lrel(id, i) ->
+    begin match lam_subst_rel f id i substf with
+      | Llam(ids, body) ->
+        reduce_lapp
+          subst_id (Array.to_list ids) body
+          substa (Array.to_list args)
+      | f' -> mkLapp f' (simplify_args substa args)
+    end
+  | Llam(ids, body) ->
+    reduce_lapp substf (Array.to_list ids) body substa (Array.to_list args)
+  | Llet(id, def, body) ->
+    let def' = simplify substf def in
+    if can_subst def' then
+      simplify_app (cons def' substf) body substa args
+    else
+      Llet(id, def', simplify_app (lift substf) body (shift substa) args)
+  | Lapp(f, args') ->
+    let args = Array.append
+        (lam_subst_args substf args') (lam_subst_args substa args) in
+    simplify_app substf f subst_id args
+  | _ -> mkLapp (simplify substf f) (simplify_args substa args)
+
+and simplify_args subst args = Array.smartmap (simplify subst) args
+
+and reduce_lapp substf lids body substa largs =
+  match lids, largs with
+  | id::lids, a::largs ->
+    let a = simplify substa a in
+    if can_subst a then
+      reduce_lapp (cons a substf) lids body substa largs
+    else
+      let body = reduce_lapp (lift substf) lids body (shift substa) largs in
+      Llet(id, a, body)
+  | [], [] -> simplify substf body
+  | _::_, _ ->
+    Llam(Array.of_list lids,  simplify (liftn (List.length lids) substf) body)
+  | [], _::_ -> simplify_app substf body substa (Array.of_list largs)
+
+
+
+
+(* [occurrence kind k lam]:
+   If [kind] is [true] return [true] if the variable [k] does not appear in
+   [lam], return [false] if the variable appear one time and not
+   under a lambda, a fixpoint, a cofixpoint; else raise Not_found.
+   If [kind] is [false] return [false] if the variable does not appear in [lam]
+   else raise [Not_found]
+*)
+
+let rec occurrence k kind lam =
+  match lam with
+  | Lrel (_,n) ->
+    if n = k then
+      if kind then false else raise Not_found
+    else kind
+  | Lvar _  | Lconst _  | Lval _ | Lsort _ | Lind _ -> kind
+  | Lprod(dom, codom) ->
+    occurrence k (occurrence k kind dom) codom
+  | Llam(ids,body) ->
+    let _ = occurrence (k+Array.length ids) false body in kind
+  | Llet(_,def,body) ->
+    occurrence (k+1) (occurrence k kind def) body
+  | Lapp(f, args) ->
+    occurrence_args k (occurrence k kind f) args
+  | Lprim(_,_,_,args) | Lmakeblock(_,args) ->
+    occurrence_args k kind args
+  | Lcase(_ci,_rtbl,t,a,branches) ->
+    let kind = occurrence k (occurrence k kind t) a in
+    let r = ref kind in
+    Array.iter (fun c -> r := occurrence k kind c  && !r) branches.constant_branches;
+    let on_b (ids,c) =
+      r := occurrence (k+Array.length ids) kind c && !r
+    in
+    Array.iter on_b branches.nonconstant_branches;
+    !r
+  | Lfix(_,(ids,ltypes,lbodies))
+  | Lcofix(_,(ids,ltypes,lbodies)) ->
+    let kind = occurrence_args k kind ltypes in
+    let _ = occurrence_args (k+Array.length ids) false lbodies in
+    kind
+  | Lproj(_,_,arg) ->
+    occurrence k kind arg
+  | Luint u -> occurrence_uint k kind u
+
+and occurrence_args k kind args =
+  Array.fold_left (occurrence k) kind args
+
+and occurrence_uint k kind u =
+  match u with
+  | UintVal _ -> kind
+  | UintDigits args -> occurrence_args k kind args
+  | UintDecomp t -> occurrence k kind t
+
+let occur_once lam =
+  try let _ = occurrence 1 true lam in true
+  with Not_found -> false
+
+(* [remove_let lam] remove let expression in [lam] if the variable is *)
+(* used at most once time in the body, and does not appear under      *)
+(* a lambda or a fix or a cofix                                       *)
+
+let rec remove_let subst lam =
+  match lam with
+  | Lrel(id,i) -> lam_subst_rel lam id i subst
+  | Llet(id,def,body) ->
+    let def' = remove_let subst def in
+    if occur_once body then remove_let (cons def' subst) body
+    else
+      let body' = remove_let (lift subst) body in
+      if def == def' && body == body' then lam else Llet(id,def',body')
+  | _ -> map_lam_with_binders liftn remove_let subst lam
+
+
+(*s Translation from [constr] to [lambda] *)
+
+(* Translation of constructor *)
+
+(* Limitation due to OCaml's representation of non-constant
+  constructors: limited to 245 + 1 (0 tag) cases. *)
+
+exception TooLargeInductive of Pp.t
+
+let max_nb_const = 0x1000000
+let max_nb_block = 0x1000000 + last_variant_tag - 1
+
+let str_max_constructors =
+  Format.sprintf
+    " which has more than %i constant constructors or more than %i non-constant constructors" max_nb_const max_nb_block
+
+let check_compilable ib =
+
+  if not (ib.mind_nb_args <= max_nb_block && ib.mind_nb_constant <= max_nb_const) then
+    let msg =
+      Pp.(str "Cannot compile code for virtual machine as it uses inductive "
+          ++ Id.print ib.mind_typename ++ str str_max_constructors)
+    in
+    raise (TooLargeInductive msg)
+
+let is_value lc =
+  match lc with
+  | Lval _ -> true
+  | _ -> false
+
+let get_value lc =
+  match lc with
+  | Lval v -> v
+  | _ -> raise Not_found
+
+let mkConst_b0 n = Lval (Cbytecodes.Const_b0 n)
+
+let make_args start _end =
+  Array.init (start - _end + 1) (fun i -> Lrel (Anonymous, start - i))
+
+(* Translation of constructors *)
+let expand_constructor tag nparams arity =
+  let ids = Array.make (nparams + arity) Anonymous in
+  if arity = 0 then mkLlam ids (mkConst_b0 tag)
+  else
+    let args = make_args arity 1 in
+    Llam(ids, Lmakeblock (tag, args))
+
+let makeblock tag nparams arity args =
+  let nargs = Array.length args in
+  if nparams > 0 || nargs < arity then
+    mkLapp (expand_constructor tag nparams arity) args
+  else
+    (* The constructor is fully applied *)
+  if arity = 0 then mkConst_b0 tag
+  else
+  if Array.for_all is_value args then
+    if tag < last_variant_tag then
+      Lval(Cbytecodes.Const_bn(tag, Array.map get_value args))
+    else
+      let args = Array.map get_value args in
+      let args = Array.append [|Cbytecodes.Const_b0 (tag - last_variant_tag) |] args in
+      Lval(Cbytecodes.Const_bn(last_variant_tag, args))
+  else Lmakeblock(tag, args)
+
+
+(* Compiling constants *)
+
+let rec get_alias env kn =
+  let cb = lookup_constant kn env in
+  let tps = cb.const_body_code in
+  match tps with
+  | None -> kn
+  | Some tps ->
+    (match Cemitcodes.force tps with
+     | Cemitcodes.BCalias kn' -> get_alias env kn'
+     | _ -> kn)
+
+(* Compilation of primitive *)
+
+let _h =  Name(Id.of_string "f")
+
+(*
+let expand_prim kn op arity =
+  let ids = Array.make arity Anonymous in
+  let args = make_args arity 1 in
+  Llam(ids, prim kn op args)
+*)
+
+let compile_prim n op kn fc args =
+  if not fc then raise Not_found
+  else
+    Lprim(kn, n, op, args)
+
+    (*
+  let (nparams, arity) = CPrimitives.arity op in
+  let expected = nparams + arity in
+  if Array.length args >= expected then prim kn op args
+  else mkLapp (expand_prim kn op expected) args
+*)
+
+(*i Global environment *)
+
+let get_names decl =
+  let decl = Array.of_list decl in
+  Array.map fst decl
+
+
+(* Rel Environment *)
+module Vect =
+struct
+  type 'a t = {
+    mutable elems : 'a array;
+    mutable size : int;
+  }
+
+  let make n a = {
+    elems = Array.make n a;
+    size = 0;
+  }
+
+  let extend v =
+    if v.size = Array.length v.elems then
+      let new_size = min (2*v.size) Sys.max_array_length in
+      if new_size <= v.size then raise (Invalid_argument "Vect.extend");
+      let new_elems = Array.make new_size v.elems.(0) in
+      Array.blit v.elems 0 new_elems 0 (v.size);
+      v.elems <- new_elems
+
+  let push v a =
+    extend v;
+    v.elems.(v.size) <- a;
+    v.size <- v.size + 1
+
+  let popn v n =
+    v.size <- max 0 (v.size - n)
+
+  let pop v = popn v 1
+
+  let get_last v n =
+    if v.size <= n then raise
+        (Invalid_argument "Vect.get:index out of bounds");
+    v.elems.(v.size - n - 1)
+
+end
+
+let dummy_lambda = Lrel(Anonymous, 0)
+
+let empty_args = [||]
+
+module Renv =
+struct
+
+  type constructor_info = tag * int * int (* nparam nrealargs *)
+
+  type t = {
+    global_env : env;
+    name_rel : Name.t Vect.t;
+    construct_tbl : (constructor, constructor_info) Hashtbl.t;
+  }
+
+  let make env = {
+    global_env = env;
+    name_rel = Vect.make 16 Anonymous;
+    construct_tbl = Hashtbl.create 111
+  }
+
+  let push_rel env id = Vect.push env.name_rel id
+
+  let push_rels env ids =
+    Array.iter (push_rel env) ids
+
+  let pop env = Vect.pop env.name_rel
+
+  let popn env n =
+    for _i = 1 to n do pop env done
+
+  let get env n =
+    Lrel (Vect.get_last env.name_rel (n-1), n)
+
+  let get_construct_info env c =
+    try Hashtbl.find env.construct_tbl c
+    with Not_found ->
+      let ((mind,j), i) = c in
+      let oib = lookup_mind mind env.global_env in
+      let oip = oib.mind_packets.(j) in
+      check_compilable oip;
+      let tag,arity = oip.mind_reloc_tbl.(i-1) in
+      let nparams = oib.mind_nparams in
+      let r = (tag, nparams, arity) in
+      Hashtbl.add env.construct_tbl c r;
+      r
+end
+
+open Renv
+
+let rec lambda_of_constr env c =
+  match Constr.kind c with
+  | Meta _ -> raise (Invalid_argument "Cbytegen.lambda_of_constr: Meta")
+  | Evar _ -> raise (Invalid_argument "Cbytegen.lambda_of_constr : Evar")
+
+  | Cast (c, _, _) -> lambda_of_constr env c
+
+  | Rel i -> Renv.get env i
+
+  | Var id -> Lvar id
+
+  | Sort s -> Lsort s
+  | Ind ind -> Lind ind
+
+  | Prod(id, dom, codom) ->
+    let ld = lambda_of_constr env dom in
+    Renv.push_rel env id;
+    let lc = lambda_of_constr env codom in
+    Renv.pop env;
+    Lprod(ld,  Llam([|id|], lc))
+
+  | Lambda _ ->
+    let params, body = decompose_lam c in
+    let ids = get_names (List.rev params) in
+    Renv.push_rels env ids;
+    let lb = lambda_of_constr env body in
+    Renv.popn env (Array.length ids);
+    mkLlam ids lb
+
+  | LetIn(id, def, _, body) ->
+    let ld = lambda_of_constr env def in
+    Renv.push_rel env id;
+    let lb = lambda_of_constr env body in
+    Renv.pop env;
+    Llet(id, ld, lb)
+
+  | App(f, args) -> lambda_of_app env f args
+
+  | Const _ -> lambda_of_app env c empty_args
+
+  | Construct _ ->  lambda_of_app env c empty_args
+
+  | Case(ci,t,a,branches) ->
+    let ind = ci.ci_ind in
+    let mib = lookup_mind (fst ind) env.global_env in
+    let oib = mib.mind_packets.(snd ind) in
+    let () = check_compilable oib in
+    let rtbl = oib.mind_reloc_tbl in
+
+
+    (* translation of the argument *)
+    let la = lambda_of_constr env a in
+    let entry = mkInd ind in
+    let la =
+      try
+        Retroknowledge.get_vm_before_match_info env.global_env.retroknowledge
+          entry la
+      with Not_found -> la
+    in
+    (* translation of the type *)
+    let lt = lambda_of_constr env t in
+    (* translation of branches *)
+    let consts = Array.make oib.mind_nb_constant dummy_lambda in
+    let blocks = Array.make oib.mind_nb_args ([||],dummy_lambda) in
+    for i = 0 to Array.length rtbl - 1 do
+      let tag, arity = rtbl.(i) in
+      let b = lambda_of_constr env branches.(i) in
+      if arity = 0 then consts.(tag) <- b
+      else
+        let b =
+          match b with
+          | Llam(ids, body) when Array.length ids = arity -> (ids, body)
+          | _ ->
+            let ids = Array.make arity Anonymous in
+            let args = make_args arity 1 in
+            let ll = lam_lift arity b in
+            (ids, mkLapp  ll args)
+        in blocks.(tag-1) <- b
+    done;
+    let branches =
+      { constant_branches = consts;
+        nonconstant_branches = blocks }
+    in
+    Lcase(ci, rtbl, lt, la, branches)
+
+  | Fix(rec_init,(names,type_bodies,rec_bodies)) ->
+    let ltypes = lambda_of_args env 0 type_bodies in
+    Renv.push_rels env names;
+    let lbodies = lambda_of_args env 0 rec_bodies in
+    Renv.popn env (Array.length names);
+    Lfix(rec_init, (names, ltypes, lbodies))
+
+  | CoFix(init,(names,type_bodies,rec_bodies)) ->
+    let ltypes = lambda_of_args env 0 type_bodies in
+    Renv.push_rels env names;
+    let lbodies = lambda_of_args env 0 rec_bodies in
+    Renv.popn env (Array.length names);
+    Lcofix(init, (names, ltypes, lbodies))
+
+  | Proj (p,c) ->
+    let kn = Projection.constant p in
+    let cb = lookup_constant kn env.global_env in
+    let pb = Option.get cb.const_proj in
+    let n = pb.proj_arg in
+    let lc = lambda_of_constr env c in
+    Lproj (n,kn,lc)
+
+and lambda_of_app env f args =
+  match Constr.kind f with
+  | Const (kn,u as c) ->
+    let kn = get_alias env.global_env kn in
+    (* spiwack: checks if there is a specific way to compile the constant
+                if there is not, Not_found is raised, and the function
+                falls back on its normal behavior *)
+    (try
+      (* We delay the compilation of arguments to avoid an exponential behavior *)
+      let f = Retroknowledge.get_vm_compiling_info env.global_env.retroknowledge
+          (mkConstU (kn,u)) in
+      let args = lambda_of_args env 0 args in
+      f args
+    with Not_found ->
+    let cb = lookup_constant kn env.global_env in
+    begin match cb.const_body with
+      | Def csubst when cb.const_inline_code ->
+        lambda_of_app env (Mod_subst.force_constr csubst) args
+      | Def _ | OpaqueDef _ | Undef _ -> mkLapp (Lconst c) (lambda_of_args env 0 args)
+    end)
+  | Construct (c,_) ->
+    let tag, nparams, arity = Renv.get_construct_info env c in
+    let nargs = Array.length args in
+    if Int.equal (nparams + arity) nargs then (* fully applied *)
+      (* spiwack: *)
+      (* 1/ tries to compile the constructor in an optimal way,
+            it is supposed to work only if the arguments are
+            all fully constructed, fails with Cbytecodes.NotClosed.
+            it can also raise Not_found when there is no special
+            treatment for this constructor
+            for instance: tries to to compile an integer of the
+                form I31 D1 D2 ... D31 to [D1D2...D31] as
+                a processor number (a caml number actually) *)
+      try
+        try
+          Retroknowledge.get_vm_constant_static_info
+            env.global_env.retroknowledge
+            f args
+        with NotClosed ->
+          (* 2/ if the arguments are not all closed (this is
+                              expectingly (and it is currently the case) the only
+                              reason why this exception is raised) tries to
+                              give a clever, run-time behavior to the constructor.
+                              Raises Not_found if there is no special treatment
+                              for this integer.
+                              this is done in a lazy fashion, using the constructor
+                              Bspecial because it needs to know the continuation
+                              and such, which can't be done at this time.
+                              for instance, for int31: if one of the digit is
+                                  not closed, it's not impossible that the number
+                                  gets fully instanciated at run-time, thus to ensure
+                                  uniqueness of the representation in the vm
+                                  it is necessary to try and build a caml integer
+                                  during the execution *)
+          let rargs = Array.sub args nparams arity in
+          let args = lambda_of_args env nparams rargs in
+          Retroknowledge.get_vm_constant_dynamic_info
+            env.global_env.retroknowledge
+            f args
+      with Not_found ->
+        (* 3/ if no special behavior is available, then the compiler
+           falls back to the normal behavior *)
+        let args = lambda_of_args env nparams args in
+        makeblock tag 0 arity args
+    else
+      let args = lambda_of_args env nparams args in
+      (* spiwack: tries first to apply the run-time compilation
+                behavior of the constructor, as in 2/ above *)
+      (try
+         (Retroknowledge.get_vm_constant_dynamic_info
+            env.global_env.retroknowledge
+            f) args
+       with Not_found ->
+         if nparams <= nargs then (* got all parameters *)
+           makeblock tag 0 arity args
+         else (* still expecting some parameters *)
+           makeblock tag (nparams - nargs) arity empty_args)
+  | _ ->
+    let f = lambda_of_constr env f in
+    let args = lambda_of_args env 0 args in
+    mkLapp f args
+
+and lambda_of_args env start args =
+  let nargs = Array.length args in
+  if start < nargs then
+    Array.init (nargs - start)
+      (fun i -> lambda_of_constr env args.(start + i))
+  else empty_args
+
+
+
+
+(*********************************)
+
+
+let optimize_lambda lam =
+  let lam = simplify subst_id lam in
+  remove_let subst_id lam
+
+let lambda_of_constr ~optimize genv c =
+  let env = Renv.make genv in
+  let ids = List.rev_map Context.Rel.Declaration.get_name genv.env_rel_context.env_rel_ctx in
+  Renv.push_rels env (Array.of_list ids);
+  let lam = lambda_of_constr env c in
+  let lam = if optimize then optimize_lambda lam else lam in
+  if !Flags.dump_lambda then
+    Feedback.msg_debug (pp_lam lam);
+  lam
+
+(** Retroknowledge, to be removed once we move to primitive machine integers *)
+let compile_structured_int31 fc args =
+  if not fc then raise Not_found else
+    Luint (UintVal
+    (Uint31.of_int (Array.fold_left
+       (fun temp_i -> fun t -> match kind t with
+          | Construct ((_,d),_) -> 2*temp_i+d-1
+          | _ -> raise NotClosed)
+       0 args)))
+
+let dynamic_int31_compilation fc args =
+  if not fc then raise Not_found else
+  Luint (UintDigits args)
+
+(* We are relying here on the tags of digits constructors *)
+let digits_from_uint i =
+  let d0 = mkConst_b0 0 in
+  let d1 = mkConst_b0 1 in
+  let digits = Array.make 31 d0 in
+  for k = 0 to 30 do
+    if Int.equal ((Uint31.to_int i lsr k) land 1) 1 then
+      digits.(30-k) <- d1
+  done;
+  digits
+
+let int31_escape_before_match fc t =
+  if not fc then
+    raise Not_found
+  else
+  match t with
+  | Luint (UintVal i) ->
+    let digits = digits_from_uint i in
+    Lmakeblock (1, digits)
+  | Luint (UintDigits args) ->
+    Lmakeblock (1,args)
+  | Luint (UintDecomp _) ->
+    assert false
+  | _ -> Luint (UintDecomp t)
diff --git a/kernel/clambda.mli b/kernel/clambda.mli
new file mode 100644
index 000000000..89b7fd8e3
--- /dev/null
+++ b/kernel/clambda.mli
@@ -0,0 +1,27 @@
+open Names
+open Cinstr
+
+exception TooLargeInductive of Pp.t
+
+val lambda_of_constr : optimize:bool -> Pre_env.env -> Constr.t -> lambda
+
+val decompose_Llam : lambda -> Name.t array * lambda
+
+val get_alias : Pre_env.env -> Constant.t -> Constant.t
+
+val compile_prim : int -> Cbytecodes.instruction -> Constr.pconstant -> bool -> lambda array -> lambda
+
+(** spiwack: this function contains the information needed to perform
+            the static compilation of int31 (trying and obtaining
+            a 31-bit integer in processor representation at compile time) *)
+val compile_structured_int31 : bool -> Constr.t array -> lambda
+
+(** this function contains the information needed to perform
+        the dynamic compilation of int31 (trying and obtaining a
+        31-bit integer in processor representation at runtime when
+        it failed at compile time *)
+val dynamic_int31_compilation : bool -> lambda array -> lambda
+
+(*spiwack: compiling function to insert dynamic decompilation before
+           matching integers (in case they are in processor representation) *)
+val int31_escape_before_match : bool -> lambda -> lambda
diff --git a/kernel/constr.ml b/kernel/constr.ml
index c3e609536..1ff1fcc4c 100644
--- a/kernel/constr.ml
+++ b/kernel/constr.ml
@@ -75,7 +75,7 @@ type ('constr, 'types) pfixpoint =
 type ('constr, 'types) pcofixpoint =
     int * ('constr, 'types) prec_declaration
 type 'a puniverses = 'a Univ.puniverses
-type pconstant = constant puniverses
+type pconstant = Constant.t puniverses
 type pinductive = inductive puniverses
 type pconstructor = constructor puniverses
 
@@ -92,7 +92,7 @@ type ('constr, 'types, 'sort, 'univs) kind_of_term =
   | Lambda    of Name.t * 'types * 'constr
   | LetIn     of Name.t * 'constr * 'types * 'constr
   | App       of 'constr * 'constr array
-  | Const     of (constant * 'univs)
+  | Const     of (Constant.t * 'univs)
   | Ind       of (inductive * 'univs)
   | Construct of (constructor * 'univs)
   | Case      of case_info * 'constr * 'constr * 'constr array
@@ -233,7 +233,6 @@ let mkMeta  n =  Meta n
 (* Constructs a Variable named id *)
 let mkVar id = Var id
 
-
 (************************************************************************)
 (*    kind_of_term = constructions as seen by the user                 *)
 (************************************************************************)
@@ -250,6 +249,168 @@ let of_kind = function
 | Cast (c, knd, t) -> mkCast (c, knd, t)
 | k -> k
 
+(**********************************************************************)
+(*          Non primitive term destructors                            *)
+(**********************************************************************)
+
+(* Destructor operations : partial functions
+   Raise [DestKO] if the const has not the expected form *)
+
+exception DestKO
+
+let isMeta c = match kind c with Meta _ -> true | _ -> false
+
+(* Destructs a type *)
+let isSort c = match kind c with
+  | Sort _ -> true
+  | _ -> false
+
+let rec isprop c = match kind c with
+  | Sort (Sorts.Prop _) -> true
+  | Cast (c,_,_) -> isprop c
+  | _ -> false
+
+let rec is_Prop c = match kind c with
+  | Sort (Sorts.Prop Sorts.Null) -> true
+  | Cast (c,_,_) -> is_Prop c
+  | _ -> false
+
+let rec is_Set c = match kind c with
+  | Sort (Sorts.Prop Sorts.Pos) -> true
+  | Cast (c,_,_) -> is_Set c
+  | _ -> false
+
+let rec is_Type c = match kind c with
+  | Sort (Sorts.Type _) -> true
+  | Cast (c,_,_) -> is_Type c
+  | _ -> false
+
+let is_small = Sorts.is_small
+let iskind c = isprop c || is_Type c
+
+(* Tests if an evar *)
+let isEvar c = match kind c with Evar _ -> true | _ -> false
+let isEvar_or_Meta c = match kind c with
+  | Evar _ | Meta _ -> true
+  | _ -> false
+
+let isCast c = match kind c with Cast _ -> true | _ -> false
+(* Tests if a de Bruijn index *)
+let isRel c = match kind c with Rel _ -> true | _ -> false
+let isRelN n c =
+  match kind c with Rel n' -> Int.equal n n' | _ -> false
+(* Tests if a variable *)
+let isVar c = match kind c with Var _ -> true | _ -> false
+let isVarId id c = match kind c with Var id' -> Id.equal id id' | _ -> false
+(* Tests if an inductive *)
+let isInd c = match kind c with Ind _ -> true | _ -> false
+let isProd c = match kind c with | Prod _ -> true | _ -> false
+let isLambda c = match kind c with | Lambda _ -> true | _ -> false
+let isLetIn c =  match kind c with LetIn _ -> true | _ -> false
+let isApp c = match kind c with App _ -> true | _ -> false
+let isConst c = match kind c with Const _ -> true | _ -> false
+let isConstruct c = match kind c with Construct _ -> true | _ -> false
+let isCase c =  match kind c with Case _ -> true | _ -> false
+let isProj c =  match kind c with Proj _ -> true | _ -> false
+let isFix c =  match kind c with Fix _ -> true | _ -> false
+let isCoFix c =  match kind c with CoFix _ -> true | _ -> false
+
+(* Destructs a de Bruijn index *)
+let destRel c = match kind c with
+  | Rel n -> n
+  | _ -> raise DestKO
+
+(* Destructs an existential variable *)
+let destMeta c = match kind c with
+  | Meta n -> n
+  | _ -> raise DestKO
+
+(* Destructs a variable *)
+let destVar c = match kind c with
+  | Var id -> id
+  | _ -> raise DestKO
+
+let destSort c = match kind c with
+  | Sort s -> s
+  | _ -> raise DestKO
+
+(* Destructs a casted term *)
+let destCast c = match kind c with
+  | Cast (t1,k,t2) -> (t1,k,t2)
+  | _ -> raise DestKO
+
+(* Destructs the product (x:t1)t2 *)
+let destProd c = match kind c with
+  | Prod (x,t1,t2) -> (x,t1,t2)
+  | _ -> raise DestKO
+
+(* Destructs the abstraction [x:t1]t2 *)
+let destLambda c = match kind c with
+  | Lambda (x,t1,t2) -> (x,t1,t2)
+  | _ -> raise DestKO
+
+(* Destructs the let [x:=b:t1]t2 *)
+let destLetIn c = match kind c with
+  | LetIn (x,b,t1,t2) -> (x,b,t1,t2)
+  | _ -> raise DestKO
+
+(* Destructs an application *)
+let destApp c = match kind c with
+  | App (f,a) -> (f, a)
+  | _ -> raise DestKO
+
+(* Destructs a constant *)
+let destConst c = match kind c with
+  | Const kn -> kn
+  | _ -> raise DestKO
+
+(* Destructs an existential variable *)
+let destEvar c = match kind c with
+  | Evar (kn, a as r) -> r
+  | _ -> raise DestKO
+
+(* Destructs a (co)inductive type named kn *)
+let destInd c = match kind c with
+  | Ind (kn, a as r) -> r
+  | _ -> raise DestKO
+
+(* Destructs a constructor *)
+let destConstruct c = match kind c with
+  | Construct (kn, a as r) -> r
+  | _ -> raise DestKO
+
+(* Destructs a term <p>Case c of lc1 | lc2 .. | lcn end *)
+let destCase c = match kind c with
+  | Case (ci,p,c,v) -> (ci,p,c,v)
+  | _ -> raise DestKO
+
+let destProj c = match kind c with
+  | Proj (p, c) -> (p, c)
+  | _ -> raise DestKO
+
+let destFix c = match kind c with
+  | Fix fix -> fix
+  | _ -> raise DestKO
+
+let destCoFix c = match kind c with
+  | CoFix cofix -> cofix
+  | _ -> raise DestKO
+
+
+(******************************************************************)
+(* Flattening and unflattening of embedded applications and casts *)
+(******************************************************************)
+
+let decompose_app c =
+  match kind c with
+    | App (f,cl) -> (f, Array.to_list cl)
+    | _ -> (c,[])
+
+let decompose_appvect c =
+  match kind c with
+    | App (f,cl) -> (f, cl)
+    | _ -> (c,[||])
+
 (****************************************************************************)
 (*              Functions to recur through subterms                         *)
 (****************************************************************************)
@@ -513,6 +674,7 @@ let compare_head_gen_leq_with kind1 kind2 eq_universes leq_sorts eq leq t1 t2 =
   | Prod (_,t1,c1), Prod (_,t2,c2) -> eq t1 t2 && leq c1 c2
   | Lambda (_,t1,c1), Lambda (_,t2,c2) -> eq t1 t2 && eq c1 c2
   | LetIn (_,b1,t1,c1), LetIn (_,b2,t2,c2) -> eq b1 b2 && eq t1 t2 && leq c1 c2
+  (* Why do we suddenly make a special case for Cast here? *)
   | App (Cast(c1, _, _),l1), _ -> leq (mkApp (c1,l1)) t2
   | _, App (Cast (c2, _, _),l2) -> leq t1 (mkApp (c2,l2))
   | App (c1,l1), App (c2,l2) ->
@@ -520,7 +682,7 @@ let compare_head_gen_leq_with kind1 kind2 eq_universes leq_sorts eq leq t1 t2 =
         eq c1 c2 && Array.equal_norefl eq l1 l2
   | Proj (p1,c1), Proj (p2,c2) -> Projection.equal p1 p2 && eq c1 c2
   | Evar (e1,l1), Evar (e2,l2) -> Evar.equal e1 e2 && Array.equal eq l1 l2
-  | Const (c1,u1), Const (c2,u2) -> eq_constant c1 c2 && eq_universes true u1 u2
+  | Const (c1,u1), Const (c2,u2) -> Constant.equal c1 c2 && eq_universes true u1 u2
   | Ind (c1,u1), Ind (c2,u2) -> eq_ind c1 c2 && eq_universes false u1 u2
   | Construct (c1,u1), Construct (c2,u2) -> eq_constructor c1 c2 && eq_universes false u1 u2
   | Case (_,p1,c1,bl1), Case (_,p2,c2,bl2) ->
@@ -530,7 +692,9 @@ let compare_head_gen_leq_with kind1 kind2 eq_universes leq_sorts eq leq t1 t2 =
       && Array.equal_norefl eq tl1 tl2 && Array.equal_norefl eq bl1 bl2
   | CoFix(ln1,(_,tl1,bl1)), CoFix(ln2,(_,tl2,bl2)) ->
       Int.equal ln1 ln2 && Array.equal_norefl eq tl1 tl2 && Array.equal_norefl eq bl1 bl2
-  | _ -> false
+  | (Rel _ | Meta _ | Var _ | Sort _ | Prod _ | Lambda _ | LetIn _ | App _
+     | Proj _ | Evar _ | Const _ | Ind _ | Construct _ | Case _ | Fix _
+     | CoFix _), _ -> false
 
 (* [compare_head_gen_leq u s eq leq c1 c2] compare [c1] and [c2] using [eq] to compare
    the immediate subterms of [c1] of [c2] for conversion if needed, [leq] for cumulativity,
@@ -650,9 +814,6 @@ let always_true _ _ = true
 let rec eq_constr_nounivs m n =
   (m == n) || compare_head_gen (fun _ -> always_true) always_true eq_constr_nounivs m n
 
-(** We only use this function over blocks! *)
-let tag t = Obj.tag (Obj.repr t)
-
 let constr_ord_int f t1 t2 =
   let (=?) f g i1 i2 j1 j2=
     let c = f i1 i2 in
@@ -664,35 +825,50 @@ let constr_ord_int f t1 t2 =
     ((Array.compare Int.compare) =? Int.compare) a1 a2 i1 i2
   in
   match kind t1, kind t2 with
+    | Cast (c1,_,_), _ -> f c1 t2
+    | _, Cast (c2,_,_) -> f t1 c2
+    (* Why this special case? *)
+    | App (Cast(c1,_,_),l1), _ -> f (mkApp (c1,l1)) t2
+    | _, App (Cast(c2, _,_),l2) -> f t1 (mkApp (c2,l2))
     | Rel n1, Rel n2 -> Int.compare n1 n2
-    | Meta m1, Meta m2 -> Int.compare m1 m2
+    | Rel _, _ -> -1 | _, Rel _ -> 1
     | Var id1, Var id2 -> Id.compare id1 id2
+    | Var _, _ -> -1 | _, Var _ -> 1
+    | Meta m1, Meta m2 -> Int.compare m1 m2
+    | Meta _, _ -> -1 | _, Meta _ -> 1
+    | Evar (e1,l1), Evar (e2,l2) ->
+        (Evar.compare =? (Array.compare f)) e1 e2 l1 l2
+    | Evar _, _ -> -1 | _, Evar _ -> 1
     | Sort s1, Sort s2 -> Sorts.compare s1 s2
-    | Cast (c1,_,_), _ -> f c1 t2
-    | _, Cast (c2,_,_) -> f t1 c2
+    | Sort _, _ -> -1 | _, Sort _ -> 1
     | Prod (_,t1,c1), Prod (_,t2,c2)
     | Lambda (_,t1,c1), Lambda (_,t2,c2) ->
         (f =? f) t1 t2 c1 c2
+    | Prod _, _ -> -1 | _, Prod _ -> 1
+    | Lambda _, _ -> -1 | _, Lambda _ -> 1
     | LetIn (_,b1,t1,c1), LetIn (_,b2,t2,c2) ->
         ((f =? f) ==? f) b1 b2 t1 t2 c1 c2
-    | App (Cast(c1,_,_),l1), _ -> f (mkApp (c1,l1)) t2
-    | _, App (Cast(c2, _,_),l2) -> f t1 (mkApp (c2,l2))
+    | LetIn _, _ -> -1 | _, LetIn _ -> 1
     | App (c1,l1), App (c2,l2) -> (f =? (Array.compare f)) c1 c2 l1 l2
-    | Proj (p1,c1), Proj (p2,c2) -> (Projection.compare =? f) p1 p2 c1 c2
-    | Evar (e1,l1), Evar (e2,l2) ->
-        (Evar.compare =? (Array.compare f)) e1 e2 l1 l2
-    | Const (c1,u1), Const (c2,u2) -> con_ord c1 c2
+    | App _, _ -> -1 | _, App _ -> 1
+    | Const (c1,u1), Const (c2,u2) -> Constant.CanOrd.compare c1 c2
+    | Const _, _ -> -1 | _, Const _ -> 1
     | Ind (ind1, u1), Ind (ind2, u2) -> ind_ord ind1 ind2
+    | Ind _, _ -> -1 | _, Ind _ -> 1
     | Construct (ct1,u1), Construct (ct2,u2) -> constructor_ord ct1 ct2
+    | Construct _, _ -> -1 | _, Construct _ -> 1
     | Case (_,p1,c1,bl1), Case (_,p2,c2,bl2) ->
         ((f =? f) ==? (Array.compare f)) p1 p2 c1 c2 bl1 bl2
+    | Case _, _ -> -1 | _, Case _ -> 1
     | Fix (ln1,(_,tl1,bl1)), Fix (ln2,(_,tl2,bl2)) ->
         ((fix_cmp =? (Array.compare f)) ==? (Array.compare f))
         ln1 ln2 tl1 tl2 bl1 bl2
+    | Fix _, _ -> -1 | _, Fix _ -> 1
     | CoFix(ln1,(_,tl1,bl1)), CoFix(ln2,(_,tl2,bl2)) ->
         ((Int.compare =? (Array.compare f)) ==? (Array.compare f))
         ln1 ln2 tl1 tl2 bl1 bl2
-    | t1, t2 -> Int.compare (tag t1) (tag t2)
+    | CoFix _, _ -> -1 | _, CoFix _ -> 1
+    | Proj (p1,c1), Proj (p2,c2) -> (Projection.compare =? f) p1 p2 c1 c2
 
 let rec compare m n=
   constr_ord_int compare m n
@@ -776,7 +952,9 @@ let hasheq t1 t2 =
       && array_eqeq lna1 lna2
       && array_eqeq tl1 tl2
       && array_eqeq bl1 bl2
-    | _ -> false
+    | (Rel _ | Meta _ | Var _ | Sort _ | Cast _ | Prod _ | Lambda _ | LetIn _
+      | App _ | Proj _ | Evar _ | Const _ | Ind _ | Construct _ | Case _
+      | Fix _ | CoFix _), _ -> false
 
 (** Note that the following Make has the side effect of creating
     once and for all the table we'll use for hash-consing all constr *)
@@ -1000,8 +1178,3 @@ let hcons =
      Id.hcons)
 
 (* let hcons_types = hcons_constr *)
-
-(*******)
-(* Type of abstract machine values *)
-(** FIXME: nothing to do there *)
-type values
diff --git a/kernel/constr.mli b/kernel/constr.mli
index 76dbf5530..19ffa8fe3 100644
--- a/kernel/constr.mli
+++ b/kernel/constr.mli
@@ -13,20 +13,22 @@ open Names
 
 (** {6 Value under universe substitution } *)
 type 'a puniverses = 'a Univ.puniverses
+[@@ocaml.deprecated "use Univ.puniverses"]
 
 (** {6 Simply type aliases } *)
-type pconstant = constant puniverses
-type pinductive = inductive puniverses
-type pconstructor = constructor puniverses
+type pconstant = Constant.t Univ.puniverses
+type pinductive = inductive Univ.puniverses
+type pconstructor = constructor Univ.puniverses
 
 (** {6 Existential variables } *)
 type existential_key = Evar.t
+[@@ocaml.deprecated "use Evar.t"]
 
 (** {6 Existential variables } *)
 type metavariable = int
 
 (** {6 Case annotation } *)
-type case_style = LetStyle | IfStyle | LetPatternStyle | MatchStyle 
+type case_style = LetStyle | IfStyle | LetPatternStyle | MatchStyle
   | RegularStyle (** infer printing form from number of constructor *)
 type case_printing =
   { ind_tags : bool list; (** tell whether letin or lambda in the arity of the inductive type *)
@@ -80,14 +82,14 @@ val mkVar : Id.t -> constr
 val mkMeta : metavariable -> constr
 
 (** Constructs an existential variable *)
-type existential = existential_key * constr array
+type existential = Evar.t * constr array
 val mkEvar : existential -> constr
 
 (** Construct a sort *)
 val mkSort : Sorts.t -> types
 val mkProp : types
 val mkSet  : types
-val mkType : Univ.universe -> types
+val mkType : Univ.Universe.t -> types
 
 
 (** This defines the strategy to use for verifiying a Cast *)
@@ -111,10 +113,10 @@ val mkLetIn : Name.t * constr * types * constr -> constr
     {%latex:$(f~t_1\dots f_n)$%}. *)
 val mkApp : constr * constr array -> constr
 
-val map_puniverses : ('a -> 'b) -> 'a puniverses -> 'b puniverses
+val map_puniverses : ('a -> 'b) -> 'a Univ.puniverses -> 'b Univ.puniverses
 
-(** Constructs a constant *)
-val mkConst : constant -> constr
+(** Constructs a Constant.t *)
+val mkConst : Constant.t -> constr
 val mkConstU : pconstant -> constr
 
 (** Constructs a projection application *)
@@ -180,7 +182,7 @@ val mkCoFix : cofixpoint -> constr
 
 (** [constr array] is an instance matching definitional [named_context] in
    the same order (i.e. last argument first) *)
-type 'constr pexistential = existential_key * 'constr array
+type 'constr pexistential = Evar.t * 'constr array
 type ('constr, 'types) prec_declaration =
     Name.t array * 'types array * 'constr array
 type ('constr, 'types) pfixpoint =
@@ -201,14 +203,14 @@ type ('constr, 'types, 'sort, 'univs) kind_of_term =
   | Cast      of 'constr * cast_kind * 'types
   | Prod      of Name.t * 'types * 'types             (** Concrete syntax ["forall A:B,C"] is represented as [Prod (A,B,C)]. *)
   | 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)]. *)
+  | LetIn     of Name.t * 'constr * 'types * 'constr  (** Concrete syntax ["let A:C := B 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 * 'univs)                  (** Gallina-variable that was introduced by Vernacular-command that extends the global environment
+  | Const     of (Constant.t * 'univs)                  (** 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 * 'univs)                 (** A name of an inductive type defined by [Variant], [Inductive] or [Record] Vernacular-commands. *)
@@ -225,6 +227,110 @@ type ('constr, 'types, 'sort, 'univs) kind_of_term =
 val kind : constr -> (constr, types, Sorts.t, Univ.Instance.t) kind_of_term
 val of_kind : (constr, types, Sorts.t, Univ.Instance.t) kind_of_term -> constr
 
+(** {6 Simple case analysis} *)
+val isRel  : constr -> bool
+val isRelN : int -> constr -> bool
+val isVar  : constr -> bool
+val isVarId : Id.t -> constr -> bool
+val isInd  : constr -> bool
+val isEvar : constr -> bool
+val isMeta : constr -> bool
+val isEvar_or_Meta : constr -> bool
+val isSort : constr -> bool
+val isCast : constr -> bool
+val isApp : constr -> bool
+val isLambda : constr -> bool
+val isLetIn : constr -> bool
+val isProd : constr -> bool
+val isConst : constr -> bool
+val isConstruct : constr -> bool
+val isFix : constr -> bool
+val isCoFix : constr -> bool
+val isCase : constr -> bool
+val isProj : constr -> bool
+
+val is_Prop : constr -> bool
+val is_Set  : constr -> bool
+val isprop : constr -> bool
+val is_Type : constr -> bool
+val iskind : constr -> bool
+val is_small : Sorts.t -> bool
+
+(** {6 Term destructors } *)
+(** Destructor operations are partial functions and
+    @raise DestKO if the term has not the expected form. *)
+
+exception DestKO
+
+(** Destructs a de Bruijn index *)
+val destRel : constr -> int
+
+(** Destructs an existential variable *)
+val destMeta : constr -> metavariable
+
+(** Destructs a variable *)
+val destVar : constr -> Id.t
+
+(** Destructs a sort. [is_Prop] recognizes the sort {% \textsf{%}Prop{% }%}, whether
+   [isprop] recognizes both {% \textsf{%}Prop{% }%} and {% \textsf{%}Set{% }%}. *)
+val destSort : constr -> Sorts.t
+
+(** Destructs a casted term *)
+val destCast : constr -> constr * cast_kind * constr
+
+(** Destructs the product {% $ %}(x:t_1)t_2{% $ %} *)
+val destProd : types -> Name.t * types * types
+
+(** Destructs the abstraction {% $ %}[x:t_1]t_2{% $ %} *)
+val destLambda : constr -> Name.t * types * constr
+
+(** Destructs the let {% $ %}[x:=b:t_1]t_2{% $ %} *)
+val destLetIn : constr -> Name.t * constr * types * constr
+
+(** Destructs an application *)
+val destApp : constr -> constr * constr array
+
+(** Decompose any term as an applicative term; the list of args can be empty *)
+val decompose_app : constr -> constr * constr list
+
+(** Same as [decompose_app], but returns an array. *)
+val decompose_appvect : constr -> constr * constr array
+
+(** Destructs a constant *)
+val destConst : constr -> Constant.t Univ.puniverses
+
+(** Destructs an existential variable *)
+val destEvar : constr -> existential
+
+(** Destructs a (co)inductive type *)
+val destInd : constr -> inductive Univ.puniverses
+
+(** Destructs a constructor *)
+val destConstruct : constr -> constructor Univ.puniverses
+
+(** Destructs a [match c as x in I args return P with ... |
+Ci(...yij...) => ti | ... end] (or [let (..y1i..) := c as x in I args
+return P in t1], or [if c then t1 else t2])
+@return [(info,c,fun args x => P,[|...|fun yij => ti| ...|])]
+where [info] is pretty-printing information *)
+val destCase : constr -> case_info * constr * constr * constr array
+
+(** Destructs a projection *)
+val destProj : constr -> projection * constr
+
+(** Destructs the {% $ %}i{% $ %}th function of the block
+   [Fixpoint f{_ 1} ctx{_ 1} = b{_ 1}
+    with    f{_ 2} ctx{_ 2} = b{_ 2}
+    ...
+    with    f{_ n} ctx{_ n} = b{_ n}],
+   where the length of the {% $ %}j{% $ %}th context is {% $ %}ij{% $ %}.
+*)
+val destFix : constr -> fixpoint
+
+val destCoFix : constr -> cofixpoint
+
+(** {6 Equality} *)
+
 (** [equal a b] is true if [a] equals [b] modulo alpha, casts,
    and application grouping *)
 val equal : constr -> constr -> bool
@@ -302,7 +408,7 @@ val compare_head : (constr -> constr -> bool) -> constr -> constr -> bool
 
 (** [compare_head_gen u s f c1 c2] compare [c1] and [c2] using [f] to compare
    the immediate subterms of [c1] of [c2] if needed, [u] to compare universe
-   instances (the first boolean tells if they belong to a constant), [s] to 
+   instances (the first boolean tells if they belong to a Constant.t), [s] to 
    compare sorts; Cast's, binders name and Cases annotations are not taken 
     into account *)
 
@@ -335,7 +441,7 @@ val compare_head_gen_with :
 (** [compare_head_gen_leq u s f fle c1 c2] compare [c1] and [c2] using
     [f] to compare the immediate subterms of [c1] of [c2] for
     conversion, [fle] for cumulativity, [u] to compare universe
-    instances (the first boolean tells if they belong to a constant),
+    instances (the first boolean tells if they belong to a Constant.t),
     [s] to compare sorts for for subtyping; Cast's, binders name and
     Cases annotations are not taken into account *)
 
@@ -344,7 +450,7 @@ val compare_head_gen_leq : (bool -> Univ.Instance.t -> Univ.Instance.t -> bool)
   (constr -> constr -> bool) ->
   (constr -> constr -> bool) ->
   constr -> constr -> bool
-  
+
 (** {6 Hashconsing} *)
 
 val hash : constr -> int
@@ -353,7 +459,3 @@ val case_info_hash : case_info -> int
 (*********************************************************************)
 
 val hcons : constr -> constr
-
-(**************************************)
-
-type values
diff --git a/kernel/context.ml b/kernel/context.ml
index 929324efe..d635c4515 100644
--- a/kernel/context.ml
+++ b/kernel/context.ml
@@ -379,8 +379,9 @@ struct
   (** Return the number of {e local declarations} in a given named-context. *)
   let length = List.length
 
-(** Return a declaration designated by a given de Bruijn index.
-    @raise Not_found if the designated identifier is not present in the designated named-context. *)   let rec lookup id = function
+(** Return a declaration designated by a given identifier
+    @raise Not_found if the designated identifier is not present in the designated named-context. *)
+  let rec lookup id = function
     | decl :: _ when Id.equal id (Declaration.get_id decl) -> decl
     | _ :: sign -> lookup id sign
     | [] -> raise Not_found
diff --git a/kernel/conv_oracle.mli b/kernel/conv_oracle.mli
index 248cd2b30..02c179ab6 100644
--- a/kernel/conv_oracle.mli
+++ b/kernel/conv_oracle.mli
@@ -16,7 +16,7 @@ val empty : oracle
    If [oracle_order kn1 kn2] is true, then unfold kn1 first.
    Note: the oracle does not introduce incompleteness, it only
    tries to postpone unfolding of "opaque" constants. *)
-val oracle_order : ('a -> constant) -> oracle -> bool -> 
+val oracle_order : ('a -> Constant.t) -> oracle -> bool -> 
   'a tableKey -> 'a tableKey -> bool
 
 (** Priority for the expansion of constant in the conversion test.
@@ -30,14 +30,14 @@ val transparent : level
 (** Check whether a level is transparent *)
 val is_transparent : level -> bool
 
-val get_strategy : oracle -> constant tableKey -> level
+val get_strategy : oracle -> Constant.t tableKey -> level
 
 (** Sets the level of a constant.
  * Level of RelKey constant cannot be set. *)
-val set_strategy : oracle -> constant tableKey -> level -> oracle
+val set_strategy : oracle -> Constant.t tableKey -> level -> oracle
 
 (** Fold over the non-transparent levels of the oracle. Order unspecified. *)
-val fold_strategy : (constant tableKey -> level -> 'a -> 'a) -> oracle -> 'a -> 'a
+val fold_strategy : (Constant.t tableKey -> level -> 'a -> 'a) -> oracle -> 'a -> 'a
 
 val get_transp_state : oracle -> transparent_state
 
diff --git a/kernel/cooking.ml b/kernel/cooking.ml
index 80d41847c..23a578d99 100644
--- a/kernel/cooking.ml
+++ b/kernel/cooking.ml
@@ -17,6 +17,7 @@ open CErrors
 open Util
 open Names
 open Term
+open Constr
 open Declarations
 open Univ
 
@@ -29,15 +30,15 @@ let pop_dirpath p = match DirPath.repr p with
   | _::l -> DirPath.make l
 
 let pop_mind kn =
-  let (mp,dir,l) = Names.repr_mind kn in
-  Names.make_mind mp (pop_dirpath dir) l
+  let (mp,dir,l) = MutInd.repr3 kn in
+  MutInd.make3 mp (pop_dirpath dir) l
 
 let pop_con con =
-  let (mp,dir,l) = Names.repr_con con in
-  Names.make_con mp (pop_dirpath dir) l
+  let (mp,dir,l) = Constant.repr3 con in
+  Constant.make3 mp (pop_dirpath dir) l
 
 type my_global_reference =
-  | ConstRef of constant
+  | ConstRef of Constant.t
   | IndRef of inductive
   | ConstructRef of constructor
 
@@ -100,42 +101,42 @@ let expmod_constr cache modlist c =
   let share_univs = share_univs cache in
   let update_case_info = update_case_info cache in
   let rec substrec c =
-    match kind_of_term c with
+    match kind c with
       | Case (ci,p,t,br) ->
-	  map_constr substrec (mkCase (update_case_info ci modlist,p,t,br))
+	  Constr.map substrec (mkCase (update_case_info ci modlist,p,t,br))
 
       | Ind (ind,u) ->
 	  (try
 	    share_univs (IndRef ind) u modlist
 	   with
-	    | Not_found -> map_constr substrec c)
+	    | Not_found -> Constr.map substrec c)
 
       | Construct (cstr,u) ->
 	  (try
 	     share_univs (ConstructRef cstr) u modlist
 	   with
-	    | Not_found -> map_constr substrec c)
+	    | Not_found -> Constr.map substrec c)
 
       | Const (cst,u) ->
 	  (try
 	    share_univs (ConstRef cst) u modlist
 	   with
-	    | Not_found -> map_constr substrec c)
+	    | Not_found -> Constr.map substrec c)
 
       | Proj (p, c') ->
           (try 
 	     let p' = share_univs (ConstRef (Projection.constant p)) Univ.Instance.empty modlist in
 	     let make c = Projection.make c (Projection.unfolded p) in
-	     match kind_of_term p' with
+	     match kind p' with
 	     | Const (p',_) -> mkProj (make p', substrec c')
 	     | App (f, args) -> 
-	       (match kind_of_term f with 
+	       (match kind f with 
 	       | Const (p', _) -> mkProj (make p', substrec c')
 	       | _ -> assert false)
 	     | _ -> assert false
-	   with Not_found -> map_constr substrec c)
+	   with Not_found -> Constr.map substrec c)
 
-  | _ -> map_constr substrec c
+  | _ -> Constr.map substrec c
 
   in
   if is_empty_modlist modlist then c
@@ -167,43 +168,52 @@ let on_body ml hy f = function
                  { Opaqueproof.modlist = ml; abstract = hy } o)
 
 let expmod_constr_subst cache modlist subst c =
+  let subst = Univ.make_instance_subst subst in
   let c = expmod_constr cache modlist c in
     Vars.subst_univs_level_constr subst c
 
-let cook_constr { Opaqueproof.modlist ; abstract } c =
+let cook_constr { Opaqueproof.modlist ; abstract = (vars, subst, _) } c =
   let cache = RefTable.create 13 in
-  let expmod = expmod_constr_subst cache modlist (pi2 abstract) in
-  let hyps = Context.Named.map expmod (pi1 abstract) in
+  let expmod = expmod_constr_subst cache modlist subst in
+  let hyps = Context.Named.map expmod vars in
   abstract_constant_body (expmod c) hyps
 
-let lift_univs cb subst =
+let lift_univs cb subst auctx0 =
   match cb.const_universes with
-  | Monomorphic_const ctx -> subst, (Monomorphic_const ctx)
-  | Polymorphic_const auctx ->  
-    if (Univ.LMap.is_empty subst) then
-      subst, (Polymorphic_const auctx)
+  | Monomorphic_const ctx ->
+    assert (AUContext.is_empty auctx0);
+    subst, (Monomorphic_const ctx)
+  | Polymorphic_const auctx ->
+    (** Given a named instance [subst := u₀ ... uₙ₋�] together with an abstract
+        context [auctx0 := 0 ... n - 1 |= C{0, ..., n - 1}] of the same length,
+        and another abstract context relative to the former context
+        [auctx := 0 ... m - 1 |= C'{u₀, ..., uₙ₋�, 0, ..., m - 1}],
+        construct the lifted abstract universe context
+        [0 ... n - 1 n ... n + m - 1 |=
+          C{0, ... n - 1} ∪
+          C'{0, ..., n - 1, n, ..., n + m - 1} ]
+        together with the instance
+        [u₀ ... uₙ₋� Var(0) ... Var (m - 1)].
+    *)
+    if (Univ.Instance.is_empty subst) then
+      (** Still need to take the union for the constraints between globals *)
+      subst, (Polymorphic_const (AUContext.union auctx0 auctx))
     else
-      let len = Univ.LMap.cardinal subst in
-      let rec gen_subst i acc =
-        if i < 0 then acc
-        else
-          let acc = Univ.LMap.add (Level.var i) (Level.var (i + len)) acc in
-          gen_subst (pred i) acc
-      in
-      let subst = gen_subst (Univ.AUContext.size auctx - 1) subst in
-      let auctx' = Univ.subst_univs_level_abstract_universe_context subst auctx in
-      subst, (Polymorphic_const auctx')
+      let ainst = Univ.make_abstract_instance auctx in
+      let subst = Instance.append subst ainst in
+      let auctx' = Univ.subst_univs_level_abstract_universe_context (Univ.make_instance_subst subst) auctx in
+      subst, (Polymorphic_const (AUContext.union auctx0 auctx'))
 
 let cook_constant ~hcons env { from = cb; info } =
   let { Opaqueproof.modlist; abstract } = info in
   let cache = RefTable.create 13 in
   let abstract, usubst, abs_ctx = abstract in
-  let usubst, univs = lift_univs cb usubst in
+  let usubst, univs = lift_univs cb usubst abs_ctx in
   let expmod = expmod_constr_subst cache modlist usubst in
   let hyps = Context.Named.map expmod abstract in
   let map c =
     let c = abstract_constant_body (expmod c) hyps in
-    if hcons then hcons_constr c else c
+    if hcons then Constr.hcons c else c
   in
   let body = on_body modlist (hyps, usubst, abs_ctx)
     map
@@ -222,7 +232,7 @@ let cook_constant ~hcons env { from = cb; info } =
     let ((mind, _), _), n' =
       try 
 	let c' = share_univs cache (IndRef (pb.proj_ind,0)) Univ.Instance.empty modlist in
-	  match kind_of_term c' with
+	  match kind c' with
 	  | App (f,l) -> (destInd f, Array.length l)
 	  | Ind ind -> ind, 0
 	  | _ -> assert false 
@@ -233,13 +243,6 @@ let cook_constant ~hcons env { from = cb; info } =
 	proj_eta = etab, etat;
 	proj_type = ty'; proj_body = c' }
   in
-  let univs =
-    match univs with
-    | Monomorphic_const ctx -> 
-      assert (AUContext.is_empty abs_ctx); univs
-    | Polymorphic_const auctx -> 
-      Polymorphic_const (AUContext.union abs_ctx auctx)
-  in
   {
     cook_body = body;
     cook_type = typ;
@@ -249,7 +252,7 @@ let cook_constant ~hcons env { from = cb; info } =
     cook_context = Some const_hyps;
   }
 
-(* let cook_constant_key = Profile.declare_profile "cook_constant" *)
-(* let cook_constant = Profile.profile2 cook_constant_key cook_constant *)
+(* let cook_constant_key = CProfile.declare_profile "cook_constant" *)
+(* let cook_constant = CProfile.profile2 cook_constant_key cook_constant *)
 
 let expmod_constr modlist c = expmod_constr (RefTable.create 13) modlist c
diff --git a/kernel/cooking.mli b/kernel/cooking.mli
index 6d1b776c0..7696d7545 100644
--- a/kernel/cooking.mli
+++ b/kernel/cooking.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Term
+open Constr
 open Declarations
 open Environ
 
@@ -26,7 +26,7 @@ type result = {
 }
 
 val cook_constant : hcons:bool -> env -> recipe -> result
-val cook_constr : Opaqueproof.cooking_info -> Term.constr -> Term.constr
+val cook_constr : Opaqueproof.cooking_info -> constr -> constr
 
 (** {6 Utility functions used in module [Discharge]. } *)
 
diff --git a/kernel/csymtable.ml b/kernel/csymtable.ml
index d21ea9670..236d83576 100644
--- a/kernel/csymtable.ml
+++ b/kernel/csymtable.ml
@@ -14,8 +14,7 @@
 
 open Util
 open Names
-open Term
-open Vm
+open Vmvalues
 open Cemitcodes
 open Cbytecodes
 open Declarations
@@ -25,7 +24,6 @@ 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"
 
 (*******************)
@@ -56,61 +54,12 @@ let set_global v =
 
 (* table pour les structured_constant et les annotations des switchs *)
 
-let rec eq_structured_constant c1 c2 = match c1, c2 with
-| Const_sorts s1, Const_sorts s2 -> Sorts.equal s1 s2
-| Const_sorts _, _ -> false
-| Const_ind i1, Const_ind i2 -> eq_ind i1 i2
-| Const_ind _, _ -> false
-| Const_proj p1, Const_proj p2 -> Constant.equal p1 p2
-| Const_proj _, _ -> false
-| Const_b0 t1, Const_b0 t2 -> Int.equal t1 t2
-| Const_b0 _, _ -> false
-| Const_bn (t1, a1), Const_bn (t2, a2) ->
-  Int.equal t1 t2 && Array.equal eq_structured_constant a1 a2
-| Const_bn _, _ -> false
-| Const_univ_level l1 , Const_univ_level l2 -> Univ.eq_levels l1 l2
-| Const_univ_level _ , _ -> false
-| Const_type u1 , Const_type u2 -> Univ.Universe.equal u1 u2
-| Const_type _ , _ -> false
-
-let rec hash_structured_constant c =
-  let open Hashset.Combine in
-  match c with
-  | Const_sorts s -> combinesmall 1 (Sorts.hash s)
-  | Const_ind i -> combinesmall 2 (ind_hash i)
-  | Const_proj p -> combinesmall 3 (Constant.hash p)
-  | Const_b0 t -> combinesmall 4 (Int.hash t)
-  | Const_bn (t, a) ->
-    let fold h c = combine h (hash_structured_constant c) in
-    let h = Array.fold_left fold 0 a in
-    combinesmall 5 (combine (Int.hash t) h)
-  | Const_univ_level l -> combinesmall 6 (Univ.Level.hash l)
-  | Const_type u -> combinesmall 7 (Univ.Universe.hash u)
-
 module SConstTable = Hashtbl.Make (struct
   type t = structured_constant
   let equal = eq_structured_constant
   let hash = hash_structured_constant
 end)
 
-let eq_annot_switch asw1 asw2 =
-  let eq_ci ci1 ci2 =
-    eq_ind ci1.ci_ind ci2.ci_ind &&
-    Int.equal ci1.ci_npar ci2.ci_npar &&
-    Array.equal Int.equal ci1.ci_cstr_ndecls ci2.ci_cstr_ndecls
-  in
-  let eq_rlc (i1, j1) (i2, j2) = Int.equal i1 i2 && Int.equal j1 j2 in
-  eq_ci asw1.ci asw2.ci &&
-  Array.equal eq_rlc asw1.rtbl asw2.rtbl &&
-  (asw1.tailcall : bool) == asw2.tailcall
-
-let hash_annot_switch asw =
-  let open Hashset.Combine in
-  let h1 = Constr.case_info_hash asw.ci in
-  let h2 = Array.fold_left (fun h (t, i) -> combine3 h t i) 0 asw.rtbl in
-  let h3 = if asw.tailcall then 1 else 0 in
-  combine3 h1 h2 h3
-
 module AnnotTable = Hashtbl.Make (struct
   type t = annot_switch
   let equal = eq_annot_switch
@@ -198,26 +147,24 @@ and slot_for_fv env fv =
       let rv = Pre_env.lookup_rel_val i env in
       begin match force_lazy_val rv with
       | None ->
-	 env.env_rel_context |> Context.Rel.lookup i |> RelDecl.get_value |> fill_fv_cache rv i val_of_rel env_of_rel
+        env |> Pre_env.lookup_rel i |> RelDecl.get_value |> fill_fv_cache rv i val_of_rel env_of_rel
       | Some (v, _) -> v
       end
   | FVuniv_var idu ->
     assert false
 
 and eval_to_patch env (buff,pl,fv) =
-  let patch = function
-    | Reloc_annot a, pos -> (pos, slot_for_annot a)
-    | Reloc_const sc, pos -> (pos, slot_for_str_cst sc)
-    | Reloc_getglobal kn, pos -> (pos, slot_for_getglobal env kn)
+  let slots = function
+    | Reloc_annot a -> slot_for_annot a
+    | Reloc_const sc -> slot_for_str_cst sc
+    | Reloc_getglobal kn -> slot_for_getglobal env kn
   in
-  let patches = List.map_left patch pl in
-  let buff = patch_int buff patches in
+  let tc = patch buff pl slots in
   let vm_env = Array.map (slot_for_fv env) fv in
-  let tc = tcode_of_code buff (length buff) in
   eval_tcode tc vm_env
 
 and val_of_constr env c =
-  match compile true env c with
+  match compile ~fail_on_error:true env c with
   | Some v -> eval_to_patch env (to_memory v)
   | None -> assert false
 
diff --git a/kernel/csymtable.mli b/kernel/csymtable.mli
index 633cf0abd..fc935f6ee 100644
--- a/kernel/csymtable.mli
+++ b/kernel/csymtable.mli
@@ -9,10 +9,10 @@
 (* $Id$ *)
 
 open Names
-open Term
+open Constr
 open Pre_env
 
-val val_of_constr : env -> constr -> values
+val val_of_constr : env -> constr -> Vmvalues.values
 
-val set_opaque_const      : constant -> unit
-val set_transparent_const : constant -> unit
+val set_opaque_const      : Constant.t -> unit
+val set_transparent_const : Constant.t -> unit
diff --git a/kernel/declarations.ml b/kernel/declarations.ml
index 9697b0b8b..cb7f0ecef 100644
--- a/kernel/declarations.ml
+++ b/kernel/declarations.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 
 (** This module defines the internal representation of global
    declarations. This includes global constants/axioms, mutual
@@ -28,8 +28,8 @@ type engagement = set_predicativity
 *)
 
 type template_arity = {
-  template_param_levels : Univ.universe_level option list;
-  template_level : Univ.universe;
+  template_param_levels : Univ.Level.t option list;
+  template_level : Univ.Universe.t;
 }
 
 type ('a, 'b) declaration_arity = 
@@ -48,7 +48,7 @@ type inline = int option
     always transparent. *)
 
 type projection_body = {
-  proj_ind : mutual_inductive;
+  proj_ind : MutInd.t;
   proj_npars : int;
   proj_arg : int;
   proj_type : types; (* Type under params *)
@@ -63,8 +63,8 @@ type constant_def =
   | OpaqueDef of Opaqueproof.opaque       (** or an opaque global definition *)
 
 type constant_universes =
-  | Monomorphic_const of Univ.universe_context
-  | Polymorphic_const of Univ.abstract_universe_context
+  | Monomorphic_const of Univ.ContextSet.t
+  | Polymorphic_const of Univ.AUContext.t
 
 (** The [typing_flags] are instructions to the type-checker which
     modify its behaviour. The typing flags used in the type-checking
@@ -74,6 +74,7 @@ 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 *)
+  conv_oracle : Conv_oracle.oracle; (** Unfolding strategies for conversion *)
 }
 
 (* some contraints are in constant_constraints, some other may be in
@@ -115,11 +116,11 @@ v}
     - The constants associated to each projection.
     - The checked projection bodies. *)
 
-type record_body = (Id.t * constant array * projection_body array) option
+type record_body = (Id.t * Constant.t array * projection_body array) option
 
 type regular_inductive_arity = {
   mind_user_arity : types;
-  mind_sort : sorts;
+  mind_sort : Sorts.t;
 }
 
 type inductive_arity = (regular_inductive_arity, template_arity) declaration_arity
@@ -146,7 +147,7 @@ type one_inductive_body = {
 
     mind_nrealdecls : int; (** Length of realargs context (with let, no params) *)
 
-    mind_kelim : sorts_family list; (** List of allowed elimination sorts *)
+    mind_kelim : Sorts.family list; (** List of allowed elimination sorts *)
 
     mind_nf_lc : types array; (** Head normalized constructor types so that their conclusion exposes the inductive type *)
 
@@ -168,9 +169,14 @@ type one_inductive_body = {
   }
 
 type abstract_inductive_universes =
-  | Monomorphic_ind of Univ.universe_context
-  | Polymorphic_ind of Univ.abstract_universe_context
-  | Cumulative_ind of Univ.abstract_cumulativity_info
+  | Monomorphic_ind of Univ.ContextSet.t
+  | Polymorphic_ind of Univ.AUContext.t
+  | Cumulative_ind of Univ.ACumulativityInfo.t
+
+type recursivity_kind =
+  | Finite (** = inductive *)
+  | CoFinite (** = coinductive *)
+  | BiFinite (** = non-recursive, like in "Record" definitions *)
 
 type mutual_inductive_body = {
 
@@ -178,7 +184,7 @@ type mutual_inductive_body = {
 
     mind_record : record_body option; (** The record information *)
 
-    mind_finite : Decl_kinds.recursivity_kind;  (** Whether the type is inductive or coinductive *)
+    mind_finite : recursivity_kind;  (** Whether the type is inductive or coinductive *)
 
     mind_ntypes : int;  (** Number of types in the block *)
 
@@ -212,12 +218,12 @@ type ('ty,'a) functorize =
     only for short module printing and for extraction. *)
 
 type with_declaration =
-  | WithMod of Id.t list * module_path
-  | WithDef of Id.t list * constr Univ.in_universe_context
+  | WithMod of Id.t list * ModPath.t
+  | WithDef of Id.t list * (constr * Univ.AUContext.t option)
 
 type module_alg_expr =
-  | MEident of module_path
-  | MEapply of module_alg_expr * module_path
+  | MEident of ModPath.t
+  | MEapply of module_alg_expr * ModPath.t
   | MEwith of module_alg_expr * with_declaration
 
 (** A component of a module structure *)
@@ -250,16 +256,16 @@ and module_implementation =
   | Struct of module_signature (** interactive body *)
   | FullStruct (** special case of [Struct] : the body is exactly [mod_type] *)
 
-and module_body =
-  { mod_mp : module_path; (** absolute path of the module *)
-    mod_expr : module_implementation; (** implementation *)
+and 'a generic_module_body =
+  { mod_mp : ModPath.t; (** absolute path of the module *)
+    mod_expr : 'a; (** implementation *)
     mod_type : module_signature; (** expanded type *)
     mod_type_alg : module_expression option; (** algebraic type *)
     mod_constraints : Univ.ContextSet.t; (**
       set of all universes constraints in the module  *)
     mod_delta : Mod_subst.delta_resolver; (**
       quotiented set of equivalent constants and inductive names *)
-    mod_retroknowledge : Retroknowledge.action list }
+    mod_retroknowledge : 'a module_retroknowledge }
 
 (** For a module, there are five possible situations:
     - [Declare Module M : T] then [mod_expr = Abstract; mod_type_alg = Some T]
@@ -269,13 +275,19 @@ and module_body =
     - [Module M : T. ... End M] then [mod_expr = Struct; mod_type_alg = Some T]
     And of course, all these situations may be functors or not. *)
 
-(** A [module_type_body] is just a [module_body] with no
-    implementation ([mod_expr] always [Abstract]) and also
-    an empty [mod_retroknowledge]. Its [mod_type_alg] contains
+and module_body = module_implementation generic_module_body
+
+(** A [module_type_body] is just a [module_body] with no implementation and
+    also an empty [mod_retroknowledge]. Its [mod_type_alg] contains
     the algebraic definition of this module type, or [None]
     if it has been built interactively. *)
 
-and module_type_body = module_body
+and module_type_body = unit generic_module_body
+
+and _ module_retroknowledge =
+| ModBodyRK :
+  Retroknowledge.action list -> module_implementation module_retroknowledge
+| ModTypeRK : unit module_retroknowledge
 
 (** Extra invariants :
 
@@ -284,5 +296,5 @@ and module_type_body = module_body
 
     - A module application is atomic, for instance ((M N) P) :
       * the head of [MEapply] can only be another [MEapply] or a [MEident]
-      * the argument of [MEapply] is now directly forced to be a [module_path].
+      * the argument of [MEapply] is now directly forced to be a [ModPath.t].
 *)
diff --git a/kernel/declareops.ml b/kernel/declareops.ml
index 85dd1e66d..9eed9efcb 100644
--- a/kernel/declareops.ml
+++ b/kernel/declareops.ml
@@ -15,9 +15,10 @@ module RelDecl = Context.Rel.Declaration
 (** Operations concernings types in [Declarations] :
     [constant_body], [mutual_inductive_body], [module_body] ... *)
 
-let safe_flags = {
+let safe_flags oracle = {
   check_guarded = true;
   check_universes = true;
+  conv_oracle = oracle;
 }
 
 (** {6 Arities } *)
@@ -112,7 +113,7 @@ let subst_const_body sub cb =
     themselves. But would it really bring substantial gains ? *)
 
 let hcons_rel_decl =
-  RelDecl.map_name Names.Name.hcons %> RelDecl.map_value Term.hcons_constr %> RelDecl.map_type Term.hcons_types
+  RelDecl.map_name Names.Name.hcons %> RelDecl.map_value Constr.hcons %> RelDecl.map_type Constr.hcons
 
 let hcons_rel_context l = List.smartmap hcons_rel_decl l
 
@@ -120,20 +121,20 @@ let hcons_const_def = function
   | Undef inl -> Undef inl
   | Def l_constr ->
     let constr = force_constr l_constr in
-    Def (from_val (Term.hcons_constr constr))
+    Def (from_val (Constr.hcons constr))
   | OpaqueDef _ as x -> x (* hashconsed when turned indirect *)
 
 let hcons_const_universes cbu =
   match cbu with
   | Monomorphic_const ctx -> 
-    Monomorphic_const (Univ.hcons_universe_context ctx)
+    Monomorphic_const (Univ.hcons_universe_context_set ctx)
   | Polymorphic_const ctx -> 
     Polymorphic_const (Univ.hcons_abstract_universe_context ctx)
 
 let hcons_const_body cb =
   { cb with
     const_body = hcons_const_def cb.const_body;
-    const_type = Term.hcons_constr cb.const_type;
+    const_type = Constr.hcons cb.const_type;
     const_universes = hcons_const_universes cb.const_universes }
 
 (** {6 Inductive types } *)
@@ -249,8 +250,8 @@ let inductive_is_cumulative mib =
 (** {6 Hash-consing of inductive declarations } *)
 
 let hcons_regular_ind_arity a =
-  { mind_user_arity = Term.hcons_constr a.mind_user_arity;
-    mind_sort = Term.hcons_sorts a.mind_sort }
+  { mind_user_arity = Constr.hcons a.mind_user_arity;
+    mind_sort = Sorts.hcons a.mind_sort }
 
 (** Just as for constants, this hash-consing is quite partial *)
 
@@ -260,8 +261,8 @@ let hcons_ind_arity =
 (** Substitution of inductive declarations *)
 
 let hcons_mind_packet oib =
-  let user = Array.smartmap Term.hcons_types oib.mind_user_lc in
-  let nf = Array.smartmap Term.hcons_types oib.mind_nf_lc in
+  let user = Array.smartmap Constr.hcons oib.mind_user_lc in
+  let nf = Array.smartmap Constr.hcons oib.mind_nf_lc in
   (* Special optim : merge [mind_user_lc] and [mind_nf_lc] if possible *)
   let nf = if Array.equal (==) user nf then user else nf in
   { oib with
@@ -274,7 +275,7 @@ let hcons_mind_packet oib =
 
 let hcons_mind_universes miu =
   match miu with
-  | Monomorphic_ind ctx -> Monomorphic_ind (Univ.hcons_universe_context ctx)
+  | Monomorphic_ind ctx -> Monomorphic_ind (Univ.hcons_universe_context_set ctx)
   | Polymorphic_ind ctx -> Polymorphic_ind (Univ.hcons_abstract_universe_context ctx)
   | Cumulative_ind cui -> Cumulative_ind (Univ.hcons_abstract_cumulativity_info cui)
 
@@ -287,9 +288,9 @@ let hcons_mind mib =
 (** {6 Stm machinery } *)
 
 let string_of_side_effect { Entries.eff } = match eff with
-  | Entries.SEsubproof (c,_,_) -> "P(" ^ Names.string_of_con c ^ ")"
+  | Entries.SEsubproof (c,_,_) -> "P(" ^ Names.Constant.to_string c ^ ")"
   | Entries.SEscheme (cl,_) ->
-      "S(" ^ String.concat ", " (List.map (fun (_,c,_,_) -> Names.string_of_con c) cl) ^ ")"
+      "S(" ^ String.concat ", " (List.map (fun (_,c,_,_) -> Names.Constant.to_string c) cl) ^ ")"
 
 (** Hashconsing of modules *)
 
@@ -318,7 +319,7 @@ let rec hcons_structure_field_body sb = match sb with
   let mb' = hcons_module_body mb in
   if mb == mb' then sb else SFBmodule mb'
 | SFBmodtype mb ->
-  let mb' = hcons_module_body mb in
+  let mb' = hcons_module_type mb in
   if mb == mb' then sb else SFBmodtype mb'
 
 and hcons_structure_body sb =
@@ -331,10 +332,10 @@ and hcons_structure_body sb =
   List.smartmap map sb
 
 and hcons_module_signature ms =
-  hcons_functorize hcons_module_body hcons_structure_body hcons_module_signature ms
+  hcons_functorize hcons_module_type hcons_structure_body hcons_module_signature ms
 
 and hcons_module_expression me =
-  hcons_functorize hcons_module_body hcons_module_alg_expr hcons_module_expression me
+  hcons_functorize hcons_module_type hcons_module_alg_expr hcons_module_expression me
 
 and hcons_module_implementation mip = match mip with
 | Abstract -> Abstract
@@ -346,9 +347,11 @@ and hcons_module_implementation mip = match mip with
   if ms == ms' then mip else Struct ms
 | FullStruct -> FullStruct
 
-and hcons_module_body mb =
+and hcons_generic_module_body :
+  'a. ('a -> 'a) -> 'a generic_module_body -> 'a generic_module_body =
+  fun hcons_impl mb ->
   let mp' = mb.mod_mp in
-  let expr' = hcons_module_implementation mb.mod_expr in
+  let expr' = hcons_impl mb.mod_expr in
   let type' = hcons_module_signature mb.mod_type in
   let type_alg' = mb.mod_type_alg in
   let constraints' = Univ.hcons_universe_context_set mb.mod_constraints in
@@ -373,3 +376,9 @@ and hcons_module_body mb =
     mod_delta = delta';
     mod_retroknowledge = retroknowledge';
   }
+
+and hcons_module_body mb =
+  hcons_generic_module_body hcons_module_implementation mb
+
+and hcons_module_type mb =
+  hcons_generic_module_body (fun () -> ()) mb
diff --git a/kernel/declareops.mli b/kernel/declareops.mli
index a8ba5fa39..0eed11f49 100644
--- a/kernel/declareops.mli
+++ b/kernel/declareops.mli
@@ -27,7 +27,7 @@ val subst_const_body : substitution -> constant_body -> constant_body
 
 val constant_has_body : constant_body -> bool
 
-val constant_polymorphic_context : constant_body -> abstract_universe_context
+val constant_polymorphic_context : constant_body -> AUContext.t
 
 (** Is the constant polymorphic? *)
 val constant_is_polymorphic : constant_body -> bool
@@ -57,7 +57,7 @@ val subst_wf_paths : substitution -> wf_paths -> wf_paths
 
 val subst_mind_body : substitution -> mutual_inductive_body -> mutual_inductive_body
 
-val inductive_polymorphic_context : mutual_inductive_body -> abstract_universe_context
+val inductive_polymorphic_context : mutual_inductive_body -> AUContext.t
 
 (** Is the inductive polymorphic? *)
 val inductive_is_polymorphic : mutual_inductive_body -> bool
@@ -67,7 +67,7 @@ val inductive_is_cumulative : mutual_inductive_body -> bool
 (** {6 Kernel flags} *)
 
 (** A default, safe set of flags for kernel type-checking *)
-val safe_flags : typing_flags
+val safe_flags : Conv_oracle.oracle -> typing_flags
 
 (** {6 Hash-consing} *)
 
@@ -78,3 +78,4 @@ val safe_flags : typing_flags
 val hcons_const_body : constant_body -> constant_body
 val hcons_mind : mutual_inductive_body -> mutual_inductive_body
 val hcons_module_body : module_body -> module_body
+val hcons_module_type : module_type_body -> module_type_body
diff --git a/kernel/entries.ml b/kernel/entries.ml
index a1ccbdbc1..36b75668b 100644
--- a/kernel/entries.ml
+++ b/kernel/entries.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 
 (** This module defines the entry types for global declarations. This
    information is entered in the environments. This includes global
@@ -35,9 +35,9 @@ then, in i{^ th} block, [mind_entry_params] is [xn:Xn;...;x1:X1];
 *)
 
 type inductive_universes =
-  | Monomorphic_ind_entry of Univ.universe_context
-  | Polymorphic_ind_entry of Univ.universe_context
-  | Cumulative_ind_entry of Univ.cumulativity_info
+  | Monomorphic_ind_entry of Univ.ContextSet.t
+  | Polymorphic_ind_entry of Univ.UContext.t
+  | Cumulative_ind_entry of Univ.CumulativityInfo.t
 
 type one_inductive_entry = {
   mind_entry_typename : Id.t;
@@ -51,7 +51,7 @@ type mutual_inductive_entry = {
   (** Some (Some id): primitive record with id the binder name of the record
       in projections.
       Some None: non-primitive record *)
-  mind_entry_finite : Decl_kinds.recursivity_kind;
+  mind_entry_finite : Declarations.recursivity_kind;
   mind_entry_params : (Id.t * local_entry) list;
   mind_entry_inds : one_inductive_entry list;
   mind_entry_universes : inductive_universes;
@@ -65,8 +65,10 @@ type 'a proof_output = constr Univ.in_universe_context_set * 'a
 type 'a const_entry_body = 'a proof_output Future.computation
 
 type constant_universes_entry =
-  | Monomorphic_const_entry of Univ.universe_context
-  | Polymorphic_const_entry of Univ.universe_context
+  | Monomorphic_const_entry of Univ.ContextSet.t
+  | Polymorphic_const_entry of Univ.UContext.t
+
+type 'a in_constant_universes_entry = 'a * constant_universes_entry
 
 type 'a definition_entry = {
   const_entry_body   : 'a const_entry_body;
@@ -79,13 +81,20 @@ type 'a definition_entry = {
   const_entry_opaque      : bool;
   const_entry_inline_code : bool }
 
+type section_def_entry = {
+  secdef_body : constr;
+  secdef_secctx : Context.Named.t option;
+  secdef_feedback : Stateid.t option;
+  secdef_type : types option;
+}
+
 type inline = int option (* inlining level, None for no inlining *)
 
 type parameter_entry = 
-    Context.Named.t option * bool * types Univ.in_universe_context * inline 
+    Context.Named.t option * types in_constant_universes_entry * inline
 
 type projection_entry = {
-  proj_entry_ind : mutual_inductive;
+  proj_entry_ind : MutInd.t;
   proj_entry_arg : int }
 
 type 'a constant_entry =
@@ -112,11 +121,11 @@ 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 ]
+  | `Opaque of Constr.t * Univ.ContextSet.t ]
 
 type side_eff =
-  | SEsubproof of constant * Declarations.constant_body * seff_env
-  | SEscheme of (inductive * constant * Declarations.constant_body * seff_env) list * string
+  | SEsubproof of Constant.t * Declarations.constant_body * seff_env
+  | SEscheme of (inductive * Constant.t * Declarations.constant_body * seff_env) list * string
 
 type side_effect = {
   from_env : Declarations.structure_body CEphemeron.key;
diff --git a/kernel/environ.ml b/kernel/environ.ml
index 621a9931d..fe5a7dfb5 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -23,7 +23,7 @@
 open CErrors
 open Util
 open Names
-open Term
+open Constr
 open Vars
 open Declarations
 open Pre_env
@@ -37,8 +37,10 @@ type env = Pre_env.env
 
 let pre_env env = env
 let env_of_pre_env env = env
-let oracle env = env.env_conv_oracle
-let set_oracle env o = { env with env_conv_oracle = o }
+let oracle env = env.env_typing_flags.conv_oracle
+let set_oracle env o =
+  let env_typing_flags = { env.env_typing_flags with conv_oracle = o } in
+  { env with env_typing_flags }
 
 let empty_named_context_val = empty_named_context_val
 
@@ -58,18 +60,17 @@ 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.env_named_ctx
 let named_context_val env = env.env_named_context
-let rel_context env = env.env_rel_context
+let rel_context env = env.env_rel_context.env_rel_ctx
 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.env_named_ctx with
+  match env.env_rel_context.env_rel_ctx, env.env_named_context.env_named_ctx with
   | [], [] -> true
   | _ -> false
 
 (* Rel context *)
-let lookup_rel n env =
-  Context.Rel.lookup n env.env_rel_context
+let lookup_rel = lookup_rel
 
 let evaluable_rel n env =
   is_local_def (lookup_rel n env)
@@ -86,13 +87,12 @@ let push_rec_types (lna,typarray,_) env =
 
 let fold_rel_context f env ~init =
   let rec fold_right env =
-    match env.env_rel_context with
-    | [] -> init
-    | rd::rc ->
+    match match_rel_context_val env.env_rel_context with
+    | None -> init
+    | Some (rd, _, rc) ->
 	let env =
 	  { env with
 	    env_rel_context = rc;
-	    env_rel_val = List.tl env.env_rel_val;
 	    env_nb_rel = env.env_nb_rel - 1 } in
 	f env rd (fold_right env)
   in fold_right env
@@ -101,6 +101,8 @@ let fold_rel_context f env ~init =
 
 let named_context_of_val c = c.env_named_ctx
 
+let ids_of_named_context_val c = Id.Map.domain c.env_named_map
+
 (* [map_named_val f ctxt] apply [f] to the body and the type of
    each declarations.
    *** /!\ ***   [f t] should be convertible with t *)
@@ -140,16 +142,21 @@ let evaluable_named id env =
 let reset_with_named_context ctxt env =
   { env with
     env_named_context = ctxt;
-    env_rel_context = Context.Rel.empty;
-    env_rel_val = [];
+    env_rel_context = empty_rel_context_val;
     env_nb_rel = 0 }
 
 let reset_context = reset_with_named_context empty_named_context_val
 
 let pop_rel_context n env =
+  let rec skip n ctx =
+    if Int.equal n 0 then ctx
+    else match match_rel_context_val ctx with
+    | None -> invalid_arg "List.skipn"
+    | Some (_, _, ctx) -> skip (pred n) ctx
+  in
   let ctxt = env.env_rel_context in
   { env with
-    env_rel_context = List.skipn n ctxt;
+    env_rel_context = skip n ctxt;
     env_nb_rel = env.env_nb_rel - n }
 
 let fold_named_context f env ~init =
@@ -247,31 +254,10 @@ let constant_context env kn =
   | Monomorphic_const _ -> Univ.AUContext.empty
   | Polymorphic_const ctx -> ctx
 
-type const_evaluation_result = NoBody | Opaque | IsProj
+type const_evaluation_result = NoBody | Opaque
 
 exception NotEvaluableConst of const_evaluation_result
 
-let constant_value env (kn,u) =
-  let cb = lookup_constant kn env in
-    if cb.const_proj = None then
-      match cb.const_body with
-      | Def l_body -> 
-        begin
-          match cb.const_universes with
-          | Monomorphic_const _ -> 
-            (Mod_subst.force_constr l_body, Univ.Constraint.empty)
-          | Polymorphic_const _ ->
-	    let csts = constraints_of cb u in
-            (subst_instance_constr u (Mod_subst.force_constr l_body), csts)
-        end
-      | OpaqueDef _ -> raise (NotEvaluableConst Opaque)
-      | Undef _ -> raise (NotEvaluableConst NoBody)
-    else raise (NotEvaluableConst IsProj)
-
-let constant_opt_value env cst =
-  try Some (constant_value env cst)
-  with NotEvaluableConst _ -> None
-
 let constant_value_and_type env (kn, u) =
   let cb = lookup_constant kn env in
     if Declareops.constant_is_polymorphic cb then
@@ -389,7 +375,7 @@ let lookup_constructor_variables (ind,_) env =
 (* Returns the list of global variables in a term *)
 
 let vars_of_global env constr =
-  match kind_of_term constr with
+  match kind constr with
       Var id -> Id.Set.singleton id
     | Const (kn, _) -> lookup_constant_variables kn env
     | Ind (ind, _) -> lookup_inductive_variables ind env
@@ -400,12 +386,12 @@ let vars_of_global env constr =
 let global_vars_set env constr =
   let rec filtrec acc c =
     let acc =
-      match kind_of_term c with
+      match kind c with
       | Var _ | Const _ | Ind _ | Construct _ ->
 	  Id.Set.union (vars_of_global env c) acc
       | _ ->
 	  acc in
-    Term.fold_constr filtrec acc c
+    Constr.fold filtrec acc c
   in
     filtrec Id.Set.empty constr
 
@@ -476,13 +462,13 @@ let j_type j = j.uj_type
 
 type 'types punsafe_type_judgment = {
   utj_val : 'types;
-  utj_type : sorts }
+  utj_type : Sorts.t }
 
 type unsafe_type_judgment = types punsafe_type_judgment
 
 (*s Compilation of global declaration *)
 
-let compile_constant_body = Cbytegen.compile_constant_body false
+let compile_constant_body = Cbytegen.compile_constant_body ~fail_on_error:false
 
 exception Hyp_not_found
 
@@ -536,7 +522,7 @@ let register_one env field entry =
 let register env field entry =
   match field with
     | KInt31 (grp, Int31Type) ->
-        let i31c = match kind_of_term entry with
+        let i31c = match kind entry with
                      | Ind i31t -> mkConstructUi (i31t, 1)
 		     | _ -> anomaly ~label:"Environ.register" (Pp.str "should be an inductive type.")
 	in
@@ -574,7 +560,7 @@ let dispatch =
      it to the name of the coq definition in the reactive retroknowledge) *)
   let int31_op n op prim kn =
     { empty_reactive_info with
-      vm_compiling = Some (Cbytegen.op_compilation n op kn);
+      vm_compiling = Some (Clambda.compile_prim n op kn);
       native_compiling = Some (Nativelambda.compile_prim prim (Univ.out_punivs kn));
     }
   in
@@ -582,7 +568,7 @@ let dispatch =
 fun rk value field ->
   (* subfunction which shortens the (very common) dispatch of operations *)
   let int31_op_from_const n op prim =
-    match kind_of_term value with
+    match kind value with
       | Const kn ->  int31_op n op prim kn
       | _ -> anomaly ~label:"Environ.register" (Pp.str "should be a constant.")
   in
@@ -599,13 +585,13 @@ fun rk value field ->
               (Pp.str "add_int31_decompilation_from_type called with an abnormal field.")
         in
         let i31bit_type =
-          match kind_of_term int31bit with
+          match kind int31bit with
           | Ind (i31bit_type,_) -> i31bit_type
           |  _ -> anomaly ~label:"Environ.register"
               (Pp.str "Int31Bits should be an inductive type.")
         in
         let int31_decompilation =
-          match kind_of_term value with
+          match kind value with
           | Ind (i31t,_) ->
               constr_of_int31 i31t i31bit_type
           | _ -> anomaly ~label:"Environ.register"
@@ -613,13 +599,13 @@ fun rk value field ->
         in
         { empty_reactive_info with
           vm_decompile_const = Some int31_decompilation;
-          vm_before_match = Some Cbytegen.int31_escape_before_match;
+          vm_before_match = Some Clambda.int31_escape_before_match;
           native_before_match = Some (Nativelambda.before_match_int31 i31bit_type);
         }
     | KInt31 (_, Int31Constructor) ->
         { empty_reactive_info with
-          vm_constant_static = Some Cbytegen.compile_structured_int31;
-          vm_constant_dynamic = Some Cbytegen.dynamic_int31_compilation;
+          vm_constant_static = Some Clambda.compile_structured_int31;
+          vm_constant_dynamic = Some Clambda.dynamic_int31_compilation;
           native_constant_static = Some Nativelambda.compile_static_int31;
           native_constant_dynamic = Some Nativelambda.compile_dynamic_int31;
         }
diff --git a/kernel/environ.mli b/kernel/environ.mli
index 377c61de2..69d811a64 100644
--- a/kernel/environ.mli
+++ b/kernel/environ.mli
@@ -7,9 +7,9 @@
 (************************************************************************)
 
 open Names
-open Term
-open Declarations
+open Constr
 open Univ
+open Declarations
 
 (** Unsafe environments. We define here a datatype for environments.
    Since typing is not yet defined, it is not possible to check the
@@ -80,6 +80,7 @@ val fold_rel_context :
 val named_context_of_val : named_context_val -> Context.Named.t
 val val_of_named_context : Context.Named.t -> named_context_val
 val empty_named_context_val : named_context_val
+val ids_of_named_context_val : named_context_val -> Id.Set.t
 
 
 (** [map_named_val f ctxt] apply [f] to the body and the type of
@@ -125,19 +126,19 @@ val pop_rel_context : int -> env -> env
 (** {5 Global constants }
   {6 Add entries to global environment } *)
 
-val add_constant : constant -> constant_body -> env -> env
-val add_constant_key : constant -> constant_body -> Pre_env.link_info ->
+val add_constant : Constant.t -> constant_body -> env -> env
+val add_constant_key : Constant.t -> constant_body -> Pre_env.link_info ->
   env -> env
 
 (** Looks up in the context of global constant names 
    raises [Not_found] if the required path is not found *)
-val lookup_constant    : constant -> env -> constant_body
-val evaluable_constant : constant -> env -> bool
+val lookup_constant    : Constant.t -> env -> constant_body
+val evaluable_constant : Constant.t -> env -> bool
 
 (** New-style polymorphism *)
-val polymorphic_constant  : constant -> env -> bool
+val polymorphic_constant  : Constant.t -> env -> bool
 val polymorphic_pconstant : pconstant -> env -> bool
-val type_in_type_constant : constant -> env -> bool
+val type_in_type_constant : Constant.t -> env -> bool
 
 (** {6 ... } *)
 (** [constant_value env c] raises [NotEvaluableConst Opaque] if
@@ -145,38 +146,36 @@ val type_in_type_constant : constant -> env -> bool
    body and [NotEvaluableConst IsProj] if [c] is a projection 
    and [Not_found] if it does not exist in [env] *)
 
-type const_evaluation_result = NoBody | Opaque | IsProj
+type const_evaluation_result = NoBody | Opaque
 exception NotEvaluableConst of const_evaluation_result
 
-val constant_value : env -> constant puniverses -> constr constrained
-val constant_type : env -> constant puniverses -> types constrained
+val constant_type : env -> Constant.t puniverses -> types constrained
 
-val constant_opt_value : env -> constant puniverses -> (constr * Univ.constraints) option
-val constant_value_and_type : env -> constant puniverses -> 
-  constr option * types * Univ.constraints
+val constant_value_and_type : env -> Constant.t puniverses -> 
+  constr option * types * Univ.Constraint.t
 (** The universe context associated to the constant, empty if not 
     polymorphic *)
-val constant_context : env -> constant -> Univ.abstract_universe_context
+val constant_context : env -> Constant.t -> Univ.AUContext.t
 
 (* These functions should be called under the invariant that [env] 
    already contains the constraints corresponding to the constant 
    application. *)
-val constant_value_in : env -> constant puniverses -> constr
-val constant_type_in : env -> constant puniverses -> types
-val constant_opt_value_in : env -> constant puniverses -> constr option
+val constant_value_in : env -> Constant.t puniverses -> constr
+val constant_type_in : env -> Constant.t puniverses -> types
+val constant_opt_value_in : env -> Constant.t puniverses -> constr option
 
 (** {6 Primitive projections} *)
 
 val lookup_projection    : Names.projection -> env -> projection_body
-val is_projection : constant -> env -> bool
+val is_projection : Constant.t -> env -> bool
 
 (** {5 Inductive types } *)
-val add_mind_key : mutual_inductive -> Pre_env.mind_key -> env -> env
-val add_mind : mutual_inductive -> mutual_inductive_body -> env -> env
+val add_mind_key : MutInd.t -> Pre_env.mind_key -> env -> env
+val add_mind : MutInd.t -> mutual_inductive_body -> env -> env
 
 (** Looks up in the context of global inductive names 
    raises [Not_found] if the required path is not found *)
-val lookup_mind : mutual_inductive -> env -> mutual_inductive_body
+val lookup_mind : MutInd.t -> env -> mutual_inductive_body
 
 (** New-style polymorphism *)
 val polymorphic_ind  : inductive -> env -> bool
@@ -194,20 +193,20 @@ val add_modtype : module_type_body -> env -> env
 (** [shallow_add_module] does not add module components *)
 val shallow_add_module : module_body -> env -> env
 
-val lookup_module : module_path -> env -> module_body
-val lookup_modtype : module_path -> env -> module_type_body
+val lookup_module : ModPath.t -> env -> module_body
+val lookup_modtype : ModPath.t -> env -> module_type_body
 
 (** {5 Universe constraints } *)
 
 (** Add universe constraints to the environment.
     @raises UniverseInconsistency
 *)
-val add_constraints : Univ.constraints -> env -> env
+val add_constraints : Univ.Constraint.t -> env -> env
 
 (** Check constraints are satifiable in the environment. *)
-val check_constraints : Univ.constraints -> env -> bool
-val push_context : ?strict:bool -> Univ.universe_context -> env -> env
-val push_context_set : ?strict:bool -> Univ.universe_context_set -> env -> env
+val check_constraints : Univ.Constraint.t -> env -> bool
+val push_context : ?strict:bool -> Univ.UContext.t -> env -> env
+val push_context_set : ?strict:bool -> Univ.ContextSet.t -> env -> env
 val push_constraints_to_env : 'a Univ.constrained -> env -> env
 
 val set_engagement : engagement -> env -> env
@@ -246,7 +245,7 @@ val j_type : ('constr, 'types) punsafe_judgment -> 'types
 
 type 'types punsafe_type_judgment = {
   utj_val : 'types;
-  utj_type : sorts }
+  utj_type : Sorts.t }
 
 type unsafe_type_judgment = types punsafe_type_judgment
 
diff --git a/kernel/evar.ml b/kernel/evar.ml
index e63665f51..dcd2e12a0 100644
--- a/kernel/evar.ml
+++ b/kernel/evar.ml
@@ -13,6 +13,7 @@ let unsafe_of_int x = x
 let compare = Int.compare
 let equal = Int.equal
 let hash = Int.hash
+let print x = Pp.(str "?X" ++ int x)
 
 module Set = Int.Set
 module Map = Int.Map
diff --git a/kernel/evar.mli b/kernel/evar.mli
index eee6680fb..6a058207f 100644
--- a/kernel/evar.mli
+++ b/kernel/evar.mli
@@ -30,5 +30,8 @@ val compare : t -> t -> int
 val hash : t -> int
 (** Hash over existential variables. *)
 
+val print : t -> Pp.t
+(** Printing representation *)
+
 module Set : Set.S with type elt = t
 module Map : CMap.ExtS with type key = t and module Set := Set
diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml
index e248436ec..cfca335d3 100644
--- a/kernel/indtypes.ml
+++ b/kernel/indtypes.ml
@@ -11,6 +11,7 @@ open Util
 open Names
 open Univ
 open Term
+open Constr
 open Vars
 open Declarations
 open Declareops
@@ -130,11 +131,11 @@ let is_unit constrsinfos =
 let infos_and_sort env t =
   let rec aux env t max =
     let t = whd_all env t in
-      match kind_of_term t with
+      match kind t with
       | Prod (name,c1,c2) ->
         let varj = infer_type env c1 in
 	let env1 = Environ.push_rel (LocalAssum (name,varj.utj_val)) env in
-	let max = Universe.sup max (univ_of_sort varj.utj_type) in
+        let max = Universe.sup max (Sorts.univ_of_sort varj.utj_type) in
 	  aux env1 c2 max
     | _ when is_constructor_head t -> max
     | _ -> (* don't fail if not positive, it is tested later *) max
@@ -168,7 +169,7 @@ let infer_constructor_packet env_ar_par params lc =
   let jlc = List.map (infer_type env_ar_par) lc in
   let jlc = Array.of_list jlc in
   (* generalize the constructor over the parameters *)
-  let lc'' = Array.map (fun j -> it_mkProd_or_LetIn j.utj_val params) jlc in
+  let lc'' = Array.map (fun j -> Term.it_mkProd_or_LetIn j.utj_val params) jlc in
   (* compute the max of the sorts of the products of the constructors types *)
   let levels = List.map (infos_and_sort env_ar_par) lc in
   let isunit = is_unit levels in
@@ -183,7 +184,7 @@ let cumulate_arity_large_levels env sign =
      match d with
      | LocalAssum (_,t) ->
 	let tj = infer_type env t in
-	let u = univ_of_sort tj.utj_type in
+        let u = Sorts.univ_of_sort tj.utj_type in
 	  (Universe.sup u lev, push_rel d env)
      | LocalDef _ ->
 	lev, push_rel d env)
@@ -199,8 +200,8 @@ let is_impredicative env u =
 let param_ccls paramsctxt =
   let fold acc = function
     | (LocalAssum (_, p)) ->
-      (let c = strip_prod_assum p in
-      match kind_of_term c with
+      (let c = Term.strip_prod_assum p in
+      match kind c with
         | Sort (Type u) -> Univ.Universe.level u
         | _ -> None) :: acc
     | LocalDef _ -> acc
@@ -208,7 +209,7 @@ let param_ccls paramsctxt =
   List.fold_left fold [] paramsctxt
 
 (* Check arities and constructors *)
-let check_subtyping_arity_constructor env (subst : constr -> constr) (arcn : Term.types) numparams is_arity =
+let check_subtyping_arity_constructor env (subst : constr -> constr) (arcn : types) numparams is_arity =
   let numchecked = ref 0 in
   let basic_check ev tp =
     if !numchecked < numparams then () else conv_leq ev tp (subst tp);
@@ -233,22 +234,32 @@ let check_subtyping_arity_constructor env (subst : constr -> constr) (arcn : Ter
 (* This check produces a value of the unit type if successful or raises an anomaly if check fails. *)
 let check_subtyping cumi paramsctxt env_ar inds = 
     let numparams = Context.Rel.nhyps paramsctxt in
-    let sbsubst = CumulativityInfo.subtyping_susbst cumi in
-    let dosubst = subst_univs_level_constr sbsubst in
     let uctx = CumulativityInfo.univ_context cumi in
-    let instance_other = Univ.subst_univs_level_instance sbsubst (Univ.UContext.instance uctx) in
-    let constraints_other = Univ.subst_univs_level_constraints sbsubst (Univ.UContext.constraints uctx) in
+    let new_levels = Array.init (UContext.size uctx) (Level.make DirPath.empty) in
+    let lmap = Array.fold_left2 (fun lmap u u' -> LMap.add u u' lmap)
+        LMap.empty (Instance.to_array @@ UContext.instance uctx) new_levels
+    in
+    let dosubst = subst_univs_level_constr lmap in
+    let instance_other = Instance.of_array new_levels in
+    let constraints_other = Univ.subst_univs_level_constraints lmap (Univ.UContext.constraints uctx) in
     let uctx_other = Univ.UContext.make (instance_other, constraints_other) in
     let env = Environ.push_context uctx env_ar in
     let env = Environ.push_context uctx_other env in
-    let env = push_context (CumulativityInfo.subtyp_context cumi) env in
+    let subtyp_constraints =
+      CumulativityInfo.leq_constraints cumi
+        (UContext.instance uctx) instance_other
+        Constraint.empty
+    in
+    let env = Environ.add_constraints subtyp_constraints env in
     (* process individual inductive types: *)
     Array.iter (fun (id,cn,lc,(sign,arity)) ->
       match arity with
         | RegularArity (_, full_arity, _) ->
            check_subtyping_arity_constructor env dosubst full_arity numparams true;
            Array.iter (fun cnt -> check_subtyping_arity_constructor env dosubst cnt numparams false) lc
-        | TemplateArity _ -> ()
+        | TemplateArity _ ->
+          anomaly ~label:"check_subtyping"
+            Pp.(str "template polymorphism and cumulative polymorphism are not compatible")
     ) inds
 
 (* Type-check an inductive definition. Does not check positivity
@@ -264,13 +275,12 @@ let typecheck_inductive env mie =
   (* Check unicity of names *)
   mind_check_names mie;
   (* Params are typed-checked here *)
-  let univctx =
+  let env' =
     match mie.mind_entry_universes with
-    | Monomorphic_ind_entry ctx -> ctx
-    | Polymorphic_ind_entry ctx -> ctx
-    | Cumulative_ind_entry cumi -> Univ.CumulativityInfo.univ_context cumi
+    | Monomorphic_ind_entry ctx -> push_context_set ctx env
+    | Polymorphic_ind_entry ctx -> push_context ctx env
+    | Cumulative_ind_entry cumi -> push_context (Univ.CumulativityInfo.univ_context cumi) env
   in
-  let env' = push_context univctx env in
   let (env_params,paramsctxt) = infer_local_decls env' mie.mind_entry_params in
   (* We first type arity of each inductive definition *)
   (* This allows building the environment of arities and to share *)
@@ -288,7 +298,7 @@ let typecheck_inductive env mie =
 	         (** We have an algebraic universe as the conclusion of the arity,
 		     typecheck the dummy Π ctx, Prop and do a special case for the conclusion.
 		 *)
-	         let proparity = infer_type env_params (mkArity (ctx, prop_sort)) in
+	         let proparity = infer_type env_params (mkArity (ctx, Sorts.prop)) in
 		 let (cctx, _) = destArity proparity.utj_val in
 		   (* Any universe is well-formed, we don't need to check [s] here *)
 		   mkArity (cctx, s)
@@ -350,7 +360,7 @@ let typecheck_inductive env mie =
 	| None -> clev
       in
       let full_polymorphic () = 
-	let defu = Term.univ_of_sort def_level in
+        let defu = Sorts.univ_of_sort def_level in
 	let is_natural =
 	  type_in_type env || (UGraph.check_leq (universes env') infu defu)
 	in
@@ -468,7 +478,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_all env params.(param_index)) with
+        match kind (whd_all env params.(param_index)) with
 	  | Rel w when Int.equal w paramdecl_index ->
             check (param_index-1) (paramdecl_index+1) paramdecls
 	  | _ ->
@@ -495,7 +505,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_all env p) with
+       ( match kind (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)
@@ -526,7 +536,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_all env c in
-    match kind_of_term c' with
+    match kind c' with
 	Prod(na,a,b) ->
 	  let ienv' = ienv_push_var ienv (na,a,mk_norec) in
 	  ienv_decompose_prod ienv' (n-1) b
@@ -555,7 +565,7 @@ let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (
       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_all env c) in
-      match kind_of_term x with
+      match kind x with
 	| Prod (na,b,d) ->
 	    let () = assert (List.is_empty largs) in
             (** If one of the inductives of the mutually inductive
@@ -663,7 +673,7 @@ let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (
   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_all env c) in
-	match kind_of_term x with
+	match kind x with
 
           | Prod (na,b,d) ->
 	      let () = assert (List.is_empty largs) in
@@ -710,7 +720,7 @@ let check_positivity_one ~chkpos recursive (env,_,ntypes,_ as ienv) paramsctxt (
     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 recursive = finite != BiFinite in
   let rc = Array.mapi (fun j t -> (Mrec (kn,j),t)) (Rtree.mk_rec_calls ntypes) in
   let ra_env_ar = Array.rev_to_list rc in
   let nparamsctxt = Context.Rel.length paramsctxt in
@@ -746,7 +756,7 @@ let allowed_sorts is_smashed s =
 	   as well. *)
       all_sorts
   else 
-    match family_of_sort s with
+    match Sorts.family s with
     (* Type: all elimination allowed: above and below *)
     | InType -> all_sorts
     (* Smashed Set is necessarily impredicative: forbids large elimination *)
@@ -787,7 +797,7 @@ exception UndefinableExpansion
     a substitution of the form [params, x : ind params] *)
 let compute_projections ((kn, _ as ind), u as indu) n x nparamargs params
     mind_consnrealdecls mind_consnrealargs paramslet ctx =
-  let mp, dp, l = repr_mind kn in
+  let mp, dp, l = MutInd.repr3 kn in
   (** We build a substitution smashing the lets in the record parameters so
       that typechecking projections requires just a substitution and not
       matching with a parameter context. *)
@@ -879,9 +889,13 @@ let abstract_inductive_universes iu =
   match iu with
   | Monomorphic_ind_entry ctx -> (Univ.empty_level_subst, Monomorphic_ind ctx)
   | Polymorphic_ind_entry ctx -> 
-    let (inst, auctx) = Univ.abstract_universes ctx in (inst, Polymorphic_ind auctx)
+    let (inst, auctx) = Univ.abstract_universes ctx in
+    let inst = Univ.make_instance_subst inst in
+    (inst, Polymorphic_ind auctx)
   | Cumulative_ind_entry cumi -> 
-    let (inst, acumi) = Univ.abstract_cumulativity_info cumi in (inst, Cumulative_ind acumi)
+    let (inst, acumi) = Univ.abstract_cumulativity_info cumi in
+    let inst = Univ.make_instance_subst inst in
+    (inst, Cumulative_ind acumi)
 
 let build_inductive env prv iu env_ar paramsctxt kn isrecord isfinite inds nmr recargs =
   let ntypes = Array.length inds in
@@ -915,11 +929,11 @@ let build_inductive env prv iu env_ar paramsctxt kn isrecord isfinite inds nmr r
 	let ar = {template_param_levels = paramlevs; template_level = lev} in
 	  TemplateArity ar, all_sorts
       | RegularArity (info,ar,defs) ->
-	let s = sort_of_univ defs in
+        let s = Sorts.sort_of_univ defs in
 	let kelim = allowed_sorts info s in
 	let ar = RegularArity 
 	  { mind_user_arity = Vars.subst_univs_level_constr substunivs ar; 
-	    mind_sort = sort_of_univ (Univ.subst_univs_level_universe substunivs defs); } in
+            mind_sort = Sorts.sort_of_univ (Univ.subst_univs_level_universe substunivs defs); } in
 	  ar, kelim in
     (* Assigning VM tags to constructors *)
     let nconst, nblock = ref 0, ref 0 in
diff --git a/kernel/indtypes.mli b/kernel/indtypes.mli
index e4b7c086a..9a9380adb 100644
--- a/kernel/indtypes.mli
+++ b/kernel/indtypes.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Declarations
 open Environ
 open Entries
@@ -34,7 +34,7 @@ exception InductiveError of inductive_error
 
 (** The following function does checks on inductive declarations. *)
 
-val check_inductive : env -> mutual_inductive -> mutual_inductive_entry -> mutual_inductive_body
+val check_inductive : env -> MutInd.t -> mutual_inductive_entry -> mutual_inductive_body
 
 (** The following enforces a system compatible with the univalent model *)
 
@@ -44,4 +44,4 @@ val is_indices_matter : unit -> bool
 val compute_projections : pinductive -> Id.t -> Id.t ->
   int -> Context.Rel.t -> int array -> int array -> 
   Context.Rel.t -> Context.Rel.t -> 
-  (constant array * projection_body array)
+  (Constant.t array * projection_body array)
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 1eaba49aa..722705bd7 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -10,7 +10,7 @@ open CErrors
 open Util
 open Names
 open Univ
-open Term
+open Constr
 open Vars
 open Declarations
 open Declareops
@@ -30,22 +30,22 @@ let lookup_mind_specif env (kn,tyi) =
 
 let find_rectype env c =
   let (t, l) = decompose_app (whd_all env c) in
-  match kind_of_term t with
+  match kind t with
   | Ind ind -> (ind, l)
   | _ -> raise Not_found
 
 let find_inductive env c =
   let (t, l) = decompose_app (whd_all env c) in
-  match kind_of_term t with
+  match kind t with
     | Ind ind
-        when (fst (lookup_mind_specif env (out_punivs ind))).mind_finite <> Decl_kinds.CoFinite -> (ind, l)
+        when (fst (lookup_mind_specif env (out_punivs ind))).mind_finite <> CoFinite -> (ind, l)
     | _ -> raise Not_found
 
 let find_coinductive env c =
   let (t, l) = decompose_app (whd_all env c) in
-  match kind_of_term t with
+  match kind t with
     | Ind ind
-        when (fst (lookup_mind_specif env (out_punivs ind))).mind_finite == Decl_kinds.CoFinite -> (ind, l)
+        when (fst (lookup_mind_specif env (out_punivs ind))).mind_finite == CoFinite -> (ind, l)
     | _ -> raise Not_found
 
 let inductive_params (mib,_) = mib.mind_nparams
@@ -81,7 +81,7 @@ let instantiate_params full t u args sign =
   let (rem_args, subs, ty) =
     Context.Rel.fold_outside
       (fun decl (largs,subs,ty) ->
-        match (decl, largs, kind_of_term ty) with
+        match (decl, largs, kind ty) with
           | (LocalAssum _, a::args, Prod(_,_,t)) -> (args, a::subs, t)
           | (LocalDef (_,b,_), _, LetIn(_,_,_,t))    ->
 	     (largs, (substl subs (subst_instance_constr u b))::subs, t)
@@ -94,9 +94,9 @@ let instantiate_params full t u args sign =
   substl subs ty
 
 let full_inductive_instantiate mib u params sign =
-  let dummy = prop_sort in
-  let t = mkArity (Vars.subst_instance_context u sign,dummy) in
-    fst (destArity (instantiate_params true t u params mib.mind_params_ctxt))
+  let dummy = Sorts.prop in
+  let t = Term.mkArity (Vars.subst_instance_context u sign,dummy) in
+    fst (Term.destArity (instantiate_params true t u params mib.mind_params_ctxt))
 
 let full_constructor_instantiate ((mind,_),u,(mib,_),params) t =
   let inst_ind = constructor_instantiate mind u mib t in
@@ -128,7 +128,7 @@ where
 Remark: Set (predicative) is encoded as Type(0)
 *)
 
-let sort_as_univ = function
+let sort_as_univ = let open Sorts in function
 | Type u -> u
 | Prop Null -> Universe.type0m
 | Prop Pos -> Universe.type0
@@ -192,11 +192,11 @@ let instantiate_universes env ctx ar argsorts =
   let level = Univ.subst_univs_universe (Univ.make_subst subst) ar.template_level in
   let ty =
     (* Singleton type not containing types are interpretable in Prop *)
-    if is_type0m_univ level then prop_sort
+    if is_type0m_univ level then Sorts.prop
     (* Non singleton type not containing types are interpretable in Set *)
-    else if is_type0_univ level then set_sort
+    else if is_type0_univ level then Sorts.set
     (* This is a Type with constraints *)
-    else Type level
+    else Sorts.Type level
   in
     (ctx, ty)
 
@@ -211,9 +211,9 @@ let type_of_inductive_gen ?(polyprop=true) env ((mib,mip),u) paramtyps =
       (* 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 (is_type0m_univ ar.template_level) && is_prop_sort s
+      if not polyprop && not (is_type0m_univ ar.template_level) && Sorts.is_prop s
       then raise (SingletonInductiveBecomesProp mip.mind_typename);
-      mkArity (List.rev ctx,s)
+      Term.mkArity (List.rev ctx,s)
 
 let type_of_inductive env pind = 
   type_of_inductive_gen env pind [||]
@@ -233,7 +233,7 @@ let type_of_inductive_knowing_parameters env ?(polyprop=true) mip args =
 
 (* The max of an array of universes *)
 
-let cumulate_constructor_univ u = function
+let cumulate_constructor_univ u = let open Sorts in function
   | Prop Null -> u
   | Prop Pos -> Universe.sup Universe.type0 u
   | Type u' -> Universe.sup u u'
@@ -276,8 +276,8 @@ let type_of_constructors (ind,u) (mib,mip) =
 
 let inductive_sort_family mip =
   match mip.mind_arity with
-  | RegularArity s -> family_of_sort s.mind_sort
-  | TemplateArity _ -> InType
+  | RegularArity s -> Sorts.family s.mind_sort
+  | TemplateArity _ -> Sorts.InType
 
 let mind_arity mip =
   mip.mind_arity_ctxt, inductive_sort_family mip
@@ -296,19 +296,20 @@ let is_primitive_record (mib,_) =
 
 let build_dependent_inductive ind (_,mip) params =
   let realargs,_ = List.chop mip.mind_nrealdecls mip.mind_arity_ctxt in
-  applist
+  Term.applist
     (mkIndU ind,
        List.map (lift mip.mind_nrealdecls) params
        @ Context.Rel.to_extended_list mkRel 0 realargs)
 
 (* This exception is local *)
-exception LocalArity of (sorts_family * sorts_family * arity_error) option
+exception LocalArity of (Sorts.family * Sorts.family * arity_error) option
 
 let check_allowed_sort ksort specif =
+  let open Sorts in
   let eq_ksort s = match ksort, s with
   | InProp, InProp | InSet, InSet | InType, InType -> true
   | _ -> false in
-  if not (List.exists eq_ksort (elim_sorts specif)) then
+  if not (CList.exists eq_ksort (elim_sorts specif)) then
     let s = inductive_sort_family (snd specif) in
     raise (LocalArity (Some(ksort,s,error_elim_explain ksort s)))
 
@@ -316,7 +317,7 @@ 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_all env pt in
-    match kind_of_term pt', ar with
+    match kind pt', ar with
       | Prod (na1,a1,t), (LocalAssum (_,a1'))::ar' ->
           let () =
             try conv env a1 a1'
@@ -325,8 +326,8 @@ 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_all env' a2) with
-	 | Sort s -> family_of_sort s
+	 let ksort = match kind (whd_all env' a2) with
+	 | Sort s -> Sorts.family s
 	 | _ -> raise (LocalArity None) in
 	 let dep_ind = build_dependent_inductive ind specif params in
 	 let _ =
@@ -351,22 +352,22 @@ let is_correct_arity env c pj ind specif params =
 let build_branches_type (ind,u) (_,mip as specif) params p =
   let build_one_branch i cty =
     let typi = full_constructor_instantiate (ind,u,specif,params) cty in
-    let (cstrsign,ccl) = decompose_prod_assum typi in
+    let (cstrsign,ccl) = Term.decompose_prod_assum typi in
     let nargs = Context.Rel.length cstrsign in
     let (_,allargs) = decompose_app ccl in
     let (lparams,vargs) = List.chop (inductive_params specif) allargs in
     let cargs =
       let cstr = ith_constructor_of_inductive ind (i+1) in
-      let dep_cstr = applist (mkConstructU (cstr,u),lparams@(Context.Rel.to_extended_list mkRel 0 cstrsign)) in
+      let dep_cstr = Term.applist (mkConstructU (cstr,u),lparams@(Context.Rel.to_extended_list mkRel 0 cstrsign)) in
       vargs @ [dep_cstr] in
-    let base = lambda_appvect_assum (mip.mind_nrealdecls+1) (lift nargs p) (Array.of_list cargs) in
-    it_mkProd_or_LetIn base cstrsign in
+    let base = Term.lambda_appvect_assum (mip.mind_nrealdecls+1) (lift nargs p) (Array.of_list cargs) in
+    Term.it_mkProd_or_LetIn base cstrsign in
   Array.mapi build_one_branch mip.mind_nf_lc
 
 (* [p] is the predicate, [c] is the match object, [realargs] is the
    list of real args of the inductive type *)
 let build_case_type env n p c realargs =
-  whd_betaiota env (lambda_appvect_assum (n+1) p (Array.of_list (realargs@[c])))
+  whd_betaiota env (Term.lambda_appvect_assum (n+1) p (Array.of_list (realargs@[c])))
 
 let type_case_branches env (pind,largs) pj c =
   let specif = lookup_mind_specif env (fst pind) in
@@ -589,7 +590,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_all env c in
-   match kind_of_term c' with
+   match kind c' with
    Prod(na,a,b) ->
      let ienv' = ienv_push_var ienv (na,a,mk_norec) in
      ienv_decompose_prod ienv' (n-1) b
@@ -621,7 +622,7 @@ 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_all env c) in
-    match kind_of_term x with
+    match kind x with
     | Prod (na,b,d) ->
        assert (List.is_empty largs);
        build_recargs (ienv_push_var ienv (na, b, mk_norec)) tree d
@@ -680,7 +681,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_all env c) in
-	match kind_of_term x with
+	match kind x with
 
           | Prod (na,b,d) ->
 	     let () = assert (List.is_empty largs) in
@@ -709,7 +710,7 @@ let restrict_spec env spec p =
   let arctx, s = dest_prod_assum env ar in
   let env = push_rel_context arctx env in
   let i,args = decompose_app (whd_all env s) in
-  match kind_of_term i with
+  match kind i with
   | Ind i ->
      begin match spec with
 	   | Dead_code -> spec
@@ -730,7 +731,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_all renv.env t) in
-    match kind_of_term f with
+    match kind f with
     | Rel k -> subterm_var k renv
     | Case (ci,p,c,lbr) ->
        let stack' = push_stack_closures renv l stack in
@@ -773,7 +774,7 @@ let rec subterm_specif renv stack t =
 	let decrArg = recindxs.(i) in
 	let theBody = bodies.(i)   in
 	let nbOfAbst = decrArg+1 in
-	let sign,strippedBody = decompose_lam_n_assum nbOfAbst theBody in
+	let sign,strippedBody = Term.decompose_lam_n_assum nbOfAbst theBody in
 		   (* pushing the fix parameters *)
 	let stack' = push_stack_closures renv l stack in
 	let renv'' = push_ctxt_renv renv' sign in
@@ -795,21 +796,24 @@ let rec subterm_specif renv stack t =
 
     | Proj (p, c) -> 
       let subt = subterm_specif renv stack c in
-	(match subt with
-	| Subterm (s, wf) ->
-	   (* We take the subterm specs of the constructor of the record *)
-	   let wf_args = (dest_subterms wf).(0) in
-	   (* We extract the tree of the projected argument *)
-	   let kn = Projection.constant p in
-	   let cb = lookup_constant kn renv.env in
-	   let pb = Option.get cb.const_proj in
-	   let n = pb.proj_arg in
-	   Subterm (Strict, List.nth wf_args n)
-	| Dead_code -> Dead_code
-	| Not_subterm -> Not_subterm)
+      (match subt with
+       | Subterm (s, wf) ->
+         (* We take the subterm specs of the constructor of the record *)
+         let wf_args = (dest_subterms wf).(0) in
+         (* We extract the tree of the projected argument *)
+         let kn = Projection.constant p in
+         let cb = lookup_constant kn renv.env in
+         let pb = Option.get cb.const_proj in
+         let n = pb.proj_arg in
+         spec_of_tree (List.nth wf_args n)
+       | Dead_code -> Dead_code
+       | Not_subterm -> Not_subterm)
+
+    | Var _ | Sort _ | Cast _ | Prod _ | LetIn _ | App _ | Const _ | Ind _
+      | Construct _ | CoFix _ -> Not_subterm
+
 
       (* Other terms are not subterms *)
-    | _ -> Not_subterm
 
 and lazy_subterm_specif renv stack t =
   lazy (subterm_specif renv stack t)
@@ -857,11 +861,13 @@ let filter_stack_domain env ci p stack =
   else let env = push_rel_context absctx env in
   let rec filter_stack env ar stack =
     let t = whd_all env ar in
-    match stack, kind_of_term t with
+    match stack, kind t with
     | elt :: stack', Prod (n,a,c0) ->
       let d = LocalAssum (n,a) in
+      let ctx, a = dest_prod_assum env a in
+      let env = push_rel_context ctx env in
       let ty, args = decompose_app (whd_all env a) in
-      let elt = match kind_of_term ty with
+      let elt = match kind ty with
       | Ind ind -> 
         let spec' = stack_element_specif elt in
         (match (Lazy.force spec') with
@@ -892,7 +898,7 @@ let check_one_fix renv recpos trees def =
     if noccur_with_meta renv.rel_min nfi t then ()
     else
       let (f,l) = decompose_app (whd_betaiotazeta renv.env t) in
-      match kind_of_term f with
+      match kind f with
         | Rel p ->
             (* Test if [p] is a fixpoint (recursive call) *)
 	    if renv.rel_min <= p && p < renv.rel_min+nfi then
@@ -922,7 +928,7 @@ let check_one_fix renv recpos trees def =
                 | LocalDef (_,c,_) ->
                     try List.iter (check_rec_call renv []) l
                     with FixGuardError _ ->
-                      check_rec_call renv stack (applist(lift p c,l))
+                      check_rec_call renv stack (Term.applist(lift p c,l))
               end
 		
         | Case (ci,p,c_0,lrest) ->
@@ -968,7 +974,7 @@ let check_one_fix renv recpos trees def =
             if evaluable_constant kn renv.env then
               try List.iter (check_rec_call renv []) l
               with (FixGuardError _ ) ->
-		let value = (applist(constant_value_in renv.env cu, l)) in
+		let value = (Term.applist(constant_value_in renv.env cu, l)) in
 	        check_rec_call renv stack value
 	    else List.iter (check_rec_call renv []) l
 
@@ -1005,7 +1011,7 @@ let check_one_fix renv recpos trees def =
               | LocalDef (_,c,_) ->
                   try List.iter (check_rec_call renv []) l
                   with (FixGuardError _) -> 
-		    check_rec_call renv stack (applist(c,l))
+		    check_rec_call renv stack (Term.applist(c,l))
             end
 
 	| Sort _ ->
@@ -1020,7 +1026,7 @@ let check_one_fix renv recpos trees def =
     if Int.equal decr 0 then
       check_rec_call (assign_var_spec renv (1,recArgsDecrArg)) [] body
     else
-      match kind_of_term body with
+      match kind body with
 	| Lambda (x,a,b) ->
 	    check_rec_call renv [] a;
             let renv' = push_var_renv renv (x,a) in
@@ -1051,7 +1057,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_all env def) with
+      match kind (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
@@ -1092,8 +1098,8 @@ let check_fix env ((nvect,_),(names,_,bodies as recdef) as fix) =
     ()
 
 (*
-let cfkey = Profile.declare_profile "check_fix";;
-let check_fix env fix = Profile.profile3 cfkey check_fix env fix;;
+let cfkey = CProfile.declare_profile "check_fix";;
+let check_fix env fix = CProfile.profile3 cfkey check_fix env fix;;
 *)
 
 (************************************************************************)
@@ -1106,7 +1112,7 @@ let anomaly_ill_typed () =
 
 let rec codomain_is_coind env c =
   let b = whd_all env c in
-  match kind_of_term b with
+  match kind b with
     | Prod (x,a,b) ->
 	codomain_is_coind (push_rel (LocalAssum (x,a)) env) b
     | _ ->
@@ -1118,7 +1124,7 @@ 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_all env t) in
-      match kind_of_term c with
+      match kind c with
 	| Rel p when  n <= p && p < n+nbfix ->
 	    (* recursive call: must be guarded and no nested recursive
                call allowed *)
@@ -1190,8 +1196,8 @@ let check_one_cofix env nbfix def deftype =
 	| Meta _ -> ()
         | Evar _ ->
 	    List.iter (check_rec_call env alreadygrd n tree vlra) args
-
-	| _    -> raise (CoFixGuardError (env,NotGuardedForm t)) in
+        | Rel _ | Var _ | Sort _ | Cast _ | Prod _ | LetIn _ | App _ | Const _
+          | Ind _ | Fix _ | Proj _ -> raise (CoFixGuardError (env,NotGuardedForm t)) in
 
   let ((mind, _),_) = codomain_is_coind env deftype in
   let vlra = lookup_subterms env mind in
diff --git a/kernel/inductive.mli b/kernel/inductive.mli
index 0dfa8db00..8aaeee831 100644
--- a/kernel/inductive.mli
+++ b/kernel/inductive.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Univ
 open Declarations
 open Environ
@@ -32,23 +32,23 @@ type mind_specif = mutual_inductive_body * one_inductive_body
 val lookup_mind_specif : env -> inductive -> mind_specif
 
 (** {6 Functions to build standard types related to inductive } *)
-val ind_subst : mutual_inductive -> mutual_inductive_body -> universe_instance -> constr list
+val ind_subst : MutInd.t -> mutual_inductive_body -> Instance.t -> constr list
 
 val inductive_paramdecls : mutual_inductive_body puniverses -> Context.Rel.t
 
-val instantiate_inductive_constraints : 
-  mutual_inductive_body -> universe_instance -> constraints
+val instantiate_inductive_constraints :
+  mutual_inductive_body -> Instance.t -> Constraint.t
 
 val constrained_type_of_inductive : env -> mind_specif puniverses -> types constrained
-val constrained_type_of_inductive_knowing_parameters : 
+val constrained_type_of_inductive_knowing_parameters :
   env -> mind_specif puniverses -> types Lazy.t array -> types constrained
 
 val type_of_inductive : env -> mind_specif puniverses -> types
 
-val type_of_inductive_knowing_parameters : 
+val type_of_inductive_knowing_parameters :
   env -> ?polyprop:bool -> mind_specif puniverses -> types Lazy.t array -> types
 
-val elim_sorts : mind_specif -> sorts_family list
+val elim_sorts : mind_specif -> Sorts.family list
 
 val is_private : mind_specif -> bool
 val is_primitive_record : mind_specif -> bool
@@ -65,7 +65,7 @@ val arities_of_constructors : pinductive -> mind_specif -> types array
 val type_of_constructors : pinductive -> mind_specif -> types array
 
 (** Transforms inductive specification into types (in nf) *)
-val arities_of_specif : mutual_inductive puniverses -> mind_specif -> types array
+val arities_of_specif : MutInd.t puniverses -> mind_specif -> types array
 
 val inductive_params : mind_specif -> int
 
@@ -85,9 +85,9 @@ val build_branches_type :
     constr list -> constr -> types array
 
 (** Return the arity of an inductive type *)
-val mind_arity : one_inductive_body -> Context.Rel.t * sorts_family
+val mind_arity : one_inductive_body -> Context.Rel.t * Sorts.family
 
-val inductive_sort_family : one_inductive_body -> sorts_family
+val inductive_sort_family : one_inductive_body -> Sorts.family
 
 (** Check a [case_info] actually correspond to a Case expression on the
    given inductive type. *)
@@ -111,10 +111,10 @@ val check_cofix : env -> cofixpoint -> unit
 
 exception SingletonInductiveBecomesProp of Id.t
 
-val max_inductive_sort : sorts array -> universe
+val max_inductive_sort : Sorts.t array -> Universe.t
 
 val instantiate_universes : env -> Context.Rel.t ->
-  template_arity -> constr Lazy.t array -> Context.Rel.t * sorts
+  template_arity -> constr Lazy.t array -> Context.Rel.t * Sorts.t
 
 (** {6 Debug} *)
 
@@ -135,6 +135,6 @@ type stack_element = |SClosure of guard_env*constr |SArg of subterm_spec Lazy.t
 
 val subterm_specif : guard_env -> stack_element list -> constr -> subterm_spec
 
-val lambda_implicit_lift : int -> Constr.constr -> Term.constr
+val lambda_implicit_lift : int -> constr -> constr
 
-val abstract_mind_lc : int -> Int.t -> Constr.constr array -> Constr.constr array
+val abstract_mind_lc : int -> Int.t -> constr array -> constr array
diff --git a/kernel/kernel.mllib b/kernel/kernel.mllib
index 917e4f6f1..370185a72 100644
--- a/kernel/kernel.mllib
+++ b/kernel/kernel.mllib
@@ -16,14 +16,16 @@ Cemitcodes
 Opaqueproof
 Declarations
 Entries
+Vmvalues
 Nativevalues
 CPrimitives
 Declareops
 Retroknowledge
 Conv_oracle
 Pre_env
-Cbytegen
+Clambda
 Nativelambda
+Cbytegen
 Nativecode
 Nativelib
 Environ
diff --git a/kernel/mod_subst.ml b/kernel/mod_subst.ml
index 7b660939b..2c8ef477f 100644
--- a/kernel/mod_subst.ml
+++ b/kernel/mod_subst.ml
@@ -16,20 +16,20 @@
 open Pp
 open Util
 open Names
-open Term
+open Constr
 
 (* For Inline, the int is an inlining level, and the constr (if present)
    is the term into which we should inline. *)
 
 type delta_hint =
   | Inline of int * constr option
-  | Equiv of kernel_name
+  | Equiv of KerName.t
 
-(* NB: earlier constructor Prefix_equiv of module_path
+(* NB: earlier constructor Prefix_equiv of ModPath.t
    is now stored in a separate table, see Deltamap.t below *)
 
 module Deltamap = struct
-  type t = module_path MPmap.t * delta_hint KNmap.t
+  type t = ModPath.t MPmap.t * delta_hint KNmap.t
   let empty = MPmap.empty, KNmap.empty
   let is_empty (mm, km) =
     MPmap.is_empty mm && KNmap.is_empty km
@@ -45,7 +45,7 @@ module Deltamap = struct
 end
 
 (* Invariant: in the [delta_hint] map, an [Equiv] should only
-   relate [kernel_name] with the same label (and section dirpath). *)
+   relate [KerName.t] with the same label (and section dirpath). *)
 
 type delta_resolver = Deltamap.t
 
@@ -65,7 +65,7 @@ module Umap = struct
   let join map1 map2 = fold add_mp add_mbi map1 map2
 end
 
-type substitution = (module_path * delta_resolver) Umap.t
+type substitution = (ModPath.t * delta_resolver) Umap.t
 
 let empty_subst = Umap.empty
 
@@ -76,21 +76,21 @@ let is_empty_subst = Umap.is_empty
 let string_of_hint = function
   | Inline (_,Some _) -> "inline(Some _)"
   | Inline _ -> "inline()"
-  | Equiv kn -> string_of_kn kn
+  | Equiv kn -> KerName.to_string kn
 
 let debug_string_of_delta resolve =
   let kn_to_string kn hint l =
-    (string_of_kn kn ^ "=>" ^ string_of_hint hint) :: l
+    (KerName.to_string kn ^ "=>" ^ string_of_hint hint) :: l
   in
   let mp_to_string mp mp' l =
-    (string_of_mp mp ^ "=>" ^ string_of_mp mp') :: l
+    (ModPath.to_string mp ^ "=>" ^ ModPath.to_string mp') :: l
   in
   let l = Deltamap.fold mp_to_string kn_to_string resolve [] in
   String.concat ", " (List.rev l)
 
 let list_contents sub =
-  let one_pair (mp,reso) = (string_of_mp mp,debug_string_of_delta reso) in
-  let mp_one_pair mp0 p l = (string_of_mp mp0, one_pair p)::l in
+  let one_pair (mp,reso) = (ModPath.to_string mp,debug_string_of_delta reso) in
+  let mp_one_pair mp0 p l = (ModPath.to_string mp0, one_pair p)::l in
   let mbi_one_pair mbi p l = (MBId.debug_to_string mbi, one_pair p)::l in
   Umap.fold mp_one_pair mbi_one_pair sub []
 
@@ -117,7 +117,7 @@ let debug_pr_subst sub =
 let add_inline_delta_resolver kn (lev,oc) = Deltamap.add_kn kn (Inline (lev,oc))
 
 let add_kn_delta_resolver kn kn' =
-  assert (Label.equal (label kn) (label kn'));
+  assert (Label.equal (KerName.label kn) (KerName.label kn'));
   Deltamap.add_kn kn (Equiv kn')
 
 let add_mp_delta_resolver mp1 mp2 = Deltamap.add_mp mp1 mp2
@@ -165,12 +165,12 @@ let solve_delta_kn resolve kn =
       | Inline (lev, Some c) ->	raise (Change_equiv_to_inline (lev,c))
       | Inline (_, None) -> raise Not_found
   with Not_found ->
-    let mp,dir,l = repr_kn kn in
+    let mp,dir,l = KerName.repr kn in
     let new_mp = find_prefix resolve mp in
     if mp == new_mp then
       kn
     else
-      make_kn new_mp dir l
+      KerName.make new_mp dir l
 
 let kn_of_delta resolve kn =
   try solve_delta_kn resolve kn
@@ -242,18 +242,18 @@ let subst_mp sub mp =
   | Some (mp',_) -> mp'
 
 let subst_kn_delta sub kn =
- let mp,dir,l = repr_kn kn in
+ let mp,dir,l = KerName.repr kn in
   match subst_mp0 sub mp with
      Some (mp',resolve) ->
-      solve_delta_kn resolve (make_kn mp' dir l)
+      solve_delta_kn resolve (KerName.make mp' dir l)
    | None -> kn
 
 
 let subst_kn sub kn =
- let mp,dir,l = repr_kn kn in
+ let mp,dir,l = KerName.repr kn in
   match subst_mp0 sub mp with
      Some (mp',_) ->
-      (make_kn mp' dir l)
+      (KerName.make mp' dir l)
    | None -> kn
 
 exception No_subst
@@ -340,7 +340,7 @@ let subst_evaluable_reference subst = function
 
 let rec map_kn f f' c =
   let func = map_kn f f' in
-    match kind_of_term c with
+    match kind c with
       | Const kn -> (try snd (f' kn) with No_subst -> c)
       | Proj (p,t) -> 
           let p' = 
@@ -419,7 +419,7 @@ let subst_mps sub c =
 
 let rec replace_mp_in_mp mpfrom mpto mp =
   match mp with
-    | _ when mp_eq mp mpfrom -> mpto
+    | _ when ModPath.equal mp mpfrom -> mpto
     | MPdot (mp1,l) ->
 	let mp1' = replace_mp_in_mp mpfrom mpto mp1 in
 	  if mp1 == mp1' then mp
@@ -427,14 +427,14 @@ let rec replace_mp_in_mp mpfrom mpto mp =
     | _ -> mp
 
 let replace_mp_in_kn mpfrom mpto kn =
- let mp,dir,l = repr_kn kn in
+ let mp,dir,l = KerName.repr kn in
   let mp'' = replace_mp_in_mp mpfrom mpto mp in
     if mp==mp'' then kn
-    else make_kn mp'' dir l
+    else KerName.make mp'' dir l
 
 let rec mp_in_mp mp mp1 =
   match mp1 with
-    | _ when mp_eq mp1 mp -> true
+    | _ when ModPath.equal mp1 mp -> true
     | MPdot (mp2,l) -> mp_in_mp mp mp2
     | _ -> false
 
@@ -446,7 +446,7 @@ let subset_prefixed_by mp resolver =
     match hint with
       | Inline _ -> rslv
       | Equiv _ ->
-	if mp_in_mp mp (modpath kn) then Deltamap.add_kn kn hint rslv else rslv
+	if mp_in_mp mp (KerName.modpath kn) then Deltamap.add_kn kn hint rslv else rslv
   in
   Deltamap.fold mp_prefix kn_prefix resolver empty_delta_resolver
 
@@ -515,7 +515,7 @@ let add_delta_resolver resolver1 resolver2 =
 
 let substition_prefixed_by k mp subst =
   let mp_prefixmp kmp (mp_to,reso) sub =
-    if mp_in_mp mp kmp && not (mp_eq mp kmp) then
+    if mp_in_mp mp kmp && not (ModPath.equal mp kmp) then
       let new_key = replace_mp_in_mp mp k kmp in
       Umap.add_mp new_key (mp_to,reso) sub
     else sub
diff --git a/kernel/mod_subst.mli b/kernel/mod_subst.mli
index f1d0e4279..1aa7ba519 100644
--- a/kernel/mod_subst.mli
+++ b/kernel/mod_subst.mli
@@ -9,7 +9,7 @@
 (** {6 [Mod_subst] } *)
 
 open Names
-open Term
+open Constr
 
 (** {6 Delta resolver} *)
 
@@ -20,44 +20,44 @@ type delta_resolver
 val empty_delta_resolver : delta_resolver
 
 val add_mp_delta_resolver :
-  module_path -> module_path -> delta_resolver -> delta_resolver
+  ModPath.t -> ModPath.t -> delta_resolver -> delta_resolver
 
 val add_kn_delta_resolver :
-  kernel_name -> kernel_name -> delta_resolver -> delta_resolver
+  KerName.t -> KerName.t -> delta_resolver -> delta_resolver
 
 val add_inline_delta_resolver :
-  kernel_name -> (int * constr option) -> delta_resolver -> delta_resolver
+  KerName.t -> (int * constr option) -> delta_resolver -> delta_resolver
 
 val add_delta_resolver : delta_resolver -> delta_resolver -> delta_resolver
 
 (** Effect of a [delta_resolver] on a module path, on a kernel name *)
 
-val mp_of_delta : delta_resolver -> module_path -> module_path
-val kn_of_delta : delta_resolver -> kernel_name -> kernel_name
+val mp_of_delta : delta_resolver -> ModPath.t -> ModPath.t
+val kn_of_delta : delta_resolver -> KerName.t -> KerName.t
 
 (** Build a constant whose canonical part is obtained via a resolver *)
 
-val constant_of_delta_kn : delta_resolver -> kernel_name -> constant
+val constant_of_delta_kn : delta_resolver -> KerName.t -> Constant.t
 
 (** Same, but a 2nd resolver is tried if the 1st one had no effect *)
 
 val constant_of_deltas_kn :
-  delta_resolver -> delta_resolver -> kernel_name -> constant
+  delta_resolver -> delta_resolver -> KerName.t -> Constant.t
 
 (** Same for inductive names *)
 
-val mind_of_delta_kn : delta_resolver -> kernel_name -> mutual_inductive
+val mind_of_delta_kn : delta_resolver -> KerName.t -> MutInd.t
 val mind_of_deltas_kn :
-  delta_resolver -> delta_resolver -> kernel_name -> mutual_inductive
+  delta_resolver -> delta_resolver -> KerName.t -> MutInd.t
 
 (** Extract the set of inlined constant in the resolver *)
-val inline_of_delta : int option -> delta_resolver -> (int * kernel_name) list
+val inline_of_delta : int option -> delta_resolver -> (int * KerName.t) list
 
 (** Does a [delta_resolver] contains a [mp], a constant, an inductive ? *)
 
-val mp_in_delta : module_path -> delta_resolver -> bool
-val con_in_delta : constant -> delta_resolver -> bool
-val mind_in_delta : mutual_inductive -> delta_resolver -> bool
+val mp_in_delta : ModPath.t -> delta_resolver -> bool
+val con_in_delta : Constant.t -> delta_resolver -> bool
+val mind_in_delta : MutInd.t -> delta_resolver -> bool
 
 
 (** {6 Substitution} *)
@@ -72,15 +72,15 @@ val is_empty_subst : substitution -> bool
    composition. Most often this is not what you want. For sequential
    composition, try [join (map_mbid mp delta) subs] **)
 val add_mbid :
-  MBId.t -> module_path -> delta_resolver  -> substitution -> substitution
+  MBId.t -> ModPath.t -> delta_resolver  -> substitution -> substitution
 val add_mp :
-  module_path -> module_path -> delta_resolver -> substitution -> substitution
+  ModPath.t -> ModPath.t -> delta_resolver -> substitution -> substitution
 
 (** map_* create a new substitution [arg2/arg1]\{arg3\} *)
 val map_mbid :
-  MBId.t -> module_path -> delta_resolver -> substitution
+  MBId.t -> ModPath.t -> delta_resolver -> substitution
 val map_mp :
-  module_path -> module_path -> delta_resolver -> substitution
+  ModPath.t -> ModPath.t -> delta_resolver -> substitution
 
 (** sequential composition:
    [substitute (join sub1 sub2) t = substitute sub2 (substitute sub1 t)]
@@ -117,10 +117,10 @@ val debug_pr_delta : delta_resolver -> Pp.t
    as well [==] *)
 
 val subst_mp :
-  substitution -> module_path -> module_path
+  substitution -> ModPath.t -> ModPath.t
 
 val subst_mind :
-  substitution -> mutual_inductive -> mutual_inductive
+  substitution -> MutInd.t -> MutInd.t
 
 val subst_ind :
   substitution -> inductive -> inductive
@@ -128,10 +128,10 @@ val subst_ind :
 val subst_pind : substitution -> pinductive -> pinductive
 
 val subst_kn :
-  substitution -> kernel_name -> kernel_name
+  substitution -> KerName.t -> KerName.t
 
 val subst_con :
-  substitution -> pconstant -> constant * constr
+  substitution -> pconstant -> Constant.t * constr
 
 val subst_pcon :
   substitution -> pconstant -> pconstant
@@ -140,10 +140,10 @@ val subst_pcon_term :
   substitution -> pconstant -> pconstant * constr
 
 val subst_con_kn :
-  substitution -> constant -> constant * constr
+  substitution -> Constant.t -> Constant.t * constr
 
-val subst_constant : 
-  substitution -> constant -> constant
+val subst_constant :
+  substitution -> Constant.t -> Constant.t
 
 (** Here the semantics is completely unclear.
    What does "Hint Unfold t" means when "t" is a parameter?
@@ -154,7 +154,7 @@ val subst_evaluable_reference :
   substitution -> evaluable_global_reference -> evaluable_global_reference
 
 (** [replace_mp_in_con mp mp' con] replaces [mp] with [mp'] in [con] *)
-val replace_mp_in_kn : module_path -> module_path -> kernel_name -> kernel_name
+val replace_mp_in_kn : ModPath.t -> ModPath.t -> KerName.t -> KerName.t
 
 (** [subst_mps sub c] performs the substitution [sub] on all kernel
    names appearing in [c] *)
@@ -171,6 +171,5 @@ val occur_mbid : MBId.t -> substitution -> bool
 
 val repr_substituted : 'a substituted -> substitution list option * 'a
 
-val force_constr : Term.constr substituted -> Term.constr
-val subst_constr :
-  substitution -> Term.constr substituted -> Term.constr substituted
+val force_constr : constr substituted -> constr
+val subst_constr : substitution -> constr substituted -> constr substituted
diff --git a/kernel/mod_typing.ml b/kernel/mod_typing.ml
index 0888ccc10..6b89a1da0 100644
--- a/kernel/mod_typing.ml
+++ b/kernel/mod_typing.ml
@@ -73,27 +73,21 @@ let rec check_with_def env struc (idl,(c,ctx)) mp equiv =
          any implementations of parameters and opaques terms,
 	 as long as they have the right type *)
       let c', univs, ctx' =
-        match cb.const_universes with
-        | Monomorphic_const _ ->
-          (** We do not add the deferred constraints of the body in the
-              environment, because they do not appear in the type of the
-              definition. Any inconsistency will be raised at a later stage
-              when joining the environment. *)
-	  let env' = Environ.push_context ~strict:true ctx env' in
-	  let c',cst = match cb.const_body with
-	    | Undef _ | OpaqueDef _ ->
-	      let j = Typeops.infer env' c in
-	      let typ = cb.const_type in
-	      let cst' = Reduction.infer_conv_leq env' (Environ.universes env')
-						j.uj_type typ in
-	      j.uj_val, cst'
-	    | Def cs ->
-	       let c' = Mod_subst.force_constr cs in
-	         c, Reduction.infer_conv env' (Environ.universes env') c c'
-	  in c', Monomorphic_const ctx, Univ.ContextSet.add_constraints cst (Univ.ContextSet.of_context ctx)
-        | Polymorphic_const uctx ->
-          let subst, ctx = Univ.abstract_universes ctx in
-          let c = Vars.subst_univs_level_constr subst c in
+        match cb.const_universes, ctx with
+        | Monomorphic_const _, None ->
+          let c',cst = match cb.const_body with
+            | Undef _ | OpaqueDef _ ->
+              let j = Typeops.infer env' c in
+              let typ = cb.const_type in
+              let cst' = Reduction.infer_conv_leq env' (Environ.universes env')
+                  j.uj_type typ in
+              j.uj_val, cst'
+            | Def cs ->
+              let c' = Mod_subst.force_constr cs in
+              c, Reduction.infer_conv env' (Environ.universes env') c c'
+          in
+          c', Monomorphic_const Univ.ContextSet.empty, cst
+        | Polymorphic_const uctx, Some ctx ->
           let () =
             if not (UGraph.check_subtype (Environ.universes env) uctx ctx) then
               error_incorrect_with_constraint lab
@@ -114,7 +108,8 @@ let rec check_with_def env struc (idl,(c,ctx)) mp equiv =
 	  in
 	    if not (Univ.Constraint.is_empty cst) then
 	      error_incorrect_with_constraint lab;
-            c, Polymorphic_const ctx, Univ.ContextSet.empty
+            c, Polymorphic_const ctx, Univ.Constraint.empty
+        | _ -> error_incorrect_with_constraint lab
       in
       let def = Def (Mod_subst.from_val c') in
 (*      let ctx' = Univ.UContext.make (newus, cst) in *)
@@ -166,16 +161,10 @@ let rec check_with_mod env struc (idl,mp1) mp equiv =
       let mb_mp1 = lookup_module mp1 env in
       let mtb_mp1 = module_type_of_module mb_mp1 in
       let cst = match old.mod_expr with
-	| Abstract ->
-	  begin
-            try
-              let mtb_old = module_type_of_module old in
-              let chk_cst = Subtyping.check_subtypes env' mtb_mp1 mtb_old in
-              Univ.ContextSet.add_constraints chk_cst old.mod_constraints
-	    with Failure _ ->
-              (* TODO: where can a Failure come from ??? *)
-              error_incorrect_with_constraint lab
-	  end
+        | Abstract ->
+          let mtb_old = module_type_of_module old in
+          let chk_cst = Subtyping.check_subtypes env' mtb_mp1 mtb_old in
+          Univ.ContextSet.add_constraints chk_cst old.mod_constraints
 	| Algebraic (NoFunctor (MEident(mp'))) ->
 	  check_modpath_equiv env' mp1 mp';
 	  old.mod_constraints
@@ -229,11 +218,11 @@ let rec check_with_mod env struc (idl,mp1) mp equiv =
   | Reduction.NotConvertible -> error_incorrect_with_constraint lab
 
 let check_with env mp (sign,alg,reso,cst) = function
-  |WithDef(idl,c) ->
+  |WithDef(idl, (c, ctx)) ->
     let struc = destr_nofunctor sign in
-    let struc',c',cst' = check_with_def env struc (idl,c) mp reso in
-    let wd' = WithDef (idl,(c',Univ.ContextSet.to_context cst')) in
-    NoFunctor struc', MEwith (alg,wd'), reso, cst+++cst'
+    let struc', c', cst' = check_with_def env struc (idl, (c, ctx)) mp reso in
+    let wd' = WithDef (idl, (c', ctx)) in
+    NoFunctor struc', MEwith (alg,wd'), reso, Univ.ContextSet.add_constraints cst' cst
   |WithMod(idl,mp1) as wd ->
     let struc = destr_nofunctor sign in
     let struc',reso',cst' = check_with_mod env struc (idl,mp1) mp reso in
@@ -264,7 +253,9 @@ let rec translate_mse env mpo inl = function
   |MEident mp1 as me ->
     let mb = match mpo with
       |Some mp -> strengthen_and_subst_mb (lookup_module mp1 env) mp false
-      |None -> lookup_modtype mp1 env
+      |None ->
+        let mt = lookup_modtype mp1 env in
+        module_body_of_type mt.mod_mp mt
     in
     mb.mod_type, me, mb.mod_delta, Univ.ContextSet.empty
   |MEapply (fe,mp1) ->
@@ -281,9 +272,11 @@ let mk_mod mp e ty cst reso =
     mod_type_alg = None;
     mod_constraints = cst;
     mod_delta = reso;
-    mod_retroknowledge = [] }
+    mod_retroknowledge = ModBodyRK []; }
 
-let mk_modtype mp ty cst reso = mk_mod mp Abstract ty cst reso
+let mk_modtype mp ty cst reso =
+  let mb = mk_mod mp Abstract ty cst reso in
+  { mb with mod_expr = (); mod_retroknowledge = ModTypeRK }
 
 let rec translate_mse_funct env mpo inl mse = function
   |[] ->
@@ -319,6 +312,7 @@ let finalize_module env mp (sign,alg,reso,cst) restype = match restype with
     { res_mtb with
       mod_mp = mp;
       mod_expr = impl;
+      mod_retroknowledge = ModBodyRK [];
       (** cst from module body typing,
           cst' from subtyping,
           constraints from module type. *)
diff --git a/kernel/mod_typing.mli b/kernel/mod_typing.mli
index dcabb1334..1225c3e1e 100644
--- a/kernel/mod_typing.mli
+++ b/kernel/mod_typing.mli
@@ -21,16 +21,16 @@ open Names
 *)
 
 val translate_module :
-  env -> module_path -> inline -> module_entry -> module_body
+  env -> ModPath.t -> inline -> module_entry -> module_body
 
 (** [translate_modtype] produces a [module_type_body] whose [mod_type_alg]
     cannot be [None] (and of course [mod_expr] is [Abstract]). *)
 
 val translate_modtype :
-  env -> module_path -> inline -> module_type_entry -> module_type_body
+  env -> ModPath.t -> inline -> module_type_entry -> module_type_body
 
 (** Low-level function for translating a module struct entry :
-    - We translate to a module when a [module_path] is given,
+    - We translate to a module when a [ModPath.t] is given,
       otherwise to a module type.
     - The first output is the expanded signature
     - The second output is the algebraic expression, kept mostly for
@@ -40,14 +40,14 @@ type 'alg translation =
   module_signature * 'alg * delta_resolver * Univ.ContextSet.t
 
 val translate_mse :
-  env -> module_path option -> inline -> module_struct_entry ->
+  env -> ModPath.t option -> inline -> module_struct_entry ->
     module_alg_expr translation
 
 (** From an already-translated (or interactive) implementation and
     an (optional) signature entry, produces a final [module_body] *)
 
 val finalize_module :
-  env -> module_path -> (module_expression option) translation ->
+  env -> ModPath.t -> (module_expression option) translation ->
   (module_type_entry * inline) option ->
   module_body
 
@@ -55,5 +55,5 @@ val finalize_module :
     module type given to an Include *)
 
 val translate_mse_incl :
-  bool -> env -> module_path -> inline -> module_struct_entry ->
+  bool -> env -> ModPath.t -> inline -> module_struct_entry ->
     unit translation
diff --git a/kernel/modops.ml b/kernel/modops.ml
index a079bc893..11e6be659 100644
--- a/kernel/modops.ml
+++ b/kernel/modops.ml
@@ -17,7 +17,7 @@
 
 open Util
 open Names
-open Term
+open Constr
 open Declarations
 open Declareops
 open Environ
@@ -59,7 +59,7 @@ type module_typing_error =
   | NotAFunctor
   | IsAFunctor
   | IncompatibleModuleTypes of module_type_body * module_type_body
-  | NotEqualModulePaths of module_path * module_path
+  | NotEqualModulePaths of ModPath.t * ModPath.t
   | NoSuchLabel of Label.t
   | IncompatibleLabels of Label.t * Label.t
   | NotAModule of string
@@ -68,7 +68,7 @@ type module_typing_error =
   | IncorrectWithConstraint of Label.t
   | GenerativeModuleExpected of Label.t
   | LabelMissing of Label.t * string
-  | IncludeRestrictedFunctor of module_path
+  | IncludeRestrictedFunctor of ModPath.t
 
 exception ModuleTypingError of module_typing_error
 
@@ -143,11 +143,12 @@ let rec functor_iter fty f0 = function
 (** {6 Misc operations } *)
 
 let module_type_of_module mb =
-  { mb with mod_expr = Abstract; mod_type_alg = None }
+  { mb with mod_expr = (); mod_type_alg = None;
+    mod_retroknowledge = ModTypeRK; }
 
 let module_body_of_type mp mtb =
-  assert (mtb.mod_expr == Abstract);
-  { mtb with mod_mp = mp }
+  { mtb with mod_expr = Abstract; mod_mp = mp;
+      mod_retroknowledge = ModBodyRK []; }
 
 let check_modpath_equiv env mp1 mp2 =
   if ModPath.equal mp1 mp2 then ()
@@ -196,7 +197,8 @@ let rec subst_structure sub do_delta sign =
   in
   List.smartmap subst_body sign
 
-and subst_body is_mod sub do_delta mb =
+and subst_body : 'a. _ -> _ -> (_ -> 'a -> 'a) -> _ -> 'a generic_module_body -> 'a generic_module_body =
+  fun is_mod sub subst_impl do_delta mb ->
   let { mod_mp=mp; mod_expr=me; mod_type=ty; mod_type_alg=aty } = mb in
   let mp' = subst_mp sub mp in
   let sub =
@@ -205,10 +207,7 @@ and subst_body is_mod sub do_delta mb =
     else add_mp mp mp' empty_delta_resolver sub
   in
   let ty' = subst_signature sub do_delta ty in
-  let me' =
-    implem_smartmap
-      (subst_signature sub id_delta) (subst_expression sub id_delta) me
-  in
+  let me' = subst_impl sub me in
   let aty' = Option.smartmap (subst_expression sub id_delta) aty in
   let delta' = do_delta mb.mod_delta sub in
   if mp==mp' && me==me' && ty==ty' && aty==aty' && delta'==mb.mod_delta
@@ -221,9 +220,14 @@ and subst_body is_mod sub do_delta mb =
       mod_type_alg = aty';
       mod_delta = delta' }
 
-and subst_module sub do_delta mb = subst_body true sub do_delta mb
+and subst_module sub do_delta mb =
+  subst_body true sub subst_impl do_delta mb
+
+and subst_impl sub me =
+  implem_smartmap
+    (subst_signature sub id_delta) (subst_expression sub id_delta) me
 
-and subst_modtype sub do_delta mtb = subst_body false sub do_delta mtb
+and subst_modtype sub do_delta mtb = subst_body false sub (fun _ () -> ()) do_delta mtb
 
 and subst_expr sub do_delta seb = match seb with
   |MEident mp ->
@@ -262,13 +266,13 @@ let subst_structure subst = subst_structure subst do_delta_codom
 (* lclrk : retroknowledge_action list, rkaction : retroknowledge action *)
 let add_retroknowledge mp =
   let perform rkaction env = match rkaction with
-    |Retroknowledge.RKRegister (f, e) when (isConst e || isInd e) ->
+    | Retroknowledge.RKRegister (f, e) when (isConst e || isInd e) ->
       Environ.register env f e
-    |_ ->
+    | _ ->
       CErrors.anomaly ~label:"Modops.add_retroknowledge"
         (Pp.str "had to import an unsupported kind of term.")
   in
-  fun lclrk env ->
+  fun (ModBodyRK lclrk) env ->
   (* The order of the declaration matters, for instance (and it's at the
      time this comment is being written, the only relevent instance) the
      int31 type registration absolutely needs int31 bits to be registered.
@@ -399,8 +403,8 @@ let inline_delta_resolver env inl mp mbid mtb delta =
 	      let constr = Mod_subst.force_constr body in
 	      add_inline_delta_resolver kn (lev, Some constr) l
 	with Not_found ->
-	  error_no_such_label_sub (con_label con)
-	    (string_of_mp (con_modpath con))
+	  error_no_such_label_sub (Constant.label con)
+	    (ModPath.to_string (Constant.modpath con))
   in
   make_inline delta constants
 
@@ -567,7 +571,7 @@ let rec is_bounded_expr l = function
       is_bounded_expr l (MEident mp) || is_bounded_expr l fexpr
   | _ -> false
 
-let rec clean_module l mb =
+let rec clean_module_body l mb =
   let impl, typ = mb.mod_expr, mb.mod_type in
   let typ' = clean_signature l typ in
   let impl' = match impl with
@@ -577,19 +581,25 @@ let rec clean_module l mb =
   if typ==typ' && impl==impl' then mb
   else { mb with mod_type=typ'; mod_expr=impl' }
 
+and clean_module_type l mb =
+  let (), typ = mb.mod_expr, mb.mod_type in
+  let typ' = clean_signature l typ in
+  if typ==typ' then mb
+  else { mb with mod_type=typ' }
+
 and clean_field l field = match field with
   |(lab,SFBmodule mb) ->
-    let mb' = clean_module l mb in
+    let mb' = clean_module_body l mb in
     if mb==mb' then field else (lab,SFBmodule mb')
   |_ -> field
 
 and clean_structure l = List.smartmap (clean_field l)
 
 and clean_signature l =
-  functor_smartmap (clean_module l) (clean_structure l)
+  functor_smartmap (clean_module_type l) (clean_structure l)
 
 and clean_expression l =
-  functor_smartmap (clean_module l) (fun me -> me)
+  functor_smartmap (clean_module_type l) (fun me -> me)
 
 let rec collect_mbid l sign =  match sign with
   |MoreFunctor (mbid,ty,m) ->
@@ -613,14 +623,16 @@ let join_constant_body except otab cb =
   | _ -> ()
 
 let join_structure except otab s =
-  let rec join_module mb =
-    implem_iter join_signature join_expression mb.mod_expr;
+  let rec join_module : 'a. 'a generic_module_body -> unit = fun mb ->
     Option.iter join_expression mb.mod_type_alg;
     join_signature mb.mod_type
   and join_field (l,body) = match body with
     |SFBconst sb -> join_constant_body except otab sb
     |SFBmind _ -> ()
-    |SFBmodule m |SFBmodtype m -> join_module m
+    |SFBmodule m ->
+      implem_iter join_signature join_expression m.mod_expr;
+      join_module m
+    |SFBmodtype m -> join_module m
   and join_structure struc = List.iter join_field struc
   and join_signature sign =
     functor_iter join_module join_structure sign
diff --git a/kernel/modops.mli b/kernel/modops.mli
index e2a94b691..bbb4c918c 100644
--- a/kernel/modops.mli
+++ b/kernel/modops.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
 open Declarations
 open Entries
@@ -26,9 +26,9 @@ val destr_nofunctor : ('ty,'a) functorize -> 'a
 (** Conversions between [module_body] and [module_type_body] *)
 
 val module_type_of_module : module_body -> module_type_body
-val module_body_of_type : module_path -> module_type_body -> module_body
+val module_body_of_type : ModPath.t -> module_type_body -> module_body
 
-val check_modpath_equiv : env -> module_path -> module_path -> unit
+val check_modpath_equiv : env -> ModPath.t -> ModPath.t -> unit
 
 val implem_smartmap :
   (module_signature -> module_signature) ->
@@ -43,7 +43,7 @@ val subst_structure : substitution -> structure_body -> structure_body
 (** {6 Adding to an environment } *)
 
 val add_structure :
-  module_path -> structure_body -> delta_resolver -> env -> env
+  ModPath.t -> structure_body -> delta_resolver -> env -> env
 
 (** adds a module and its components, but not the constraints *)
 val add_module : module_body -> env -> env
@@ -53,19 +53,19 @@ the native compiler. The linking information is updated. *)
 val add_linked_module : module_body -> Pre_env.link_info -> env -> env
 
 (** same, for a module type *)
-val add_module_type : module_path -> module_type_body -> env -> env
+val add_module_type : ModPath.t -> module_type_body -> env -> env
 
 (** {6 Strengthening } *)
 
-val strengthen : module_type_body -> module_path -> module_type_body
+val strengthen : module_type_body -> ModPath.t -> module_type_body
 
 val inline_delta_resolver :
-  env -> inline -> module_path -> MBId.t -> module_type_body ->
+  env -> inline -> ModPath.t -> MBId.t -> module_type_body ->
   delta_resolver -> delta_resolver
 
-val strengthen_and_subst_mb : module_body -> module_path -> bool -> module_body
+val strengthen_and_subst_mb : module_body -> ModPath.t -> bool -> module_body
 
-val subst_modtype_and_resolver : module_type_body -> module_path ->
+val subst_modtype_and_resolver : module_type_body -> ModPath.t ->
   module_type_body
 
 (** {6 Cleaning a module expression from bounded parts }
@@ -118,7 +118,7 @@ type module_typing_error =
   | NotAFunctor
   | IsAFunctor
   | IncompatibleModuleTypes of module_type_body * module_type_body
-  | NotEqualModulePaths of module_path * module_path
+  | NotEqualModulePaths of ModPath.t * ModPath.t
   | NoSuchLabel of Label.t
   | IncompatibleLabels of Label.t * Label.t
   | NotAModule of string
@@ -127,7 +127,7 @@ type module_typing_error =
   | IncorrectWithConstraint of Label.t
   | GenerativeModuleExpected of Label.t
   | LabelMissing of Label.t * string
-  | IncludeRestrictedFunctor of module_path
+  | IncludeRestrictedFunctor of ModPath.t
 
 exception ModuleTypingError of module_typing_error
 
@@ -153,4 +153,4 @@ val error_generative_module_expected : Label.t -> 'a
 
 val error_no_such_label_sub : Label.t->string->'a
 
-val error_include_restricted_functor : module_path -> 'a
+val error_include_restricted_functor : ModPath.t -> 'a
diff --git a/kernel/names.ml b/kernel/names.ml
index e524f4258..b02c0b840 100644
--- a/kernel/names.ml
+++ b/kernel/names.ml
@@ -113,8 +113,7 @@ struct
 
   module Self_Hashcons =
     struct
-      type _t = t
-      type t = _t
+      type nonrec t = t
       type u = Id.t -> Id.t
       let hashcons hident = function
         | Name id -> Name (hident id)
@@ -180,6 +179,8 @@ struct
     | [] -> "<>"
     | sl -> String.concat "." (List.rev_map Id.to_string sl)
 
+  let print dp = str (to_string dp)
+
   let initial = [default_module_name]
 
   module Hdir = Hashcons.Hlist(Id)
@@ -236,8 +237,7 @@ struct
 
   module Self_Hashcons =
     struct
-      type _t = t
-      type t = _t
+      type nonrec t = t
       type u = (Id.t -> Id.t) * (DirPath.t -> DirPath.t)
       let hashcons (hid,hdir) (n,s,dir) = (n,hid s,hdir dir)
       let eq ((n1,s1,dir1) as x) ((n2,s2,dir2) as y) =
@@ -869,8 +869,7 @@ struct
 
   module Self_Hashcons =
     struct
-      type _t = t
-      type t = _t
+      type nonrec t = t
       type u = Constant.t -> Constant.t
       let hashcons hc (c,b) = (hc c,b)
       let eq ((c,b) as x) ((c',b') as y) =
diff --git a/kernel/names.mli b/kernel/names.mli
index d111dd3c0..b1e8efd8d 100644
--- a/kernel/names.mli
+++ b/kernel/names.mli
@@ -40,19 +40,16 @@ sig
   (** Hash over identifiers. *)
 
   val is_valid : string -> bool
-  (** Check that a string may be converted to an identifier.
-  @raise Unicode.Unsupported if the provided string contains unsupported UTF-8 characters. *)
+  (** Check that a string may be converted to an identifier. *)
 
   val of_bytes : bytes -> t
   val of_string : string -> t
   (** Converts a string into an identifier.
-      @raise UserError if the string is invalid as an identifier.
-      @raise Unicode.Unsupported if the provided string contains unsupported UTF-8 characters. *)
+      @raise UserError if the string is invalid as an identifier. *)
 
   val of_string_soft : string -> t
   (** Same as {!of_string} except that any string made of supported UTF-8 characters is accepted.
-      @raise UserError if the string is invalid as an UTF-8 string.
-      @raise Unicode.Unsupported if the provided string contains unsupported UTF-8 characters. *)
+      @raise UserError if the string is invalid as an UTF-8 string. *)
 
   val to_string : t -> string
   (** Converts a identifier into an string. *)
@@ -113,6 +110,8 @@ end
 (** {6 Type aliases} *)
 
 type name = Name.t = Anonymous | Name of Id.t
+[@@ocaml.deprecated "Use Name.t"]
+
 type variable = Id.t
 type module_ident = Id.t
 
@@ -157,6 +156,7 @@ sig
   val hcons : t -> t
   (** Hashconsing of directory paths. *)
 
+  val print : t -> Pp.t
 end
 
 (** {6 Names of structure elements } *)
@@ -298,7 +298,6 @@ module KNset  : CSig.SetS with type elt = KerName.t
 module KNpred : Predicate.S with type elt = KerName.t
 module KNmap  : Map.ExtS with type key = KerName.t and module Set := KNset
 
-
 (** {6 Constant Names } *)
 
 module Constant:
@@ -546,80 +545,81 @@ val eq_ind_chk : inductive -> inductive -> bool
 (** {5 Identifiers} *)
 
 type identifier = Id.t
-(** @deprecated Alias for [Id.t] *)
+[@@ocaml.deprecated "Alias for [Id.t]"]
 
-val string_of_id : identifier -> string
-(** @deprecated Same as [Id.to_string]. *)
+val string_of_id : Id.t -> string
+[@@ocaml.deprecated "Same as [Id.to_string]."]
 
-val id_of_string : string -> identifier
-(** @deprecated Same as [Id.of_string]. *)
+val id_of_string : string -> Id.t
+[@@ocaml.deprecated "Same as [Id.of_string]."]
 
-val id_ord : identifier -> identifier -> int
-(** @deprecated Same as [Id.compare]. *)
+val id_ord : Id.t -> Id.t -> int
+[@@ocaml.deprecated "Same as [Id.compare]."]
 
-val id_eq : identifier -> identifier -> bool
-(** @deprecated Same as [Id.equal]. *)
+val id_eq : Id.t -> Id.t -> bool
+[@@ocaml.deprecated "Same as [Id.equal]."]
 
-module Idset  : Set.S with type elt = identifier and type t = Id.Set.t
-(** @deprecated Same as [Id.Set]. *)
+module Idset  : Set.S with type elt = Id.t and type t = Id.Set.t
+[@@ocaml.deprecated "Same as [Id.Set]."]
 
-module Idpred : Predicate.S with type elt = identifier and type t = Id.Pred.t
-(** @deprecated Same as [Id.Pred]. *)
+module Idpred : Predicate.S with type elt = Id.t and type t = Id.Pred.t
+[@@ocaml.deprecated "Same as [Id.Pred]."]
 
 module Idmap : module type of Id.Map
-(** @deprecated Same as [Id.Map]. *)
+[@@ocaml.deprecated "Same as [Id.Map]."]
 
 (** {5 Directory paths} *)
 
 type dir_path = DirPath.t
-(** @deprecated Alias for [DirPath.t]. *)
+[@@ocaml.deprecated "Alias for [DirPath.t]."]
 
-val dir_path_ord : dir_path -> dir_path -> int
-(** @deprecated Same as [DirPath.compare]. *)
+val dir_path_ord : DirPath.t -> DirPath.t -> int
+[@@ocaml.deprecated "Same as [DirPath.compare]."]
 
-val dir_path_eq : dir_path -> dir_path -> bool
-(** @deprecated Same as [DirPath.equal]. *)
+val dir_path_eq : DirPath.t -> DirPath.t -> bool
+[@@ocaml.deprecated "Same as [DirPath.equal]."]
 
-val make_dirpath : module_ident list -> dir_path
-(** @deprecated Same as [DirPath.make]. *)
+val make_dirpath : module_ident list -> DirPath.t
+[@@ocaml.deprecated "Same as [DirPath.make]."]
 
-val repr_dirpath : dir_path -> module_ident list
-(** @deprecated Same as [DirPath.repr]. *)
+val repr_dirpath : DirPath.t -> module_ident list
+[@@ocaml.deprecated "Same as [DirPath.repr]."]
 
-val empty_dirpath : dir_path
-(** @deprecated Same as [DirPath.empty]. *)
+val empty_dirpath : DirPath.t
+[@@ocaml.deprecated "Same as [DirPath.empty]."]
 
-val is_empty_dirpath : dir_path -> bool
-(** @deprecated Same as [DirPath.is_empty]. *)
+val is_empty_dirpath : DirPath.t -> bool
+[@@ocaml.deprecated "Same as [DirPath.is_empty]."]
 
-val string_of_dirpath : dir_path -> string
-(** @deprecated Same as [DirPath.to_string]. *)
+val string_of_dirpath : DirPath.t -> string
+[@@ocaml.deprecated "Same as [DirPath.to_string]."]
 
 val initial_dir : DirPath.t
-(** @deprecated Same as [DirPath.initial]. *)
+[@@ocaml.deprecated "Same as [DirPath.initial]."]
 
 (** {5 Labels} *)
 
 type label = Label.t
+[@@ocaml.deprecated "Same as [Label.t]."]
 (** Alias type *)
 
-val mk_label : string -> label
-(** @deprecated Same as [Label.make]. *)
+val mk_label : string -> Label.t
+[@@ocaml.deprecated "Same as [Label.make]."]
 
-val string_of_label : label -> string
-(** @deprecated Same as [Label.to_string]. *)
+val string_of_label : Label.t -> string
+[@@ocaml.deprecated "Same as [Label.to_string]."]
 
-val pr_label : label -> Pp.t
-(** @deprecated Same as [Label.print]. *)
+val pr_label : Label.t -> Pp.t
+[@@ocaml.deprecated "Same as [Label.print]."]
 
-val label_of_id : Id.t -> label
-(** @deprecated Same as [Label.of_id]. *)
+val label_of_id : Id.t -> Label.t
+[@@ocaml.deprecated "Same as [Label.of_id]."]
 
-val id_of_label : label -> Id.t
-(** @deprecated Same as [Label.to_id]. *)
+val id_of_label : Label.t -> Id.t
+[@@ocaml.deprecated "Same as [Label.to_id]."]
 
-val eq_label : label -> label -> bool
-(** @deprecated Same as [Label.equal]. *)
+val eq_label : Label.t -> Label.t -> bool
+[@@ocaml.deprecated "Same as [Label.equal]."]
 
 (** {5 Unique bound module names} *)
 
@@ -627,89 +627,89 @@ type mod_bound_id = MBId.t
 (** Alias type. *)
 
 val mod_bound_id_ord : mod_bound_id -> mod_bound_id -> int
-(** @deprecated Same as [MBId.compare]. *)
+[@@ocaml.deprecated "Same as [MBId.compare]."]
 
 val mod_bound_id_eq : mod_bound_id -> mod_bound_id -> bool
-(** @deprecated Same as [MBId.equal]. *)
+[@@ocaml.deprecated "Same as [MBId.equal]."]
 
 val make_mbid : DirPath.t -> Id.t -> mod_bound_id
-(** @deprecated Same as [MBId.make]. *)
+[@@ocaml.deprecated "Same as [MBId.make]."]
 
 val repr_mbid : mod_bound_id -> int * Id.t * DirPath.t
-(** @deprecated Same as [MBId.repr]. *)
+[@@ocaml.deprecated "Same as [MBId.repr]."]
 
 val id_of_mbid : mod_bound_id -> Id.t
-(** @deprecated Same as [MBId.to_id]. *)
+[@@ocaml.deprecated "Same as [MBId.to_id]."]
 
 val string_of_mbid : mod_bound_id -> string
-(** @deprecated Same as [MBId.to_string]. *)
+[@@ocaml.deprecated "Same as [MBId.to_string]."]
 
 val debug_string_of_mbid : mod_bound_id -> string
-(** @deprecated Same as [MBId.debug_to_string]. *)
+[@@ocaml.deprecated "Same as [MBId.debug_to_string]."]
 
 (** {5 Names} *)
 
-val name_eq : name -> name -> bool
-(** @deprecated Same as [Name.equal]. *)
+val name_eq : Name.t -> Name.t -> bool
+[@@ocaml.deprecated "Same as [Name.equal]."]
 
 (** {5 Module paths} *)
 
 type module_path = ModPath.t =
   | MPfile of DirPath.t
   | MPbound of MBId.t
-  | MPdot of module_path * Label.t
-(** @deprecated Alias type *)
+  | MPdot of ModPath.t * Label.t
+[@@ocaml.deprecated "Alias type"]
 
-val mp_ord : module_path -> module_path -> int
-(** @deprecated Same as [ModPath.compare]. *)
+val mp_ord : ModPath.t -> ModPath.t -> int
+[@@ocaml.deprecated "Same as [ModPath.compare]."]
 
-val mp_eq : module_path -> module_path -> bool
-(** @deprecated Same as [ModPath.equal]. *)
+val mp_eq : ModPath.t -> ModPath.t -> bool
+[@@ocaml.deprecated "Same as [ModPath.equal]."]
 
-val check_bound_mp : module_path -> bool
-(** @deprecated Same as [ModPath.is_bound]. *)
+val check_bound_mp : ModPath.t -> bool
+[@@ocaml.deprecated "Same as [ModPath.is_bound]."]
 
-val string_of_mp : module_path -> string
-(** @deprecated Same as [ModPath.to_string]. *)
+val string_of_mp : ModPath.t -> string
+[@@ocaml.deprecated "Same as [ModPath.to_string]."]
 
-val initial_path : module_path
-(** @deprecated Same as [ModPath.initial]. *)
+val initial_path : ModPath.t
+[@@ocaml.deprecated "Same as [ModPath.initial]."]
 
 (** {5 Kernel names} *)
 
 type kernel_name = KerName.t
-(** @deprecated Alias type *)
+[@@ocaml.deprecated "Alias type"]
 
-val make_kn : ModPath.t -> DirPath.t -> Label.t -> kernel_name
-(** @deprecated Same as [KerName.make]. *)
+val make_kn : ModPath.t -> DirPath.t -> Label.t -> KerName.t
+[@@ocaml.deprecated "Same as [KerName.make]."]
 
-val repr_kn : kernel_name -> module_path * DirPath.t * Label.t
-(** @deprecated Same as [KerName.repr]. *)
+val repr_kn : KerName.t -> ModPath.t * DirPath.t * Label.t
+[@@ocaml.deprecated "Same as [KerName.repr]."]
 
-val modpath : kernel_name -> module_path
-(** @deprecated Same as [KerName.modpath]. *)
+val modpath : KerName.t -> ModPath.t
+[@@ocaml.deprecated "Same as [KerName.modpath]."]
 
-val label : kernel_name -> Label.t
-(** @deprecated Same as [KerName.label]. *)
+val label : KerName.t -> Label.t
+[@@ocaml.deprecated "Same as [KerName.label]."]
 
-val string_of_kn : kernel_name -> string
-(** @deprecated Same as [KerName.to_string]. *)
+val string_of_kn : KerName.t -> string
+[@@ocaml.deprecated "Same as [KerName.to_string]."]
 
-val pr_kn : kernel_name -> Pp.t
-(** @deprecated Same as [KerName.print]. *)
+val pr_kn : KerName.t -> Pp.t
+[@@ocaml.deprecated "Same as [KerName.print]."]
 
-val kn_ord : kernel_name -> kernel_name -> int
-(** @deprecated Same as [KerName.compare]. *)
+val kn_ord : KerName.t -> KerName.t -> int
+[@@ocaml.deprecated "Same as [KerName.compare]."]
 
 (** {5 Constant names} *)
 
 type constant = Constant.t
-(** @deprecated Alias type *)
+[@@ocaml.deprecated "Alias type"]
 
 module Projection : sig
   type t
-    
-  val make : constant -> bool -> t
+
+  val make : Constant.t -> bool -> t
 
   module SyntacticOrd : sig
     val compare : t -> t -> int
@@ -717,7 +717,7 @@ module Projection : sig
     val hash : t -> int
   end
 
-  val constant : t -> constant
+  val constant : t -> Constant.t
   val unfolded : t -> bool
   val unfold : t -> t
 
@@ -727,8 +727,8 @@ module Projection : sig
   (** Hashconsing of projections. *)
 
   val compare : t -> t -> int
-    
-  val map : (constant -> constant) -> t -> t
+
+  val map : (Constant.t -> Constant.t) -> t -> t
 
   val to_string : t -> string
   val print : t -> Pp.t
@@ -737,100 +737,100 @@ end
 
 type projection = Projection.t
 
-val constant_of_kn_equiv : KerName.t -> KerName.t -> constant
-(** @deprecated Same as [Constant.make] *)
+val constant_of_kn_equiv : KerName.t -> KerName.t -> Constant.t
+[@@ocaml.deprecated "Same as [Constant.make]"]
 
-val constant_of_kn : KerName.t -> constant
-(** @deprecated Same as [Constant.make1] *)
+val constant_of_kn : KerName.t -> Constant.t
+[@@ocaml.deprecated "Same as [Constant.make1]"]
 
-val make_con : ModPath.t -> DirPath.t -> Label.t -> constant
-(** @deprecated Same as [Constant.make3] *)
+val make_con : ModPath.t -> DirPath.t -> Label.t -> Constant.t
+[@@ocaml.deprecated "Same as [Constant.make3]"]
 
-val repr_con : constant -> ModPath.t * DirPath.t * Label.t
-(** @deprecated Same as [Constant.repr3] *)
+val repr_con : Constant.t -> ModPath.t * DirPath.t * Label.t
+[@@ocaml.deprecated "Same as [Constant.repr3]"]
 
-val user_con : constant -> KerName.t
-(** @deprecated Same as [Constant.user] *)
+val user_con : Constant.t -> KerName.t
+[@@ocaml.deprecated "Same as [Constant.user]"]
 
-val canonical_con : constant -> KerName.t
-(** @deprecated Same as [Constant.canonical] *)
+val canonical_con : Constant.t -> KerName.t
+[@@ocaml.deprecated "Same as [Constant.canonical]"]
 
-val con_modpath : constant -> ModPath.t
-(** @deprecated Same as [Constant.modpath] *)
+val con_modpath : Constant.t -> ModPath.t
+[@@ocaml.deprecated "Same as [Constant.modpath]"]
 
-val con_label : constant -> Label.t
-(** @deprecated Same as [Constant.label] *)
+val con_label : Constant.t -> Label.t
+[@@ocaml.deprecated "Same as [Constant.label]"]
 
-val eq_constant : constant -> constant -> bool
-(** @deprecated Same as [Constant.equal] *)
+val eq_constant : Constant.t -> Constant.t -> bool
+[@@ocaml.deprecated "Same as [Constant.equal]"]
 
-val con_ord : constant -> constant -> int
-(** @deprecated Same as [Constant.CanOrd.compare] *)
+val con_ord : Constant.t -> Constant.t -> int
+[@@ocaml.deprecated "Same as [Constant.CanOrd.compare]"]
 
-val con_user_ord : constant -> constant -> int
-(** @deprecated Same as [Constant.UserOrd.compare] *)
+val con_user_ord : Constant.t -> Constant.t -> int
+[@@ocaml.deprecated "Same as [Constant.UserOrd.compare]"]
 
-val con_with_label : constant -> Label.t -> constant
-(** @deprecated Same as [Constant.change_label] *)
+val con_with_label : Constant.t -> Label.t -> Constant.t
+[@@ocaml.deprecated "Same as [Constant.change_label]"]
 
-val string_of_con : constant -> string
-(** @deprecated Same as [Constant.to_string] *)
+val string_of_con : Constant.t -> string
+[@@ocaml.deprecated "Same as [Constant.to_string]"]
 
-val pr_con : constant -> Pp.t
-(** @deprecated Same as [Constant.print] *)
+val pr_con : Constant.t -> Pp.t
+[@@ocaml.deprecated "Same as [Constant.print]"]
 
-val debug_pr_con : constant -> Pp.t
-(** @deprecated Same as [Constant.debug_print] *)
+val debug_pr_con : Constant.t -> Pp.t
+[@@ocaml.deprecated "Same as [Constant.debug_print]"]
 
-val debug_string_of_con : constant -> string
-(** @deprecated Same as [Constant.debug_to_string] *)
+val debug_string_of_con : Constant.t -> string
+[@@ocaml.deprecated "Same as [Constant.debug_to_string]"]
 
 (** {5 Mutual Inductive names} *)
 
 type mutual_inductive = MutInd.t
-(** @deprecated Alias type *)
+[@@ocaml.deprecated "Alias type"]
 
-val mind_of_kn : KerName.t -> mutual_inductive
-(** @deprecated Same as [MutInd.make1] *)
+val mind_of_kn : KerName.t -> MutInd.t
+[@@ocaml.deprecated "Same as [MutInd.make1]"]
 
-val mind_of_kn_equiv : KerName.t -> KerName.t -> mutual_inductive
-(** @deprecated Same as [MutInd.make] *)
+val mind_of_kn_equiv : KerName.t -> KerName.t -> MutInd.t
+[@@ocaml.deprecated "Same as [MutInd.make]"]
 
-val make_mind : ModPath.t -> DirPath.t -> Label.t -> mutual_inductive
-(** @deprecated Same as [MutInd.make3] *)
+val make_mind : ModPath.t -> DirPath.t -> Label.t -> MutInd.t
+[@@ocaml.deprecated "Same as [MutInd.make3]"]
 
-val user_mind : mutual_inductive -> KerName.t
-(** @deprecated Same as [MutInd.user] *)
+val user_mind : MutInd.t -> KerName.t
+[@@ocaml.deprecated "Same as [MutInd.user]"]
 
-val canonical_mind : mutual_inductive -> KerName.t
-(** @deprecated Same as [MutInd.canonical] *)
+val canonical_mind : MutInd.t -> KerName.t
+[@@ocaml.deprecated "Same as [MutInd.canonical]"]
 
-val repr_mind : mutual_inductive -> ModPath.t * DirPath.t * Label.t
-(** @deprecated Same as [MutInd.repr3] *)
+val repr_mind : MutInd.t -> ModPath.t * DirPath.t * Label.t
+[@@ocaml.deprecated "Same as [MutInd.repr3]"]
 
-val eq_mind : mutual_inductive -> mutual_inductive -> bool
-(** @deprecated Same as [MutInd.equal] *)
+val eq_mind : MutInd.t -> MutInd.t -> bool
+[@@ocaml.deprecated "Same as [MutInd.equal]"]
 
-val mind_ord : mutual_inductive -> mutual_inductive -> int
-(** @deprecated Same as [MutInd.CanOrd.compare] *)
+val mind_ord : MutInd.t -> MutInd.t -> int
+[@@ocaml.deprecated "Same as [MutInd.CanOrd.compare]"]
 
-val mind_user_ord : mutual_inductive -> mutual_inductive -> int
-(** @deprecated Same as [MutInd.UserOrd.compare] *)
+val mind_user_ord : MutInd.t -> MutInd.t -> int
+[@@ocaml.deprecated "Same as [MutInd.UserOrd.compare]"]
 
-val mind_label : mutual_inductive -> Label.t
-(** @deprecated Same as [MutInd.label] *)
+val mind_label : MutInd.t -> Label.t
+[@@ocaml.deprecated "Same as [MutInd.label]"]
 
-val mind_modpath : mutual_inductive -> ModPath.t
-(** @deprecated Same as [MutInd.modpath] *)
+val mind_modpath : MutInd.t -> ModPath.t
+[@@ocaml.deprecated "Same as [MutInd.modpath]"]
 
-val string_of_mind : mutual_inductive -> string
-(** @deprecated Same as [MutInd.to_string] *)
+val string_of_mind : MutInd.t -> string
+[@@ocaml.deprecated "Same as [MutInd.to_string]"]
 
-val pr_mind : mutual_inductive -> Pp.t
-(** @deprecated Same as [MutInd.print] *)
+val pr_mind : MutInd.t -> Pp.t
+[@@ocaml.deprecated "Same as [MutInd.print]"]
 
-val debug_pr_mind : mutual_inductive -> Pp.t
-(** @deprecated Same as [MutInd.debug_print] *)
+val debug_pr_mind : MutInd.t -> Pp.t
+[@@ocaml.deprecated "Same as [MutInd.debug_print]"]
 
-val debug_string_of_mind : mutual_inductive -> string
-(** @deprecated Same as [MutInd.debug_to_string] *)
+val debug_string_of_mind : MutInd.t -> string
+[@@ocaml.deprecated "Same as [MutInd.debug_to_string]"]
diff --git a/kernel/nativecode.ml b/kernel/nativecode.ml
index e08d913bc..8fa254053 100644
--- a/kernel/nativecode.ml
+++ b/kernel/nativecode.ml
@@ -8,7 +8,7 @@
 
 open CErrors
 open Names
-open Term
+open Constr
 open Declarations
 open Util
 open Nativevalues
@@ -25,7 +25,7 @@ to OCaml code. *)
 (** Local names **)
 
 (* The first component is there for debugging purposes only *)
-type lname = { lname : name; luid : int }
+type lname = { lname : Name.t; luid : int }
 
 let eq_lname ln1 ln2 =
   Int.equal ln1.luid ln2.luid
@@ -50,16 +50,16 @@ let fresh_lname n =
 type gname = 
   | Gind of string * inductive (* prefix, inductive name *)
   | Gconstruct of string * constructor (* prefix, constructor name *)
-  | Gconstant of string * constant (* prefix, constant name *)
-  | Gproj of string * constant (* prefix, constant name *)
-  | Gcase of label option * int
-  | Gpred of label option * int
-  | Gfixtype of label option * int
-  | Gnorm of label option * int
-  | Gnormtbl of label option * int
+  | Gconstant of string * Constant.t (* prefix, constant name *)
+  | Gproj of string * Constant.t (* prefix, constant name *)
+  | Gcase of Label.t option * int
+  | Gpred of Label.t option * int
+  | Gfixtype of Label.t option * int
+  | Gnorm of Label.t option * int
+  | Gnormtbl of Label.t option * int
   | Ginternal of string
   | Grel of int
-  | Gnamed of identifier
+  | Gnamed of Id.t
 
 let eq_gname gn1 gn2 =
   match gn1, gn2 with
@@ -142,13 +142,13 @@ let fresh_gnormtbl l =
 
 type symbol =
   | SymbValue of Nativevalues.t
-  | SymbSort of sorts
-  | SymbName of name
-  | SymbConst of constant
+  | SymbSort of Sorts.t
+  | SymbName of Name.t
+  | SymbConst of Constant.t
   | SymbMatch of annot_sw
   | SymbInd of inductive
   | SymbMeta of metavariable
-  | SymbEvar of existential
+  | SymbEvar of Evar.t
   | SymbLevel of Univ.Level.t
 
 let dummy_symb = SymbValue (dummy_value ())
@@ -162,8 +162,7 @@ let eq_symbol sy1 sy2 =
   | SymbMatch sw1, SymbMatch sw2 -> eq_annot_sw sw1 sw2
   | SymbInd ind1, SymbInd ind2 -> eq_ind ind1 ind2
   | SymbMeta m1, SymbMeta m2 -> Int.equal m1 m2
-  | SymbEvar (evk1,args1), SymbEvar (evk2,args2) ->
-     Evar.equal evk1 evk2 && Array.for_all2 eq_constr args1 args2
+  | SymbEvar evk1, SymbEvar evk2 -> Evar.equal evk1 evk2
   | SymbLevel l1, SymbLevel l2 -> Univ.Level.equal l1 l2
   | _, _ -> false
 
@@ -176,10 +175,7 @@ let hash_symbol symb =
   | SymbMatch sw -> combinesmall 5 (hash_annot_sw sw)
   | SymbInd ind -> combinesmall 6 (ind_hash ind)
   | SymbMeta m -> combinesmall 7 m
-  | SymbEvar (evk,args) ->
-     let evh = Evar.hash evk in
-     let hl = Array.fold_left (fun h t -> combine h (Constr.hash t)) evh args in
-     combinesmall 8 hl
+  | SymbEvar evk -> combinesmall 8 (Evar.hash evk)
   | SymbLevel l -> combinesmall 9 (Univ.Level.hash l)
 
 module HashedTypeSymbol = struct
@@ -266,7 +262,7 @@ type primitive =
   | Mk_fix of rec_pos * int 
   | Mk_cofix of int
   | Mk_rel of int
-  | Mk_var of identifier
+  | Mk_var of Id.t
   | Mk_proj
   | Is_accu
   | Is_int
@@ -296,7 +292,7 @@ type primitive =
   | MLmagic
   | MLarrayget
   | Mk_empty_instance
-  | Coq_primitive of CPrimitives.t * (prefix * constant) option
+  | Coq_primitive of CPrimitives.t * (prefix * Constant.t) option
 
 let eq_primitive p1 p2 =
   match p1, p2 with
@@ -625,7 +621,7 @@ let decompose_MLlam c =
 
 (*s Global declaration *)
 type global =
-(*  | Gtblname of gname * identifier array *)
+(*  | Gtblname of gname * Id.t array *)
   | Gtblnorm of gname * lname array * mllambda array 
   | Gtblfixtype of gname * lname array * mllambda array
   | Glet of gname * mllambda
@@ -732,7 +728,7 @@ type env =
       env_bound : int; (* length of env_rel *)
       (* free variables *)
       env_urel : (int * mllambda) list ref; (* list of unbound rel *)
-      env_named : (identifier * mllambda) list ref;
+      env_named : (Id.t * mllambda) list ref;
       env_univ : lname option}
 
 let empty_env univ () =
@@ -921,7 +917,7 @@ let merge_branches t =
 
 
 type prim_aux = 
-  | PAprim of string * constant * CPrimitives.t * prim_aux array
+  | PAprim of string * Constant.t * CPrimitives.t * prim_aux array
   | PAml of mllambda
 
 let add_check cond args =
@@ -1047,11 +1043,12 @@ let ml_of_instance instance u =
      let tyn = fresh_lname Anonymous in
      let i = push_symbol (SymbMeta mv) in
      MLapp(MLprimitive Mk_meta, [|get_meta_code i; MLlocal tyn|])
-  | Levar(ev,ty) ->
+  | Levar(evk,ty,args) ->
      let tyn = fresh_lname Anonymous in
-     let i = push_symbol (SymbEvar ev) in
+     let i = push_symbol (SymbEvar evk) in
+     let args = MLarray(Array.map (ml_of_lam env l) args) in
      MLlet(tyn, ml_of_lam env l ty,
-       MLapp(MLprimitive Mk_evar, [|get_evar_code i;MLlocal tyn|]))
+       MLapp(MLprimitive Mk_evar, [|get_evar_code i;MLlocal tyn; args|]))
   | Lprod(dom,codom) ->
       let dom = ml_of_lam env l dom in
       let codom = ml_of_lam env l codom in
@@ -1504,7 +1501,7 @@ let string_of_dirpath = function
 (* OCaml as a module identifier.                                           *)
 let string_of_dirpath s = "N"^string_of_dirpath s
 
-let mod_uid_of_dirpath dir = string_of_dirpath (repr_dirpath dir)
+let mod_uid_of_dirpath dir = string_of_dirpath (DirPath.repr dir)
 
 let link_info_of_dirpath dir =
   Linked (mod_uid_of_dirpath dir ^ ".")
@@ -1523,19 +1520,19 @@ let string_of_label_def l =
 let rec list_of_mp acc = function
   | MPdot (mp,l) -> list_of_mp (string_of_label l::acc) mp
   | MPfile dp ->
-      let dp = repr_dirpath dp in
+      let dp = DirPath.repr dp in
       string_of_dirpath dp :: acc
-  | MPbound mbid -> ("X"^string_of_id (id_of_mbid mbid))::acc
+  | MPbound mbid -> ("X"^string_of_id (MBId.to_id mbid))::acc
 
 let list_of_mp mp = list_of_mp [] mp
 
 let string_of_kn kn =
-  let (mp,dp,l) = repr_kn kn in
+  let (mp,dp,l) = KerName.repr kn in
   let mp = list_of_mp mp in
   String.concat "_" mp ^ "_" ^ string_of_label l
 
-let string_of_con c = string_of_kn (user_con c)
-let string_of_mind mind = string_of_kn (user_mind mind)
+let string_of_con c = string_of_kn (Constant.user c)
+let string_of_mind mind = string_of_kn (MutInd.user mind)
 
 let string_of_gname g =
   match g with
@@ -1830,7 +1827,7 @@ and apply_fv env sigma univ (fv_named,fv_rel) auxdefs ml =
   in
   let auxdefs = List.fold_right get_rel_val fv_rel auxdefs in
   let auxdefs = List.fold_right get_named_val fv_named auxdefs in
-  let lvl = Context.Rel.length env.env_rel_context in
+  let lvl = Context.Rel.length env.env_rel_context.env_rel_ctx in
   let fv_rel = List.map (fun (n,_) -> MLglobal (Grel (lvl-n))) fv_rel in
   let fv_named = List.map (fun (id,_) -> MLglobal (Gnamed id)) fv_named in
   let aux_name = fresh_lname Anonymous in
@@ -1838,8 +1835,8 @@ and apply_fv env sigma univ (fv_named,fv_rel) auxdefs ml =
 
 and compile_rel env sigma univ auxdefs n =
   let open Context.Rel.Declaration in
-  let decl = Context.Rel.lookup n env.env_rel_context in
-  let n = Context.Rel.length env.env_rel_context - n in
+  let decl = Pre_env.lookup_rel n env in
+  let n = List.length env.env_rel_context.env_rel_ctx - n in
   match decl with
   | LocalDef (_,t,_) ->
       let code = lambda_of_constr env sigma t in
@@ -1877,7 +1874,7 @@ let compile_constant env sigma prefix ~interactive con cb =
         if interactive then LinkedInteractive prefix
         else Linked prefix
       in
-      let l = con_label con in
+      let l = Constant.label con in
       let auxdefs,code =
 	if no_univs then compile_with_fv env sigma None [] (Some l) code
 	else
@@ -1919,15 +1916,17 @@ let compile_constant env sigma prefix ~interactive con cb =
       let asw = { asw_ind = ind; asw_prefix = prefix; asw_ci = ci;
 		  asw_reloc = tbl; asw_finite = true } in
       let c_uid = fresh_lname Anonymous in
+      let cf_uid = fresh_lname Anonymous in
       let _, arity = tbl.(0) in
       let ci_uid = fresh_lname Anonymous in
       let cargs = Array.init arity
         (fun i -> if Int.equal i pb.proj_arg then Some ci_uid else None)
       in
       let i = push_symbol (SymbConst con) in
-      let accu = MLapp (MLprimitive Cast_accu, [|MLlocal c_uid|]) in
+      let accu = MLapp (MLprimitive Cast_accu, [|MLlocal cf_uid|]) in
       let accu_br = MLapp (MLprimitive Mk_proj, [|get_const_code i;accu|]) in
-      let code = MLmatch(asw,MLlocal c_uid,accu_br,[|[((ind,1),cargs)],MLlocal ci_uid|]) in
+      let code = MLmatch(asw,MLlocal cf_uid,accu_br,[|[((ind,1),cargs)],MLlocal ci_uid|]) in
+      let code = MLlet(cf_uid, MLapp (MLprimitive Force_cofix, [|MLlocal c_uid|]), code) in
       let gn = Gproj ("",con) in
       let fargs = Array.init (pb.proj_npars + 1) (fun _ -> fresh_lname Anonymous) in
       let arg = fargs.(pb.proj_npars) in
@@ -1955,8 +1954,8 @@ let is_code_loaded ~interactive name =
       if is_loaded_native_file s then true
       else (name := NotLinked; false)
 
-let param_name = Name (id_of_string "params")
-let arg_name = Name (id_of_string "arg")
+let param_name = Name (Id.of_string "params")
+let arg_name = Name (Id.of_string "arg")
 
 let compile_mind prefix ~interactive mb mind stack =
   let u = Declareops.inductive_polymorphic_context mb in
@@ -2016,7 +2015,7 @@ let compile_mind_deps env prefix ~interactive
 (* This function compiles all necessary dependencies of t, and generates code in
    reverse order, as well as linking information updates *)
 let rec compile_deps env sigma prefix ~interactive init t =
-  match kind_of_term t with
+  match kind t with
   | Ind ((mind,_),u) -> compile_mind_deps env prefix ~interactive init mind
   | Const c ->
       let c,u = get_alias env c in
@@ -2048,8 +2047,8 @@ let rec compile_deps env sigma prefix ~interactive init t =
   | Case (ci, p, c, ac) ->
       let mind = fst ci.ci_ind in
       let init = compile_mind_deps env prefix ~interactive init mind in
-      fold_constr (compile_deps env sigma prefix ~interactive) init t
-  | _ -> fold_constr (compile_deps env sigma prefix ~interactive) init t
+      Constr.fold (compile_deps env sigma prefix ~interactive) init t
+  | _ -> Constr.fold (compile_deps env sigma prefix ~interactive) init t
 
 let compile_constant_field env prefix con acc cb =
     let (gl, _) =
diff --git a/kernel/nativecode.mli b/kernel/nativecode.mli
index ae6fb1bd6..7d20054f7 100644
--- a/kernel/nativecode.mli
+++ b/kernel/nativecode.mli
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-open Term
 open Names
+open Constr
 open Declarations
 open Pre_env
 open Nativelambda
@@ -32,11 +32,11 @@ val clear_symbols : unit -> unit
 
 val get_value : symbols -> int -> Nativevalues.t
 
-val get_sort : symbols -> int -> sorts
+val get_sort : symbols -> int -> Sorts.t
 
-val get_name : symbols -> int -> name
+val get_name : symbols -> int -> Name.t
 
-val get_const : symbols -> int -> constant
+val get_const : symbols -> int -> Constant.t
 
 val get_match : symbols -> int -> Nativevalues.annot_sw
 
@@ -44,7 +44,7 @@ val get_ind : symbols -> int -> inductive
 
 val get_meta : symbols -> int -> metavariable
 
-val get_evar : symbols -> int -> existential
+val get_evar : symbols -> int -> Evar.t
 
 val get_level : symbols -> int -> Univ.Level.t
 
@@ -60,20 +60,20 @@ val empty_updates : code_location_updates
 
 val register_native_file : string -> unit
 
-val compile_constant_field : env -> string -> constant ->
+val compile_constant_field : env -> string -> Constant.t ->
   global list -> constant_body -> global list
 
-val compile_mind_field : string -> module_path -> label ->
+val compile_mind_field : string -> ModPath.t -> Label.t ->
   global list -> mutual_inductive_body -> global list
 
 val mk_conv_code : env -> evars -> string -> constr -> constr -> linkable_code
 val mk_norm_code : env -> evars -> string -> constr -> linkable_code
 
-val mk_library_header : dir_path -> global list
+val mk_library_header : DirPath.t -> global list
 
-val mod_uid_of_dirpath : dir_path -> string
+val mod_uid_of_dirpath : DirPath.t -> string
 
-val link_info_of_dirpath : dir_path -> link_info
+val link_info_of_dirpath : DirPath.t -> link_info
 
 val update_locations : code_location_updates -> unit
 
diff --git a/kernel/nativeconv.ml b/kernel/nativeconv.ml
index a62a079da..bfa982136 100644
--- a/kernel/nativeconv.ml
+++ b/kernel/nativeconv.ml
@@ -54,13 +54,18 @@ and conv_accu env pb lvl k1 k2 cu =
     conv_atom env pb lvl (atom_of_accu k1) (atom_of_accu k2) cu
   else
     let cu = conv_atom env pb lvl (atom_of_accu k1) (atom_of_accu k2) cu in
-    List.fold_right2 (conv_val env CONV lvl) (args_of_accu k1) (args_of_accu k2) cu
+    Array.fold_right2 (conv_val env CONV lvl) (args_of_accu k1) (args_of_accu k2) cu
 
 and conv_atom env pb lvl a1 a2 cu =
   if a1 == a2 then cu
   else
     match a1, a2 with
-    | Ameta _, _ | _, Ameta _ | Aevar _, _ | _, Aevar _ -> assert false
+    | Ameta (m1,_), Ameta (m2,_) ->
+      if Int.equal m1 m2 then cu else raise NotConvertible
+    | Aevar (ev1,_,args1), Aevar (ev2,_,args2) ->
+      if Evar.equal ev1 ev2 then
+        Array.fold_right2 (conv_val env CONV lvl) args1 args2 cu
+      else raise NotConvertible
     | Arel i1, Arel i2 -> 
 	if Int.equal i1 i2 then cu else raise NotConvertible
     | Aind (ind1,u1), Aind (ind2,u2) ->
@@ -112,7 +117,7 @@ and conv_atom env pb lvl a1 a2 cu =
        else conv_accu env CONV lvl ac1 ac2 cu
     | Arel _, _ | Aind _, _ | Aconstant _, _ | Asort _, _ | Avar _, _
     | Acase _, _ | Afix _, _ | Acofix _, _ | Acofixe _, _ | Aprod _, _
-    | Aproj _, _ -> raise NotConvertible
+    | Aproj _, _ | Ameta _, _ | Aevar _, _ -> raise NotConvertible
 
 (* Precondition length t1 = length f1 = length f2 = length t2 *)
 and conv_fix env lvl t1 f1 t2 f2 cu =
@@ -154,7 +159,7 @@ let warn_no_native_compiler =
 
 (* Wrapper for [native_conv] above *)
 let native_conv cv_pb sigma env t1 t2 =
-  if Coq_config.no_native_compiler then begin
+  if not Coq_config.native_compiler then begin
     warn_no_native_compiler ();
     vm_conv cv_pb env t1 t2
   end
diff --git a/kernel/nativeconv.mli b/kernel/nativeconv.mli
index fbbcce744..769deacae 100644
--- a/kernel/nativeconv.mli
+++ b/kernel/nativeconv.mli
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-open Term
+open Constr
 open Reduction
 open Nativelambda
 
diff --git a/kernel/nativeinstr.mli b/kernel/nativeinstr.mli
index 2353470f0..48ad88444 100644
--- a/kernel/nativeinstr.mli
+++ b/kernel/nativeinstr.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 open Names
-open Term
+open Constr
 open Nativevalues
 
 (** This file defines the lambda code for the native compiler. It has been
@@ -20,17 +20,17 @@ type uint =
   | UintDecomp of prefix * constructor * lambda
 
 and lambda =
-  | Lrel          of name * int 
-  | Lvar          of identifier
+  | Lrel          of Name.t * int 
+  | Lvar          of Id.t
   | Lmeta         of metavariable * lambda (* type *)
-  | Levar         of existential * lambda (* type *)
+  | Levar         of Evar.t * lambda (* type *) * lambda array (* arguments *)
   | Lprod         of lambda * lambda 
-  | Llam          of name array * lambda  
-  | Llet          of name * lambda * lambda
+  | Llam          of Name.t array * lambda  
+  | Llet          of Name.t * lambda * lambda
   | Lapp          of lambda * lambda array
   | Lconst        of prefix * pconstant
-  | Lproj         of prefix * constant (* prefix, projection name *)
-  | Lprim         of prefix * constant * CPrimitives.t * lambda array
+  | Lproj         of prefix * Constant.t (* prefix, projection name *)
+  | Lprim         of prefix * Constant.t * CPrimitives.t * lambda array
   | Lcase         of annot_sw * lambda * lambda * lam_branches 
                   (* annotations, term being matched, accu, branches *)
   | Lif           of lambda * lambda * lambda
@@ -43,11 +43,11 @@ and lambda =
 	(* A partially applied constructor *)
   | Luint         of uint
   | Lval          of Nativevalues.t
-  | Lsort         of sorts
+  | Lsort         of Sorts.t
   | Lind          of prefix * pinductive
   | Llazy
   | Lforce
 
-and lam_branches = (constructor * name array * lambda) array 
+and lam_branches = (constructor * Name.t array * lambda) array 
 
-and fix_decl =  name array * lambda array * lambda array
+and fix_decl =  Name.t array * lambda array * lambda array
diff --git a/kernel/nativelambda.ml b/kernel/nativelambda.ml
index 508112b35..dfe9d025e 100644
--- a/kernel/nativelambda.ml
+++ b/kernel/nativelambda.ml
@@ -8,7 +8,7 @@
 open Util
 open Names
 open Esubst
-open Term
+open Constr
 open Declarations
 open Pre_env
 open Nativevalues
@@ -83,9 +83,9 @@ let get_const_prefix env c =
 
 (* A generic map function *)
 
-let map_lam_with_binders g f n lam =
+let rec map_lam_with_binders g f n lam =
   match lam with
-  | Lrel _ | Lvar _  | Lconst _ | Lproj _ | Luint _ | Lval _ | Lsort _ | Lind _
+  | Lrel _ | Lvar _  | Lconst _ | Lproj _ | Lval _ | Lsort _ | Lind _
   | Lconstruct _ | Llazy | Lforce | Lmeta _ | Levar _ -> lam
   | Lprod(dom,codom) -> 
       let dom' = f n dom in
@@ -134,6 +134,19 @@ let map_lam_with_binders g f n lam =
   | Lmakeblock(prefix,cn,tag,args) ->
       let args' = Array.smartmap (f n) args in
       if args == args' then lam else Lmakeblock(prefix,cn,tag,args')
+  | Luint u ->
+    let u' = map_uint g f n u in
+    if u == u' then lam else Luint u'
+
+and map_uint g f n u =
+  match u with
+  | UintVal _ -> u
+  | UintDigits(prefix,c,args) ->
+    let args' = Array.smartmap (f n) args in
+    if args == args' then u else UintDigits(prefix,c,args')
+  | UintDecomp(prefix,c,a) ->
+    let a' = f n a in
+    if a == a' then u else UintDecomp(prefix,c,a')
 
 (*s Lift and substitution *)
  
@@ -378,7 +391,7 @@ module Renv =
     type constructor_info = tag * int * int (* nparam nrealargs *)
 
     type t = {
-	name_rel : name Vect.t;
+	name_rel : Name.t Vect.t;
 	construct_tbl : constructor_info ConstrTable.t;
 
        }
@@ -417,9 +430,9 @@ module Renv =
 
 (* What about pattern matching ?*)
 let is_lazy prefix t =
-  match kind_of_term t with
+  match kind t with
   | App (f,args) ->
-     begin match kind_of_term f with
+     begin match kind f with
      | Construct (c,_) ->
 	let entry = mkInd (fst c) in
 	(try
@@ -448,16 +461,17 @@ let empty_evars =
 let empty_ids = [||]
 
 let rec lambda_of_constr env sigma c =
-  match kind_of_term c with
+  match kind c with
   | Meta mv ->
      let ty = meta_type sigma mv in
      Lmeta (mv, lambda_of_constr env sigma ty)
 
-  | Evar ev ->
+  | Evar (evk,args as ev) ->
      (match evar_value sigma ev with
      | None ->
 	let ty = evar_type sigma ev in
-	Levar(ev, lambda_of_constr env sigma ty)
+        let args = Array.map (lambda_of_constr env sigma) args in
+        Levar(evk, lambda_of_constr env sigma ty, args)
      | Some t -> lambda_of_constr env sigma t)
 
   | Cast (c, _, _) -> lambda_of_constr env sigma c
@@ -480,7 +494,7 @@ let rec lambda_of_constr env sigma c =
       Lprod(ld,  Llam([|id|], lc))
 
   | Lambda _ ->
-      let params, body = decompose_lam c in
+      let params, body = Term.decompose_lam c in
       let ids = get_names (List.rev params) in
       Renv.push_rels env ids;
       let lb = lambda_of_constr env sigma body in
@@ -515,7 +529,7 @@ let rec lambda_of_constr env sigma c =
 	    { asw_ind = ind;
           asw_ci = ci;
           asw_reloc = tbl; 
-          asw_finite = mib.mind_finite <> Decl_kinds.CoFinite;
+          asw_finite = mib.mind_finite <> CoFinite;
           asw_prefix = prefix}
       in
       (* translation of the argument *)
@@ -561,7 +575,7 @@ let rec lambda_of_constr env sigma c =
       Lcofix(init, (names, ltypes, lbodies))
 
 and lambda_of_app env sigma f args =
-  match kind_of_term f with
+  match kind f with
   | Const (kn,u as c) ->
       let kn,u = get_alias !global_env c in
       let cb = lookup_constant kn !global_env in
@@ -639,7 +653,7 @@ let optimize lam =
 let lambda_of_constr env sigma c =
   set_global_env env;
   let env = Renv.make () in
-  let ids = List.rev_map RelDecl.get_name !global_env.env_rel_context in
+  let ids = List.rev_map RelDecl.get_name !global_env.env_rel_context.env_rel_ctx 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
@@ -656,7 +670,7 @@ let compile_static_int31 fc args =
   if not fc then raise Not_found else
     Luint (UintVal
     (Uint31.of_int (Array.fold_left
-       (fun temp_i -> fun t -> match kind_of_term t with
+       (fun temp_i -> fun t -> match kind t with
           | Construct ((_,d),_) -> 2*temp_i+d-1
           | _ -> raise NotClosed)
        0 args)))
diff --git a/kernel/nativelambda.mli b/kernel/nativelambda.mli
index 156e4f834..933fbc660 100644
--- a/kernel/nativelambda.mli
+++ b/kernel/nativelambda.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 open Names
-open Term
+open Constr
 open Pre_env
 open Nativeinstr
 
@@ -18,13 +18,13 @@ type evars =
 
 val empty_evars : evars
 
-val decompose_Llam : lambda -> Names.name array * lambda
-val decompose_Llam_Llet : lambda -> (Names.name * lambda option) array * lambda
+val decompose_Llam : lambda -> Name.t array * lambda
+val decompose_Llam_Llet : lambda -> (Name.t * lambda option) array * lambda
 
 val is_lazy : prefix -> constr -> bool
 val mk_lazy : lambda -> lambda
 
-val get_mind_prefix : env -> mutual_inductive -> string
+val get_mind_prefix : env -> MutInd.t -> string
 
 val get_alias : env -> pconstant -> pconstant
 
@@ -38,5 +38,5 @@ val compile_dynamic_int31 : bool -> prefix -> constructor -> lambda array ->
 val before_match_int31 : inductive -> bool -> prefix -> constructor -> lambda ->
 			 lambda
 
-val compile_prim : CPrimitives.t -> constant -> bool -> prefix -> lambda array ->
+val compile_prim : CPrimitives.t -> Constant.t -> bool -> prefix -> lambda array ->
 		   lambda
diff --git a/kernel/nativelib.ml b/kernel/nativelib.ml
index 665ddf7a6..1e35f6c03 100644
--- a/kernel/nativelib.ml
+++ b/kernel/nativelib.ml
@@ -74,7 +74,7 @@ let call_compiler ?profile:(profile=false) ml_filename =
   let remove f = if Sys.file_exists f then Sys.remove f in
   remove link_filename;
   remove (f ^ ".cmi");
-  let initial_args = 
+  let initial_args =
     if Dynlink.is_native then
       ["opt"; "-shared"]
      else
@@ -86,9 +86,20 @@ let call_compiler ?profile:(profile=false) ml_filename =
     else
       []
   in
+  let flambda_args =
+    if Coq_config.caml_version_nums >= [4;3;0] && Dynlink.is_native then
+      (* We play safe for now, and use the native compiler
+         with -Oclassic, however it is likely that `native_compute`
+         users can benefit from tweaking here.
+      *)
+      ["-Oclassic"]
+    else
+      []
+  in
   let args =
     initial_args @
-      profile_args @ 
+      profile_args @
+        flambda_args @
       ("-o"::link_filename
        ::"-rectypes"
        ::"-w"::"a"
@@ -146,9 +157,8 @@ let call_linker ?(fatal=true) prefix f upds =
     register_native_file prefix
    with Dynlink.Error e as exn ->
      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));
+     if fatal then iraise exn
+     else if !Flags.debug then Feedback.msg_debug CErrors.(iprint exn));
   match upds with Some upds -> update_locations upds | _ -> ()
 
 let link_library ~prefix ~dirname ~basename =
diff --git a/kernel/nativelib.mli b/kernel/nativelib.mli
index a262a9f58..b74d4fdd0 100644
--- a/kernel/nativelib.mli
+++ b/kernel/nativelib.mli
@@ -21,7 +21,7 @@ val get_ml_filename : unit -> string * string
 
 val compile : string -> global list -> profile:bool -> bool * string
 
-val compile_library : Names.dir_path -> global list -> string -> bool
+val compile_library : Names.DirPath.t -> global list -> string -> bool
 
 val call_linker :
   ?fatal:bool -> string -> string -> code_location_updates option -> unit
diff --git a/kernel/nativelibrary.ml b/kernel/nativelibrary.ml
index 3e273dde2..c68f78121 100644
--- a/kernel/nativelibrary.ml
+++ b/kernel/nativelibrary.ml
@@ -26,7 +26,7 @@ let rec translate_mod prefix mp env mod_expr acc =
 and translate_field prefix mp env acc (l,x) =
   match x with
   | SFBconst cb ->
-     let con = make_con mp empty_dirpath l in
+     let con = Constant.make3 mp DirPath.empty l in
      (if !Flags.debug then
 	let msg = Printf.sprintf "Compiling constant %s..." (Constant.to_string con) in
 	Feedback.msg_debug (Pp.str msg));
diff --git a/kernel/nativelibrary.mli b/kernel/nativelibrary.mli
index f327ba224..72e3d8041 100644
--- a/kernel/nativelibrary.mli
+++ b/kernel/nativelibrary.mli
@@ -13,5 +13,5 @@ open Nativecode
 (** This file implements separate compilation for libraries in the native
 compiler *)
 
-val dump_library : module_path -> dir_path -> env -> module_signature ->
+val dump_library : ModPath.t -> DirPath.t -> env -> module_signature ->
   global list * symbols
diff --git a/kernel/nativevalues.ml b/kernel/nativevalues.ml
index 7463a30fe..3d47b1672 100644
--- a/kernel/nativevalues.ml
+++ b/kernel/nativevalues.ml
@@ -5,10 +5,11 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-open Term
-open Names
-open CErrors
+
 open Util
+open CErrors
+open Names
+open Constr
 
 (** This module defines the representation of values internally used by
 the native compiler *)
@@ -51,17 +52,17 @@ type atom =
   | Arel of int
   | Aconstant of pconstant
   | Aind of pinductive
-  | Asort of sorts
-  | Avar of identifier
+  | Asort of Sorts.t
+  | Avar of Id.t
   | Acase of annot_sw * accumulator * t * (t -> t)
   | Afix of t array * t array * rec_pos * int
             (* types, bodies, rec_pos, pos *)
   | Acofix of t array * t array * int * t
   | Acofixe of t array * t array * int * t
-  | Aprod of name * t * (t -> t)
+  | Aprod of Name.t * t * (t -> t)
   | Ameta of metavariable * t
-  | Aevar of existential * t
-  | Aproj of constant * accumulator
+  | Aevar of Evar.t * t * t array
+  | Aproj of Constant.t * accumulator
 
 let accumulate_tag = 0
 
@@ -111,6 +112,7 @@ let mk_ind_accu ind u =
   mk_accu (Aind (ind,Univ.Instance.of_array u))
 
 let mk_sort_accu s u =
+  let open Sorts in
   match s with
   | Prop _ -> mk_accu (Asort s)
   | Type s ->
@@ -130,8 +132,8 @@ let mk_prod_accu s dom codom =
 let mk_meta_accu mv ty =
   mk_accu (Ameta (mv,ty))
 
-let mk_evar_accu ev ty =
-  mk_accu (Aevar (ev,ty))
+let mk_evar_accu ev ty args =
+  mk_accu (Aevar (ev,ty,args))
 
 let mk_proj_accu kn c = 
   mk_accu (Aproj (kn,c))
@@ -151,8 +153,7 @@ let accu_nargs (k:accumulator) =
 let args_of_accu (k:accumulator) =
   let nargs = accu_nargs k in
   let f i = (Obj.magic (Obj.field (Obj.magic k) (nargs-i+2)) : t) in
-  let t = Array.init nargs f in
-  Array.to_list t
+  Array.init nargs f
 
 let is_accu x =
   let o = Obj.repr x in
@@ -177,11 +178,10 @@ let force_cofix (cofix : t) =
     let atom = atom_of_accu accu in
     match atom with
     | Acofix(typ,norm,pos,f) ->
-	let f = ref f in
-    let args = List.rev (args_of_accu accu) in
-    List.iter (fun x -> f := !f x) args;
-	let v = !f (Obj.magic ()) in
-	set_atom_of_accu accu (Acofixe(typ,norm,pos,v));
+      let args = args_of_accu accu in
+      let f = Array.fold_right (fun arg f -> f arg) args f in
+      let v = f (Obj.magic ()) in
+      set_atom_of_accu accu (Acofixe(typ,norm,pos,v));
 	v
     | Acofixe(_,_,_,v) -> v 
     | _ -> cofix
diff --git a/kernel/nativevalues.mli b/kernel/nativevalues.mli
index 49b1e122d..993842740 100644
--- a/kernel/nativevalues.mli
+++ b/kernel/nativevalues.mli
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-open Term
+open Constr
 open Names
 
 (** This modules defines the representation of values internally used by
@@ -43,33 +43,33 @@ type atom =
   | Arel of int
   | Aconstant of pconstant
   | Aind of pinductive
-  | Asort of sorts
-  | Avar of identifier
+  | Asort of Sorts.t
+  | Avar of Id.t
   | Acase of annot_sw * accumulator * t * (t -> t) 
   | Afix of t array * t array * rec_pos * int 
   | Acofix of t array * t array * int * t
   | Acofixe of t array * t array * int * t
-  | Aprod of name * t * (t -> t)
+  | Aprod of Name.t * t * (t -> t)
   | Ameta of metavariable * t
-  | Aevar of existential * t
-  | Aproj of constant * accumulator
+  | Aevar of Evar.t * t (* type *) * t array (* arguments *)
+  | Aproj of Constant.t * accumulator
 
 (* Constructors *)
 
 val mk_accu : atom -> t
 val mk_rel_accu : int -> t
 val mk_rels_accu : int -> int -> t array
-val mk_constant_accu : constant -> Univ.Level.t array -> t
+val mk_constant_accu : Constant.t -> Univ.Level.t array -> t
 val mk_ind_accu : inductive -> Univ.Level.t array -> t
-val mk_sort_accu : sorts -> Univ.Level.t array -> t
-val mk_var_accu : identifier -> t
+val mk_sort_accu : Sorts.t -> Univ.Level.t array -> t
+val mk_var_accu : Id.t -> t
 val mk_sw_accu : annot_sw -> accumulator -> t -> (t -> t)
-val mk_prod_accu : name -> t -> t -> t
+val mk_prod_accu : Name.t -> t -> t -> t
 val mk_fix_accu : rec_pos  -> int -> t array -> t array -> t
 val mk_cofix_accu : int -> t array -> t array -> t
 val mk_meta_accu : metavariable -> t
-val mk_evar_accu : existential -> t -> t
-val mk_proj_accu : constant -> accumulator -> t
+val mk_evar_accu : Evar.t -> t -> t array -> t
+val mk_proj_accu : Constant.t -> accumulator -> t
 val upd_cofix : t -> t -> unit
 val force_cofix : t -> t 
 val mk_const : tag -> t
@@ -84,7 +84,7 @@ val napply : t -> t array -> t
 
 val dummy_value : unit -> t
 val atom_of_accu : accumulator -> atom
-val args_of_accu : accumulator -> t list
+val args_of_accu : accumulator -> t array
 val accu_nargs : accumulator -> int
 
 val cast_accu : t -> accumulator
diff --git a/kernel/opaqueproof.ml b/kernel/opaqueproof.ml
index 5e20c1b51..c2fcfbfd6 100644
--- a/kernel/opaqueproof.ml
+++ b/kernel/opaqueproof.ml
@@ -8,7 +8,7 @@
 
 open Names
 open Univ
-open Term
+open Constr
 open Mod_subst
 
 type work_list = (Instance.t * Id.t array) Cmap.t * 
@@ -16,8 +16,8 @@ type work_list = (Instance.t * Id.t array) Cmap.t *
 
 type cooking_info = { 
   modlist : work_list; 
-  abstract : Context.Named.t * Univ.universe_level_subst * Univ.AUContext.t } 
-type proofterm = (constr * Univ.universe_context_set) Future.computation
+  abstract : Context.Named.t * Univ.Instance.t * Univ.AUContext.t }
+type proofterm = (constr * Univ.ContextSet.t) Future.computation
 type opaque =
   | Indirect of substitution list * DirPath.t * int (* subst, lib, index *)
   | Direct of cooking_info list * proofterm
@@ -78,12 +78,12 @@ let subst_opaque sub = function
 let iter_direct_opaque f = function
   | 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))
+      Direct (d,Future.chain cu (fun (c, u) -> f c; c, u))
 
 let discharge_direct_opaque ~cook_constr ci = function
   | 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))
+      Direct (ci::d,Future.chain cu (fun (c, u) -> cook_constr c, u))
 
 let join_opaque { opaque_val = prfs; opaque_dir = odp } = function
   | Direct (_,cu) -> ignore(Future.join cu)
@@ -105,7 +105,7 @@ let force_proof { opaque_val = prfs; opaque_dir = odp } = function
   | Indirect (l,dp,i) ->
       let pt =
         if DirPath.equal dp odp
-        then Future.chain ~pure:true (snd (Int.Map.find i prfs)) fst
+        then Future.chain (snd (Int.Map.find i prfs)) fst
         else !get_opaque dp i in
       let c = Future.force pt in
       force_constr (List.fold_right subst_substituted l (from_val c))
@@ -120,25 +120,25 @@ let force_constraints { opaque_val = prfs; opaque_dir = odp } = function
         | Some u -> Future.force u
 
 let get_constraints { opaque_val = prfs; opaque_dir = odp } = function
-  | Direct (_,cu) -> Some(Future.chain ~pure:true cu snd)
+  | Direct (_,cu) -> Some(Future.chain cu snd)
   | Indirect (_,dp,i) ->
       if DirPath.equal dp odp
-      then Some(Future.chain ~pure:true (snd (Int.Map.find i prfs)) snd)
+      then Some(Future.chain (snd (Int.Map.find i prfs)) snd)
       else !get_univ dp i
 
 let get_proof { opaque_val = prfs; opaque_dir = odp } = function
-  | Direct (_,cu) -> Future.chain ~pure:true cu fst
+  | Direct (_,cu) -> Future.chain cu fst
   | Indirect (l,dp,i) ->
       let pt =
         if DirPath.equal dp odp
-        then Future.chain ~pure:true (snd (Int.Map.find i prfs)) fst
+        then Future.chain (snd (Int.Map.find i prfs)) fst
         else !get_opaque dp i in
-      Future.chain ~pure:true pt (fun c ->
+      Future.chain pt (fun c ->
         force_constr (List.fold_right subst_substituted l (from_val c)))
  
 module FMap = Future.UUIDMap
 
-let a_constr = Future.from_val (Term.mkRel 1)
+let a_constr = Future.from_val (mkRel 1)
 let a_univ = Future.from_val Univ.ContextSet.empty
 let a_discharge : cooking_info list = []
 
diff --git a/kernel/opaqueproof.mli b/kernel/opaqueproof.mli
index a0418a022..c8339e6eb 100644
--- a/kernel/opaqueproof.mli
+++ b/kernel/opaqueproof.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Mod_subst
 
 (** This module implements the handling of opaque proof terms.
@@ -19,7 +19,7 @@ open Mod_subst
     When it is [turn_indirect] the data is relocated to an opaque table
     and the [opaque] is turned into an index. *)
 
-type proofterm = (constr * Univ.universe_context_set) Future.computation
+type proofterm = (constr * Univ.ContextSet.t) Future.computation
 type opaquetab
 type opaque
 
@@ -36,10 +36,10 @@ val turn_indirect : DirPath.t -> opaque -> opaquetab -> opaque * opaquetab
 (** From a [opaque] back to a [constr]. This might use the
     indirect opaque accessor configured below. *)
 val force_proof : opaquetab -> opaque -> constr
-val force_constraints : opaquetab -> opaque -> Univ.universe_context_set
-val get_proof : opaquetab -> opaque -> Term.constr Future.computation
+val force_constraints : opaquetab -> opaque -> Univ.ContextSet.t
+val get_proof : opaquetab -> opaque -> constr Future.computation
 val get_constraints :
-  opaquetab -> opaque -> Univ.universe_context_set Future.computation option
+  opaquetab -> opaque -> Univ.ContextSet.t Future.computation option
 
 val subst_opaque : substitution -> opaque -> opaque
 val iter_direct_opaque : (constr -> unit) -> opaque -> opaque
@@ -49,7 +49,7 @@ type work_list = (Univ.Instance.t * Id.t array) Cmap.t *
 
 type cooking_info = { 
   modlist : work_list; 
-  abstract : Context.Named.t * Univ.universe_level_subst * Univ.AUContext.t } 
+  abstract : Context.Named.t * Univ.Instance.t * Univ.AUContext.t }
 
 (* The type has two caveats:
    1) cook_constr is defined after
@@ -63,7 +63,7 @@ val join_opaque : opaquetab -> opaque -> unit
 
 val dump : opaquetab ->
   Constr.t Future.computation array *
-  Univ.universe_context_set Future.computation array *
+  Univ.ContextSet.t Future.computation array *
   cooking_info list array *
   int Future.UUIDMap.t
 
@@ -75,7 +75,7 @@ val dump : opaquetab ->
 *)
 
 val set_indirect_opaque_accessor :
-  (DirPath.t -> int -> Term.constr Future.computation) -> unit
+  (DirPath.t -> int -> constr Future.computation) -> unit
 val set_indirect_univ_accessor :
-  (DirPath.t -> int -> Univ.universe_context_set Future.computation option) -> unit
+  (DirPath.t -> int -> Univ.ContextSet.t Future.computation option) -> unit
 
diff --git a/kernel/pre_env.ml b/kernel/pre_env.ml
index 94738d618..6c5e1cde5 100644
--- a/kernel/pre_env.ml
+++ b/kernel/pre_env.ml
@@ -15,7 +15,6 @@
 
 open Util
 open Names
-open Term
 open Declarations
 
 module NamedDecl = Context.Named.Declaration
@@ -50,7 +49,7 @@ type stratification = {
 }
 
 type val_kind =
-    | VKvalue of (values * Id.Set.t) CEphemeron.key
+    | VKvalue of (Vmvalues.values * Id.Set.t) CEphemeron.key
     | VKnone
 
 type lazy_val = val_kind ref
@@ -67,15 +66,18 @@ type named_context_val = {
   env_named_map : (Context.Named.Declaration.t * lazy_val) Id.Map.t;
 }
 
+type rel_context_val = {
+  env_rel_ctx : Context.Rel.t;
+  env_rel_map : (Context.Rel.Declaration.t * lazy_val) Range.t;
+}
+
 type env = {
   env_globals       : globals;           (* globals = constants + inductive types + modules + module-types *)
   env_named_context : named_context_val; (* section variables *)
-  env_rel_context   : Context.Rel.t;
-  env_rel_val       : lazy_val list;
+  env_rel_context   : rel_context_val;
   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;
 }
@@ -85,6 +87,11 @@ let empty_named_context_val = {
   env_named_map = Id.Map.empty;
 }
 
+let empty_rel_context_val = {
+  env_rel_ctx = [];
+  env_rel_map = Range.empty;
+}
+
 let empty_env = {
   env_globals = {
     env_constants = Cmap_env.empty;
@@ -92,14 +99,12 @@ let empty_env = {
     env_modules = MPmap.empty;
     env_modtypes = MPmap.empty};
   env_named_context = empty_named_context_val;
-  env_rel_context = Context.Rel.empty;
-  env_rel_val = [];
+  env_rel_context = empty_rel_context_val;
   env_nb_rel = 0;
   env_stratification = {
     env_universes = UGraph.initial_universes;
     env_engagement = PredicativeSet };
-  env_typing_flags = Declareops.safe_flags;
-  env_conv_oracle = Conv_oracle.empty;
+  env_typing_flags = Declareops.safe_flags Conv_oracle.empty;
   retroknowledge = Retroknowledge.initial_retroknowledge;
   indirect_pterms = Opaqueproof.empty_opaquetab }
 
@@ -108,21 +113,39 @@ let empty_env = {
 
 let nb_rel env = env.env_nb_rel
 
+let push_rel_context_val d ctx = {
+  env_rel_ctx = Context.Rel.add d ctx.env_rel_ctx;
+  env_rel_map = Range.cons (d, ref VKnone) ctx.env_rel_map;
+}
+
+let match_rel_context_val ctx = match ctx.env_rel_ctx with
+| [] -> None
+| decl :: rem ->
+  let (_, lval) = Range.hd ctx.env_rel_map in
+  let ctx = { env_rel_ctx = rem; env_rel_map = Range.tl ctx.env_rel_map } in
+  Some (decl, lval, ctx)
+
 let push_rel d env =
-  let rval = ref VKnone in
     { env with
-      env_rel_context = Context.Rel.add d env.env_rel_context;
-      env_rel_val = rval :: env.env_rel_val;
+      env_rel_context = push_rel_context_val d env.env_rel_context;
       env_nb_rel = env.env_nb_rel + 1 }
 
+let lookup_rel n env =
+  try fst (Range.get env.env_rel_context.env_rel_map (n - 1))
+  with Invalid_argument _ -> raise Not_found
+
 let lookup_rel_val n env =
-  try List.nth env.env_rel_val (n - 1)
-  with Failure _ -> raise Not_found
+  try snd (Range.get env.env_rel_context.env_rel_map (n - 1))
+  with Invalid_argument _ -> raise Not_found
+
+let rel_skipn n ctx = {
+  env_rel_ctx = Util.List.skipn n ctx.env_rel_ctx;
+  env_rel_map = Range.skipn n ctx.env_rel_map;
+}
 
 let env_of_rel n env =
   { env with
-    env_rel_context = Util.List.skipn n env.env_rel_context;
-    env_rel_val = Util.List.skipn n env.env_rel_val;
+    env_rel_context = rel_skipn n env.env_rel_context;
     env_nb_rel = env.env_nb_rel - n
   }
 
diff --git a/kernel/pre_env.mli b/kernel/pre_env.mli
index f2a009b86..a6b57bd1b 100644
--- a/kernel/pre_env.mli
+++ b/kernel/pre_env.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Declarations
 
 (** The type of environments. *)
@@ -36,24 +36,27 @@ type stratification = {
 
 type lazy_val
 
-val force_lazy_val : lazy_val -> (values * Id.Set.t) option
+val force_lazy_val : lazy_val -> (Vmvalues.values * Id.Set.t) option
 val dummy_lazy_val : unit -> lazy_val
-val build_lazy_val : lazy_val -> (values * Id.Set.t) -> unit
+val build_lazy_val : lazy_val -> (Vmvalues.values * Id.Set.t) -> unit
 
 type named_context_val = private {
   env_named_ctx : Context.Named.t;
   env_named_map : (Context.Named.Declaration.t * lazy_val) Id.Map.t;
 }
 
+type rel_context_val = private {
+  env_rel_ctx : Context.Rel.t;
+  env_rel_map : (Context.Rel.Declaration.t * lazy_val) Range.t;
+}
+
 type env = {
     env_globals       : globals;
     env_named_context : named_context_val;
-    env_rel_context   : Context.Rel.t;
-    env_rel_val       : lazy_val list;
+    env_rel_context   : rel_context_val;
     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;
 }
@@ -64,8 +67,15 @@ val empty_env : env
 
 (** Rel context *)
 
+val empty_rel_context_val : rel_context_val
+val push_rel_context_val :
+  Context.Rel.Declaration.t -> rel_context_val -> rel_context_val
+val match_rel_context_val  :
+  rel_context_val -> (Context.Rel.Declaration.t * lazy_val * rel_context_val) option
+
 val nb_rel         : env -> int
 val push_rel       : Context.Rel.Declaration.t -> env -> env
+val lookup_rel     : int -> env -> Context.Rel.Declaration.t
 val lookup_rel_val : int -> env -> lazy_val
 val env_of_rel     : int -> env -> env
 
@@ -88,9 +98,9 @@ val env_of_named     : Id.t -> env -> env
 (** Global constants *)
 
 
-val lookup_constant_key : constant -> env -> constant_key
-val lookup_constant : constant -> env -> constant_body
+val lookup_constant_key : Constant.t -> env -> constant_key
+val lookup_constant : Constant.t -> env -> constant_body
 
 (** Mutual Inductives *)
-val lookup_mind_key : mutual_inductive -> env -> mind_key
-val lookup_mind : mutual_inductive -> env -> mutual_inductive_body
+val lookup_mind_key : MutInd.t -> env -> mind_key
+val lookup_mind : MutInd.t -> env -> mutual_inductive_body
diff --git a/kernel/reduction.ml b/kernel/reduction.ml
index 2bf9f43a5..68f53c355 100644
--- a/kernel/reduction.ml
+++ b/kernel/reduction.ml
@@ -18,7 +18,7 @@
 open CErrors
 open Util
 open Names
-open Term
+open Constr
 open Vars
 open Environ
 open CClosure
@@ -57,12 +57,14 @@ let compare_stack_shape stk1 stk2 =
         Int.equal bal 0 (* && c1.ci_ind  = c2.ci_ind *) && compare_rec 0 s1 s2
     | (Zfix(_,a1)::s1, Zfix(_,a2)::s2) ->
         Int.equal bal 0 && compare_rec 0 a1 a2 && compare_rec 0 s1 s2
-    | (_,_) -> false in
+    | [], _ :: _
+    | (Zproj _ | ZcaseT _ | Zfix _) :: _, _ -> false
+  in
   compare_rec 0 stk1 stk2
 
 type lft_constr_stack_elt =
     Zlapp of (lift * fconstr) array
-  | Zlproj of constant * lift
+  | Zlproj of Constant.t * lift
   | Zlfix of (lift * fconstr) * lft_constr_stack
   | Zlcase of case_info * lift * fconstr * fconstr array
 and lft_constr_stack = lft_constr_stack_elt list
@@ -107,11 +109,11 @@ let pure_stack lfts stk =
 (****************************************************************************)
 
 let whd_betaiota env t =
-  match kind_of_term t with
+  match kind t with
     | (Sort _|Var _|Meta _|Evar _|Const _|Ind _|Construct _|
        Prod _|Lambda _|Fix _|CoFix _) -> t
     | App (c, _) ->
-      begin match kind_of_term c with
+      begin match kind c with
       | Ind _ | Construct _ | Evar _ | Meta _ | Const _ | LetIn _ -> t
       | _ -> whd_val (create_clos_infos betaiota env) (inject t)
       end
@@ -121,37 +123,46 @@ let nf_betaiota env t =
   norm_val (create_clos_infos betaiota env) (inject t)
 
 let whd_betaiotazeta env x =
-  match kind_of_term x with
-    | (Sort _|Var _|Meta _|Evar _|Const _|Ind _|Construct _|
+  match kind x with
+  | (Sort _|Var _|Meta _|Evar _|Const _|Ind _|Construct _|
        Prod _|Lambda _|Fix _|CoFix _) -> x
     | App (c, _) ->
-      begin match kind_of_term c with
+      begin match kind c with
       | Ind _ | Construct _ | Evar _ | Meta _ | Const _ -> x
-      | _ -> whd_val (create_clos_infos betaiotazeta env) (inject x)
+      | Sort _ | Rel _ | Var _ | Cast _ | Prod _ | Lambda _ | LetIn _ | App _
+        | Case _ | Fix _ | CoFix _ | Proj _ ->
+         whd_val (create_clos_infos betaiotazeta env) (inject x)
       end
-    | _ -> whd_val (create_clos_infos betaiotazeta env) (inject x)
+    | Rel _ | Cast _ | LetIn _ | Case _ | Proj _ ->
+        whd_val (create_clos_infos betaiotazeta env) (inject x)
 
 let whd_all env t =
-  match kind_of_term t with
+  match kind t with
     | (Sort _|Meta _|Evar _|Ind _|Construct _|
        Prod _|Lambda _|Fix _|CoFix _) -> t
     | App (c, _) ->
-      begin match kind_of_term c with
+      begin match kind c with
       | Ind _ | Construct _ | Evar _ | Meta _ -> t
-      | _ -> whd_val (create_clos_infos all env) (inject t)
+      | Sort _ | Rel _ | Var _ | Cast _ | Prod _ | Lambda _ | LetIn _ | App _
+        | Const _ |Case _ | Fix _ | CoFix _ | Proj _ ->
+         whd_val (create_clos_infos all env) (inject t)
       end
-    | _ -> whd_val (create_clos_infos all env) (inject t)
+    | Rel _ | Cast _ | LetIn _ | Case _ | Proj _ | Const _ | Var _ ->
+        whd_val (create_clos_infos all env) (inject t)
 
 let whd_allnolet env t =
-  match kind_of_term t with
+  match kind t with
     | (Sort _|Meta _|Evar _|Ind _|Construct _|
        Prod _|Lambda _|Fix _|CoFix _|LetIn _) -> t
     | App (c, _) ->
-      begin match kind_of_term c with
+      begin match kind c with
       | Ind _ | Construct _ | Evar _ | Meta _ | LetIn _ -> t
-      | _ -> whd_val (create_clos_infos allnolet env) (inject t)
+      | Sort _ | Rel _ | Var _ | Cast _ | Prod _ | Lambda _ | App _
+        | Const _ | Case _ | Fix _ | CoFix _ | Proj _ ->
+         whd_val (create_clos_infos allnolet env) (inject t)
       end
-    | _ -> whd_val (create_clos_infos allnolet env) (inject t)
+    | Rel _ | Cast _ | Case _ | Proj _ | Const _ | Var _ ->
+        whd_val (create_clos_infos allnolet env) (inject t)
 
 (********************************************************************)
 (*                         Conversion                               *)
@@ -189,33 +200,79 @@ let is_cumul = function CUMUL -> true | CONV -> false
 
 type 'a universe_compare = 
   { (* Might raise NotConvertible *)
-    compare : env -> conv_pb -> sorts -> sorts -> 'a -> 'a;
+    compare_sorts : env -> conv_pb -> Sorts.t -> Sorts.t -> 'a -> 'a;
     compare_instances: flex:bool -> Univ.Instance.t -> Univ.Instance.t -> 'a -> 'a;
-    conv_inductives : conv_pb -> (Declarations.mutual_inductive_body * int) -> Univ.Instance.t -> int ->
-      Univ.Instance.t -> int -> 'a -> 'a;
-    conv_constructors : (Declarations.mutual_inductive_body * int * int) ->
-      Univ.Instance.t -> int -> Univ.Instance.t -> int -> 'a -> 'a;
-  } 
+    compare_cumul_instances : Univ.Constraint.t -> 'a -> 'a }
 
 type 'a universe_state = 'a * 'a universe_compare
 
 type ('a,'b) generic_conversion_function = env -> 'b universe_state -> 'a -> 'a -> 'b
 
-type 'a infer_conversion_function = env -> UGraph.t -> 'a -> 'a -> Univ.constraints
+type 'a infer_conversion_function = env -> UGraph.t -> 'a -> 'a -> Univ.Constraint.t
 
 let sort_cmp_universes env pb s0 s1 (u, check) =
-  (check.compare env pb s0 s1 u, check)
+  (check.compare_sorts env pb s0 s1 u, check)
 
 (* [flex] should be true for constants, false for inductive types and
    constructors. *)
 let convert_instances ~flex u u' (s, check) =
   (check.compare_instances ~flex u u' s, check)
-  
-let convert_inductives cv_pb ind u1 sv1 u2 sv2 (s, check) =
-  (check.conv_inductives cv_pb ind u1 sv1 u2 sv2 s, check)
 
-let convert_constructors cons u1 sv1 u2 sv2 (s, check) =
-  (check.conv_constructors cons u1 sv1 u2 sv2 s, check)
+let get_cumulativity_constraints cv_pb cumi u u' =
+  match cv_pb with
+  | CONV ->
+    Univ.ACumulativityInfo.eq_constraints cumi u u' Univ.Constraint.empty
+  | CUMUL ->
+    Univ.ACumulativityInfo.leq_constraints cumi u u' Univ.Constraint.empty
+
+let inductive_cumulativity_arguments (mind,ind) =
+  mind.Declarations.mind_nparams +
+  mind.Declarations.mind_packets.(ind).Declarations.mind_nrealargs
+
+let convert_inductives_gen cmp_instances cmp_cumul cv_pb (mind,ind) nargs u1 u2 s =
+  match mind.Declarations.mind_universes with
+  | Declarations.Monomorphic_ind _ ->
+    assert (Univ.Instance.length u1 = 0 && Univ.Instance.length u2 = 0);
+    s
+  | Declarations.Polymorphic_ind _ ->
+    cmp_instances u1 u2 s
+  | Declarations.Cumulative_ind cumi ->
+    let num_param_arity = inductive_cumulativity_arguments (mind,ind) in
+    if not (Int.equal num_param_arity nargs) then
+      cmp_instances u1 u2 s
+    else
+      let csts = get_cumulativity_constraints cv_pb cumi u1 u2 in
+      cmp_cumul csts s
+
+let convert_inductives cv_pb ind nargs u1 u2 (s, check) =
+  convert_inductives_gen (check.compare_instances ~flex:false) check.compare_cumul_instances
+    cv_pb ind nargs u1 u2 s, check
+
+let constructor_cumulativity_arguments (mind, ind, ctor) =
+  let nparamsctxt =
+    mind.Declarations.mind_nparams +
+    mind.Declarations.mind_packets.(ind).Declarations.mind_nrealargs
+    (* Context.Rel.length mind.Declarations.mind_params_ctxt *) in
+  nparamsctxt + mind.Declarations.mind_packets.(ind).Declarations.mind_consnrealargs.(ctor - 1)
+
+let convert_constructors_gen cmp_instances cmp_cumul (mind, ind, cns) nargs u1 u2 s =
+  match mind.Declarations.mind_universes with
+  | Declarations.Monomorphic_ind _ ->
+    assert (Univ.Instance.length u1 = 0 && Univ.Instance.length u2 = 0);
+    s
+  | Declarations.Polymorphic_ind _ ->
+    cmp_instances u1 u2 s
+  | Declarations.Cumulative_ind cumi ->
+    let num_cnstr_args = constructor_cumulativity_arguments (mind,ind,cns) in
+    if not (Int.equal num_cnstr_args nargs) then
+      cmp_instances u1 u2 s
+    else
+      let csts = get_cumulativity_constraints CONV cumi u1 u2 in
+      cmp_cumul csts s
+
+let convert_constructors ctor nargs u1 u2 (s, check) =
+  convert_constructors_gen (check.compare_instances ~flex:false) check.compare_cumul_instances
+    ctor nargs u1 u2 s, check
 
 let conv_table_key infos k1 k2 cuniv =
   if k1 == k2 then cuniv else
@@ -239,7 +296,7 @@ let compare_stacks f fmind lft1 stk1 lft2 stk2 cuniv =
             | (Zlapp a1,Zlapp a2) -> 
 	       Array.fold_right2 f a1 a2 cu1
 	    | (Zlproj (c1,l1),Zlproj (c2,l2)) -> 
-	      if not (eq_constant c1 c2) then 
+	      if not (Constant.equal c1 c2) then 
 		raise NotConvertible
 	      else cu1
             | (Zlfix(fx1,a1),Zlfix(fx2,a2)) ->
@@ -297,23 +354,12 @@ let in_whnf (t,stk) =
     | (FFlex _ | FProd _ | FEvar _ | FInd _ | FAtom _ | FRel _ | FProj _) -> true
     | FLOCKED -> assert false
 
-let unfold_projection infos p c =
-  let unf = Projection.unfolded p in
-    if unf || RedFlags.red_set infos.i_flags (RedFlags.fCONST (Projection.constant p)) then
-      (match try Some (lookup_projection p (info_env infos)) with Not_found -> None with
-      | Some pb -> 
-	let s = Zproj (pb.Declarations.proj_npars, pb.Declarations.proj_arg, 
-		       Projection.constant p) in
-	  Some (c, s)
-      | None -> None)
-  else None
-
 (* Conversion between  [lft1]term1 and [lft2]term2 *)
-let rec ccnv env cv_pb l2r infos lft1 lft2 term1 term2 cuniv =
-  eqappr env cv_pb l2r infos (lft1, (term1,[])) (lft2, (term2,[])) cuniv
+let rec ccnv cv_pb l2r infos lft1 lft2 term1 term2 cuniv =
+  eqappr cv_pb l2r infos (lft1, (term1,[])) (lft2, (term2,[])) cuniv
 
 (* Conversion between [lft1](hd1 v1) and [lft2](hd2 v2) *)
-and eqappr env cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
+and eqappr cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
   Control.check_for_interrupt ();
   (* First head reduce both terms *)
   let whd = whd_stack (infos_with_reds infos betaiotazeta) in
@@ -325,41 +371,44 @@ and eqappr env cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
     if in_whnf st1' then (st1',st2') else whd_both st1' st2' in
   let ((hd1,v1),(hd2,v2)) = whd_both st1 st2 in
   let appr1 = (lft1,(hd1,v1)) and appr2 = (lft2,(hd2,v2)) in
-  (* compute the lifts that apply to the head of the term (hd1 and hd2) *)
-  let el1 = el_stack lft1 v1 in
-  let el2 = el_stack lft2 v2 in
+  (** We delay the computation of the lifts that apply to the head of the term
+      with [el_stack] inside the branches where they are actually used. *)
   match (fterm_of hd1, fterm_of hd2) with
     (* case of leaves *)
     | (FAtom a1, FAtom a2) ->
-	(match kind_of_term a1, kind_of_term a2 with
+	(match kind a1, kind a2 with
 	   | (Sort s1, Sort s2) ->
 	       if not (is_empty_stack v1 && is_empty_stack v2) then
 		 anomaly (Pp.str "conversion was given ill-typed terms (Sort).");
 	       sort_cmp_universes (env_of_infos infos) cv_pb s1 s2 cuniv
 	   | (Meta n, Meta m) ->
                if Int.equal n m
-	       then convert_stacks env l2r infos lft1 lft2 v1 v2 cuniv
+               then convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
                else raise NotConvertible
 	   | _ -> raise NotConvertible)
     | (FEvar ((ev1,args1),env1), FEvar ((ev2,args2),env2)) ->
         if Evar.equal ev1 ev2 then
-          let cuniv = convert_stacks env l2r infos lft1 lft2 v1 v2 cuniv in
-          convert_vect env l2r infos el1 el2
+          let el1 = el_stack lft1 v1 in
+          let el2 = el_stack lft2 v2 in
+          let cuniv = convert_stacks l2r infos lft1 lft2 v1 v2 cuniv in
+          convert_vect l2r infos el1 el2
             (Array.map (mk_clos env1) args1)
             (Array.map (mk_clos env2) args2) cuniv
         else raise NotConvertible
 
     (* 2 index known to be bound to no constant *)
     | (FRel n, FRel m) ->
+        let el1 = el_stack lft1 v1 in
+        let el2 = el_stack lft2 v2 in
         if Int.equal (reloc_rel n el1) (reloc_rel m el2)
-        then convert_stacks env l2r infos lft1 lft2 v1 v2 cuniv
+        then convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
         else raise NotConvertible
 
     (* 2 constants, 2 local defined vars or 2 defined rels *)
     | (FFlex fl1, FFlex fl2) ->
       (try
 	 let cuniv = conv_table_key infos fl1 fl2 cuniv in
-	   convert_stacks env l2r infos lft1 lft2 v1 v2 cuniv
+           convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
        with NotConvertible | Univ.UniverseInconsistency _ ->
            (* else the oracle tells which constant is to be expanded *)
 	 let oracle = CClosure.oracle_of_infos infos in
@@ -379,50 +428,52 @@ and eqappr env cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
                | Some def1 -> ((lft1, (def1, v1)), appr2)
 	       | None -> raise NotConvertible) 
 	 in
-           eqappr env cv_pb l2r infos app1 app2 cuniv)
+           eqappr cv_pb l2r infos app1 app2 cuniv)
 
     | (FProj (p1,c1), FProj (p2, c2)) ->
       (* Projections: prefer unfolding to first-order unification,
 	 which will happen naturally if the terms c1, c2 are not in constructor
 	 form *)
-      (match unfold_projection infos p1 c1 with
-      | Some (def1,s1) -> 
-	eqappr env cv_pb l2r infos (lft1, (def1, (s1 :: v1))) appr2 cuniv
+      (match unfold_projection infos p1 with
+      | Some s1 ->
+        eqappr cv_pb l2r infos (lft1, (c1, (s1 :: v1))) appr2 cuniv
       | None ->
-	match unfold_projection infos p2 c2 with
-	| Some (def2,s2) ->
-	  eqappr env cv_pb l2r infos appr1 (lft2, (def2, (s2 :: v2))) cuniv
+        match unfold_projection infos p2 with
+        | Some s2 ->
+          eqappr cv_pb l2r infos appr1 (lft2, (c2, (s2 :: v2))) cuniv
 	| None -> 
           if Constant.equal (Projection.constant p1) (Projection.constant p2)
 	     && compare_stack_shape v1 v2 then
-	    let u1 = ccnv env CONV l2r infos el1 el2 c1 c2 cuniv in
-	      convert_stacks env l2r infos lft1 lft2 v1 v2 u1
+            let el1 = el_stack lft1 v1 in
+            let el2 = el_stack lft2 v2 in
+            let u1 = ccnv CONV l2r infos el1 el2 c1 c2 cuniv in
+              convert_stacks l2r infos lft1 lft2 v1 v2 u1
 	  else (* Two projections in WHNF: unfold *)
 	    raise NotConvertible)
 
     | (FProj (p1,c1), t2) ->
-      (match unfold_projection infos p1 c1 with
-      | Some (def1,s1) ->
-         eqappr env cv_pb l2r infos (lft1, (def1, (s1 :: v1))) appr2 cuniv
+      (match unfold_projection infos p1 with
+      | Some s1 ->
+         eqappr cv_pb l2r infos (lft1, (c1, (s1 :: v1))) appr2 cuniv
       | None -> 
 	 (match t2 with 
 	  | FFlex fl2 ->
 	     (match unfold_reference infos fl2 with
               | Some def2 ->
-		 eqappr env cv_pb l2r infos appr1 (lft2, (def2, v2)) cuniv
+                 eqappr cv_pb l2r infos appr1 (lft2, (def2, v2)) cuniv
               | None -> raise NotConvertible)
 	  | _ -> raise NotConvertible))
       
     | (t1, FProj (p2,c2)) ->
-      (match unfold_projection infos p2 c2 with
-      | Some (def2,s2) -> 
-         eqappr env cv_pb l2r infos appr1 (lft2, (def2, (s2 :: v2))) cuniv
+      (match unfold_projection infos p2 with
+      | Some s2 ->
+         eqappr cv_pb l2r infos appr1 (lft2, (c2, (s2 :: v2))) cuniv
       | None -> 
 	 (match t1 with 
 	  | FFlex fl1 ->
 	     (match unfold_reference infos fl1 with
               | Some def1 ->
-		 eqappr env cv_pb l2r infos (lft1, (def1, v1)) appr2 cuniv
+                 eqappr cv_pb l2r infos (lft1, (def1, v1)) appr2 cuniv
               | None -> raise NotConvertible)
 	  | _ -> raise NotConvertible))
       
@@ -434,15 +485,19 @@ and eqappr env cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
 	  anomaly (Pp.str "conversion was given ill-typed terms (FLambda).");
         let (_,ty1,bd1) = destFLambda mk_clos hd1 in
         let (_,ty2,bd2) = destFLambda mk_clos hd2 in
-        let cuniv = ccnv env CONV l2r infos el1 el2 ty1 ty2 cuniv in
-        ccnv env CONV l2r infos (el_lift el1) (el_lift el2) bd1 bd2 cuniv
+        let el1 = el_stack lft1 v1 in
+        let el2 = el_stack lft2 v2 in
+        let cuniv = ccnv CONV l2r infos el1 el2 ty1 ty2 cuniv in
+        ccnv CONV l2r infos (el_lift el1) (el_lift el2) bd1 bd2 cuniv
 
     | (FProd (_,c1,c2), FProd (_,c'1,c'2)) ->
         if not (is_empty_stack v1 && is_empty_stack v2) then
 	  anomaly (Pp.str "conversion was given ill-typed terms (FProd).");
 	(* Luo's system *)
-        let cuniv = ccnv env CONV l2r infos el1 el2 c1 c'1 cuniv in
-        ccnv env cv_pb l2r infos (el_lift el1) (el_lift el2) c2 c'2 cuniv
+        let el1 = el_stack lft1 v1 in
+        let el2 = el_stack lft2 v2 in
+        let cuniv = ccnv CONV l2r infos el1 el2 c1 c'1 cuniv in
+        ccnv cv_pb l2r infos (el_lift el1) (el_lift el2) c2 c'2 cuniv
 
     (* Eta-expansion on the fly *)
     | (FLambda _, _) ->
@@ -452,7 +507,7 @@ and eqappr env cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
           anomaly (Pp.str "conversion was given unreduced term (FLambda).")
         in
         let (_,_ty1,bd1) = destFLambda mk_clos hd1 in
-	eqappr env CONV l2r infos
+        eqappr CONV l2r infos
 	  (el_lift lft1, (bd1, [])) (el_lift lft2, (hd2, eta_expand_stack v2)) cuniv
     | (_, FLambda _) ->
         let () = match v2 with
@@ -461,34 +516,43 @@ and eqappr env cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
 	  anomaly (Pp.str "conversion was given unreduced term (FLambda).")
 	in
         let (_,_ty2,bd2) = destFLambda mk_clos hd2 in
-	eqappr env CONV l2r infos
+        eqappr CONV l2r infos
 	  (el_lift lft1, (hd1, eta_expand_stack v1)) (el_lift lft2, (bd2, [])) cuniv
 	
     (* only one constant, defined var or defined rel *)
     | (FFlex fl1, c2)      ->
        (match unfold_reference infos fl1 with
 	| Some def1 ->
-	   eqappr env cv_pb l2r infos (lft1, (def1, v1)) appr2 cuniv
+          (** By virtue of the previous case analyses, we know [c2] is rigid.
+              Conversion check to rigid terms eventually implies full weak-head
+              reduction, so instead of repeatedly performing small-step
+              unfoldings, we perform reduction with all flags on. *)
+            let all = RedFlags.red_add_transparent all (RedFlags.red_transparent (info_flags infos)) in
+            let r1 = whd_stack (infos_with_reds infos all) def1 v1 in
+            eqappr cv_pb l2r infos (lft1, r1) appr2 cuniv
 	| None -> 
 	   match c2 with
 	   | FConstruct ((ind2,j2),u2) ->
 	      (try
 	      let v2, v1 =
 		eta_expand_ind_stack (info_env infos) ind2 hd2 v2 (snd appr1)
-	      in convert_stacks env l2r infos lft1 lft2 v1 v2 cuniv
+              in convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
 	      with Not_found -> raise NotConvertible)
 	   | _ -> raise NotConvertible)
        
     | (c1, FFlex fl2)      ->
        (match unfold_reference infos fl2 with
         | Some def2 ->
-	   eqappr env cv_pb l2r infos appr1 (lft2, (def2, v2)) cuniv
+          (** Symmetrical case of above. *)
+          let all = RedFlags.red_add_transparent all (RedFlags.red_transparent (info_flags infos)) in
+          let r2 = whd_stack (infos_with_reds infos all) def2 v2 in
+          eqappr cv_pb l2r infos appr1 (lft2, r2) cuniv
         | None -> 
 	   match c1 with
 	   | FConstruct ((ind1,j1),u1) ->
  	      (try let v1, v2 =
 	     	     eta_expand_ind_stack (info_env infos) ind1 hd1 v1 (snd appr2)
-	     	   in convert_stacks env l2r infos lft1 lft2 v1 v2 cuniv
+                   in convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
 	       with Not_found -> raise NotConvertible)
 	   | _ -> raise NotConvertible)
        
@@ -497,37 +561,30 @@ and eqappr env cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
       if eq_ind ind1 ind2 then
         if Univ.Instance.length u1 = 0 || Univ.Instance.length u2 = 0 then
           let cuniv = convert_instances ~flex:false u1 u2 cuniv in
-          convert_stacks env l2r infos lft1 lft2 v1 v2 cuniv
+          convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
         else
-          let mind = Environ.lookup_mind (fst ind1) env in
-          let cuniv =
-            match mind.Declarations.mind_universes with
-            | Declarations.Monomorphic_ind _ | Declarations.Polymorphic_ind _ ->
-              convert_instances ~flex:false u1 u2 cuniv
-            | Declarations.Cumulative_ind cumi ->
-              convert_inductives cv_pb (mind, snd ind1) u1 (CClosure.stack_args_size v1)
-                u2 (CClosure.stack_args_size v2) cuniv
-          in
-          convert_stacks env l2r infos lft1 lft2 v1 v2 cuniv
+          let mind = Environ.lookup_mind (fst ind1) (info_env infos) in
+          let nargs = CClosure.stack_args_size v1 in
+          if not (Int.equal nargs (CClosure.stack_args_size v2))
+          then raise NotConvertible
+          else
+            let cuniv = convert_inductives cv_pb (mind, snd ind1) nargs u1 u2 cuniv in
+            convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
       else raise NotConvertible
 
     | (FConstruct ((ind1,j1),u1), FConstruct ((ind2,j2),u2)) ->
       if Int.equal j1 j2 && eq_ind ind1 ind2 then
         if Univ.Instance.length u1 = 0 || Univ.Instance.length u2 = 0 then
           let cuniv = convert_instances ~flex:false u1 u2 cuniv in
-          convert_stacks env l2r infos lft1 lft2 v1 v2 cuniv
+          convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
         else
-          let mind = Environ.lookup_mind (fst ind1) env in
-          let cuniv =
-            match mind.Declarations.mind_universes with
-            | Declarations.Monomorphic_ind _ | Declarations.Polymorphic_ind _ ->
-              convert_instances ~flex:false u1 u2 cuniv
-            | Declarations.Cumulative_ind _ ->
-              convert_constructors
-                (mind, snd ind1, j1) u1 (CClosure.stack_args_size v1)
-                u2 (CClosure.stack_args_size v2) cuniv
-          in
-          convert_stacks env l2r infos lft1 lft2 v1 v2 cuniv
+          let mind = Environ.lookup_mind (fst ind1) (info_env infos) in
+          let nargs = CClosure.stack_args_size v1 in
+          if not (Int.equal nargs (CClosure.stack_args_size v2))
+          then raise NotConvertible
+          else
+            let cuniv = convert_constructors (mind, snd ind1, j1) nargs u1 u2 cuniv in
+            convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
       else raise NotConvertible
 	  
     (* Eta expansion of records *)
@@ -535,14 +592,14 @@ and eqappr env cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
       (try
     	 let v1, v2 =
     	   eta_expand_ind_stack (info_env infos) ind1 hd1 v1 (snd appr2)
-    	 in convert_stacks env l2r infos lft1 lft2 v1 v2 cuniv
+         in convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
        with Not_found -> raise NotConvertible)
 
     | (_, FConstruct ((ind2,j2),u2)) ->
       (try
     	 let v2, v1 =
     	   eta_expand_ind_stack (info_env infos) ind2 hd2 v2 (snd appr1)
-    	 in convert_stacks env l2r infos lft1 lft2 v1 v2 cuniv
+         in convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
        with Not_found -> raise NotConvertible)
 
     | (FFix (((op1, i1),(_,tys1,cl1)),e1), FFix(((op2, i2),(_,tys2,cl2)),e2)) ->
@@ -553,11 +610,13 @@ and eqappr env cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
           let fty2 = Array.map (mk_clos e2) tys2 in
           let fcl1 = Array.map (mk_clos (subs_liftn n e1)) cl1 in
           let fcl2 = Array.map (mk_clos (subs_liftn n e2)) cl2 in
-	  let cuniv = convert_vect env l2r infos el1 el2 fty1 fty2 cuniv in
+          let el1 = el_stack lft1 v1 in
+          let el2 = el_stack lft2 v2 in
+          let cuniv = convert_vect l2r infos el1 el2 fty1 fty2 cuniv in
           let cuniv =
-            convert_vect env l2r infos
+            convert_vect l2r infos
 	      (el_liftn n el1) (el_liftn n el2) fcl1 fcl2 cuniv in
-          convert_stacks env l2r infos lft1 lft2 v1 v2 cuniv
+          convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
         else raise NotConvertible
 
     | (FCoFix ((op1,(_,tys1,cl1)),e1), FCoFix((op2,(_,tys2,cl2)),e2)) ->
@@ -568,28 +627,30 @@ and eqappr env cv_pb l2r infos (lft1,st1) (lft2,st2) cuniv =
           let fty2 = Array.map (mk_clos e2) tys2 in
           let fcl1 = Array.map (mk_clos (subs_liftn n e1)) cl1 in
           let fcl2 = Array.map (mk_clos (subs_liftn n e2)) cl2 in
-          let cuniv = convert_vect env l2r infos el1 el2 fty1 fty2 cuniv in
+          let el1 = el_stack lft1 v1 in
+          let el2 = el_stack lft2 v2 in
+          let cuniv = convert_vect l2r infos el1 el2 fty1 fty2 cuniv in
           let cuniv =
-	    convert_vect env l2r infos
+            convert_vect l2r infos
 	      (el_liftn n el1) (el_liftn n el2) fcl1 fcl2 cuniv in
-          convert_stacks env l2r infos lft1 lft2 v1 v2 cuniv
+          convert_stacks l2r infos lft1 lft2 v1 v2 cuniv
         else raise NotConvertible
 
      (* Should not happen because both (hd1,v1) and (hd2,v2) are in whnf *)
      | ( (FLetIn _, _) | (FCaseT _,_) | (FApp _,_) | (FCLOS _,_) | (FLIFT _,_)
        | (_, FLetIn _) | (_,FCaseT _) | (_,FApp _) | (_,FCLOS _) | (_,FLIFT _)
-       | (FLOCKED,_) | (_,FLOCKED) ) -> assert false
+       | (FLOCKED,_) | (_,FLOCKED) ) | (FCast _, _) | (_, FCast _) -> assert false
 
-     (* In all other cases, terms are not convertible *)
-     | _ -> raise NotConvertible
+     | (FRel _ | FAtom _ | FInd _ | FFix _ | FCoFix _
+        | FProd _ | FEvar _), _ -> raise NotConvertible
 
-and convert_stacks env l2r infos lft1 lft2 stk1 stk2 cuniv =
+and convert_stacks l2r infos lft1 lft2 stk1 stk2 cuniv =
   compare_stacks
-    (fun (l1,t1) (l2,t2) cuniv -> ccnv env CONV l2r infos l1 l2 t1 t2 cuniv)
+    (fun (l1,t1) (l2,t2) cuniv -> ccnv CONV l2r infos l1 l2 t1 t2 cuniv)
     (eq_ind)
     lft1 stk1 lft2 stk2 cuniv
 
-and convert_vect env l2r infos lft1 lft2 v1 v2 cuniv =
+and convert_vect l2r infos lft1 lft2 v1 v2 cuniv =
   let lv1 = Array.length v1 in
   let lv2 = Array.length v2 in
   if Int.equal lv1 lv2
@@ -597,7 +658,7 @@ and convert_vect env l2r infos lft1 lft2 v1 v2 cuniv =
     let rec fold n cuniv =
       if n >= lv1 then cuniv
       else
-        let cuniv = ccnv env CONV l2r infos lft1 lft2 v1.(n) v2.(n) cuniv in
+        let cuniv = ccnv CONV l2r infos lft1 lft2 v1.(n) v2.(n) cuniv in
         fold (n+1) cuniv in
     fold 0 cuniv
   else raise NotConvertible
@@ -605,7 +666,7 @@ and convert_vect env l2r infos lft1 lft2 v1 v2 cuniv =
 let clos_gen_conv trans cv_pb l2r evars env univs t1 t2 =
   let reds = CClosure.RedFlags.red_add_transparent betaiotazeta trans in
   let infos = create_clos_infos ~evars reds env in
-  ccnv env cv_pb l2r infos el_id el_id (inject t1) (inject t2) univs
+  ccnv cv_pb l2r infos el_id el_id (inject t1) (inject t2) univs
 
 
 let check_eq univs u u' = 
@@ -615,6 +676,7 @@ let check_leq univs u u' =
   if not (UGraph.check_leq univs u u') then raise NotConvertible
 
 let check_sort_cmp_universes env pb s0 s1 univs =
+  let open Sorts in
   match (s0,s1) with
     | (Prop c1, Prop c2) when is_cumul pb ->
       begin match c1, c2 with
@@ -643,84 +705,14 @@ let check_convert_instances ~flex u u' univs =
   else raise NotConvertible
 
 (* general conversion and inference functions *)
-let infer_check_conv_inductives
-    infer_check_convert_instances
-    infer_check_inductive_instances
-    cv_pb (mind, ind) u1 sv1 u2 sv2 univs =
-  match mind.Declarations.mind_universes with
-  | Declarations.Monomorphic_ind _ | Declarations.Polymorphic_ind _ ->
-    infer_check_convert_instances ~flex:false u1 u2 univs
-  | Declarations.Cumulative_ind cumi ->
-    let num_param_arity =
-      mind.Declarations.mind_nparams + mind.Declarations.mind_packets.(ind).Declarations.mind_nrealargs
-    in
-    if not (num_param_arity = sv1 && num_param_arity = sv2) then
-      infer_check_convert_instances ~flex:false u1 u2 univs
-    else
-      infer_check_inductive_instances cv_pb cumi u1 u2 univs
-
-let infer_check_conv_constructors
-    infer_check_convert_instances
-    infer_check_inductive_instances
-    (mind, ind, cns) u1 sv1 u2 sv2 univs =
-  match mind.Declarations.mind_universes with
-  | Declarations.Monomorphic_ind _ | Declarations.Polymorphic_ind _ ->
-    infer_check_convert_instances ~flex:false u1 u2 univs
-  | Declarations.Cumulative_ind cumi ->
-    let num_cnstr_args =
-      let nparamsctxt =
-        mind.Declarations.mind_nparams + mind.Declarations.mind_packets.(ind).Declarations.mind_nrealargs
-        (* Context.Rel.length mind.Declarations.mind_params_ctxt *) in
-      nparamsctxt + mind.Declarations.mind_packets.(ind).Declarations.mind_consnrealargs.(cns - 1)
-    in
-    if not (num_cnstr_args = sv1 && num_cnstr_args = sv2) then
-      infer_check_convert_instances ~flex:false u1 u2 univs
-    else
-      infer_check_inductive_instances CONV cumi u1 u2 univs
-
-let check_inductive_instances cv_pb cumi u u' univs =
-  let length_ind_instance = 
-    Univ.AUContext.size (Univ.ACumulativityInfo.univ_context cumi)
-  in
-  let ind_subtypctx = Univ.ACumulativityInfo.subtyp_context cumi in
-  if not ((length_ind_instance = Univ.Instance.length u) &&
-          (length_ind_instance = Univ.Instance.length u')) then
-     anomaly (Pp.str "Invalid inductive subtyping encountered!")
-  else
-    let comp_cst =
-      let comp_subst = (Univ.Instance.append u u') in
-      Univ.AUContext.instantiate comp_subst ind_subtypctx
-    in
-    let comp_cst =
-      match cv_pb with
-        CONV -> 
-        let comp_cst' = 
-          let comp_subst = (Univ.Instance.append u' u) in
-          Univ.AUContext.instantiate comp_subst ind_subtypctx
-        in
-        Univ.Constraint.union comp_cst comp_cst'
-      | CUMUL -> comp_cst
-    in
-    if (UGraph.check_constraints comp_cst univs) then univs
-    else raise NotConvertible
-
-let check_conv_inductives cv_pb ind u1 sv1 u2 sv2 univs =
-  infer_check_conv_inductives
-    check_convert_instances
-    check_inductive_instances
-    cv_pb ind u1 sv1 u2 sv2 univs
-
-let check_conv_constructors cns u1 sv1 u2 sv2 univs =
-  infer_check_conv_constructors
-    check_convert_instances
-    check_inductive_instances
-    cns u1 sv1 u2 sv2 univs
+let check_inductive_instances csts univs =
+  if (UGraph.check_constraints csts univs) then univs
+  else raise NotConvertible
 
 let checked_universes =
-  { compare = checked_sort_cmp_universes;
+  { compare_sorts = checked_sort_cmp_universes;
     compare_instances = check_convert_instances;
-    conv_inductives = check_conv_inductives;
-    conv_constructors = check_conv_constructors}
+    compare_cumul_instances = check_inductive_instances; }
 
 let infer_eq (univs, cstrs as cuniv) u u' =
   if UGraph.check_eq univs u u' then cuniv
@@ -734,6 +726,7 @@ let infer_leq (univs, cstrs as cuniv) u u' =
       univs, cstrs'
 
 let infer_cmp_universes env pb s0 s1 univs =
+  let open Sorts in
   match (s0,s1) with
     | (Prop c1, Prop c2) when is_cumul pb ->
       begin match c1, c2 with
@@ -762,49 +755,13 @@ let infer_convert_instances ~flex u u' (univs,cstrs) =
     else Univ.enforce_eq_instances u u' cstrs
   in (univs, cstrs')
 
-let infer_inductive_instances cv_pb cumi u u' (univs, cstrs) =
-  let length_ind_instance = 
-    Univ.AUContext.size (Univ.ACumulativityInfo.univ_context cumi)
-  in
-  let ind_subtypctx =  Univ.ACumulativityInfo.subtyp_context cumi in
-  if not ((length_ind_instance = Univ.Instance.length u) &&
-          (length_ind_instance = Univ.Instance.length u')) then
-    anomaly (Pp.str "Invalid inductive subtyping encountered!")
-  else
-    let comp_cst =
-      let comp_subst = (Univ.Instance.append u u') in
-      Univ.AUContext.instantiate comp_subst ind_subtypctx
-    in
-    let comp_cst =
-      match cv_pb with
-        CONV -> 
-        let comp_cst' = 
-          let comp_subst = (Univ.Instance.append u' u) in
-          Univ.AUContext.instantiate comp_subst ind_subtypctx
-        in
-        Univ.Constraint.union comp_cst comp_cst'
-      | CUMUL -> comp_cst
-    in
-    (univs, Univ.Constraint.union cstrs comp_cst)
-
-
-let infer_conv_inductives cv_pb ind u1 sv1 u2 sv2 univs =
-  infer_check_conv_inductives
-    infer_convert_instances
-    infer_inductive_instances
-    cv_pb ind u1 sv1 u2 sv2 univs
-
-let infer_conv_constructors cns u1 sv1 u2 sv2 univs =
-  infer_check_conv_constructors
-    infer_convert_instances
-    infer_inductive_instances
-    cns u1 sv1 u2 sv2 univs
-    
-let inferred_universes : (UGraph.t * Univ.Constraint.t) universe_compare = 
-  { compare = infer_cmp_universes;
+let infer_inductive_instances csts (univs,csts') =
+  (univs, Univ.Constraint.union csts csts')
+
+let inferred_universes : (UGraph.t * Univ.Constraint.t) universe_compare =
+  { compare_sorts = infer_cmp_universes;
     compare_instances = infer_convert_instances;
-    conv_inductives = infer_conv_inductives;
-    conv_constructors = infer_conv_constructors}
+    compare_cumul_instances = infer_inductive_instances; }
 
 let gen_conv cv_pb l2r reds env evars univs t1 t2 =
   let b = 
@@ -820,8 +777,8 @@ let gen_conv cv_pb l2r reds env evars univs t1 t2 =
 let gen_conv cv_pb ?(l2r=false) ?(reds=full_transparent_state) env ?(evars=(fun _->None), universes env) =
   let evars, univs = evars in
   if Flags.profile then
-    let fconv_universes_key = Profile.declare_profile "trans_fconv_universes" in
-      Profile.profile8 fconv_universes_key gen_conv cv_pb l2r reds env evars univs
+    let fconv_universes_key = CProfile.declare_profile "trans_fconv_universes" in
+      CProfile.profile8 fconv_universes_key gen_conv cv_pb l2r reds env evars univs
   else gen_conv cv_pb l2r reds env evars univs
 
 let conv = gen_conv CONV
@@ -847,8 +804,8 @@ let infer_conv_universes cv_pb l2r evars reds env univs t1 t2 =
 (* Profiling *)
 let infer_conv_universes = 
   if Flags.profile then 
-    let infer_conv_universes_key = Profile.declare_profile "infer_conv_universes" in
-      Profile.profile8 infer_conv_universes_key infer_conv_universes
+    let infer_conv_universes_key = CProfile.declare_profile "infer_conv_universes" in
+      CProfile.profile8 infer_conv_universes_key infer_conv_universes
   else infer_conv_universes
 
 let infer_conv ?(l2r=false) ?(evars=fun _ -> None) ?(ts=full_transparent_state)
@@ -869,7 +826,7 @@ let warn_bytecode_compiler_failed =
          (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 set_vm_conv (f:conv_pb -> types kernel_conversion_function) = vm_conv := f
 let vm_conv cv_pb env t1 t2 =
   try
     !vm_conv cv_pb env t1 t2
@@ -882,22 +839,22 @@ let default_conv cv_pb ?(l2r=false) env t1 t2 =
 
 let default_conv_leq = default_conv CUMUL
 (*
-let convleqkey = Profile.declare_profile "Kernel_reduction.conv_leq";;
+let convleqkey = CProfile.declare_profile "Kernel_reduction.conv_leq";;
 let conv_leq env t1 t2 =
-  Profile.profile4 convleqkey conv_leq env t1 t2;;
+  CProfile.profile4 convleqkey conv_leq env t1 t2;;
 
-let convkey = Profile.declare_profile "Kernel_reduction.conv";;
+let convkey = CProfile.declare_profile "Kernel_reduction.conv";;
 let conv env t1 t2 =
-  Profile.profile4 convleqkey conv env t1 t2;;
+  CProfile.profile4 convleqkey conv env t1 t2;;
 *)
 
 (* Application with on-the-fly reduction *)
 
 let beta_applist c l =
   let rec app subst c l =
-    match kind_of_term c, l with
+    match kind c, l with
     | Lambda(_,_,c), arg::l -> app (arg::subst) c l
-    | _ -> applist (substl subst c, l) in
+    | _ -> Term.applist (substl subst c, l) in
   app [] c l
 
 let beta_appvect c v = beta_applist c (Array.to_list v)
@@ -905,7 +862,7 @@ let beta_appvect c v = beta_applist c (Array.to_list v)
 let beta_app c a = beta_applist c [a]
 
 (* Compatibility *)
-let betazeta_appvect = lambda_appvect_assum
+let betazeta_appvect = Term.lambda_appvect_assum
 
 (********************************************************************)
 (*             Special-Purpose Reduction                            *)
@@ -918,19 +875,31 @@ let betazeta_appvect = lambda_appvect_assum
  * error message. *)
 
 let hnf_prod_app env t n =
-  match kind_of_term (whd_all env t) with
+  match kind (whd_all env t) with
     | Prod (_,_,b) -> subst1 n b
     | _ -> anomaly ~label:"hnf_prod_app" (Pp.str "Need a product.")
 
 let hnf_prod_applist env t nl =
   List.fold_left (hnf_prod_app env) t nl
 
+let hnf_prod_applist_assum env n c l =
+  let rec app n subst t l =
+    if Int.equal n 0 then
+      if l == [] then substl subst t
+      else anomaly (Pp.str "Too many arguments.")
+    else match kind (whd_allnolet env t), l with
+    | Prod(_,_,c), arg::l -> app (n-1) (arg::subst) c l
+    | LetIn(_,b,_,c), _ -> app (n-1) (substl subst b::subst) c l
+    | _, [] -> anomaly (Pp.str "Not enough arguments.")
+    | _ -> anomaly (Pp.str "Not enough prod/let's.") in
+  app n [] c l
+
 (* Dealing with arities *)
 
 let dest_prod env =
   let rec decrec env m c =
     let t = whd_all env c in
-    match kind_of_term t with
+    match kind t with
       | Prod (n,a,c0) ->
 	  let d = LocalAssum (n,a) in
 	  decrec (push_rel d env) (Context.Rel.add d m) c0
@@ -942,17 +911,16 @@ let dest_prod env =
 let dest_prod_assum env =
   let rec prodec_rec env l ty =
     let rty = whd_allnolet env ty in
-    match kind_of_term rty with
+    match kind rty with
     | Prod (x,t,c)  ->
         let d = LocalAssum (x,t) in
 	prodec_rec (push_rel d env) (Context.Rel.add d l) c
     | LetIn (x,b,t,c) ->
         let d = LocalDef (x,b,t) in
 	prodec_rec (push_rel d env) (Context.Rel.add d l) c
-    | Cast (c,_,_)    -> prodec_rec env l c
     | _               ->
       let rty' = whd_all env rty in
-	if Term.eq_constr rty' rty then l, rty
+	if Constr.equal rty' rty then l, rty
 	else prodec_rec env l rty'
   in
   prodec_rec env Context.Rel.empty
@@ -960,14 +928,13 @@ let dest_prod_assum env =
 let dest_lam_assum env =
   let rec lamec_rec env l ty =
     let rty = whd_allnolet env ty in
-    match kind_of_term rty with
+    match kind rty with
     | Lambda (x,t,c)  ->
         let d = LocalAssum (x,t) in
 	lamec_rec (push_rel d env) (Context.Rel.add d l) c
     | LetIn (x,b,t,c) ->
         let d = LocalDef (x,b,t) in
 	lamec_rec (push_rel d env) (Context.Rel.add d l) c
-    | Cast (c,_,_)    -> lamec_rec env l c
     | _               -> l,rty
   in
   lamec_rec env Context.Rel.empty
@@ -976,7 +943,7 @@ exception NotArity
 
 let dest_arity env c =
   let l, c = dest_prod_assum env c in
-  match kind_of_term c with
+  match kind c with
     | Sort s -> l,s
     | _ -> raise NotArity
 
diff --git a/kernel/reduction.mli b/kernel/reduction.mli
index 253c0874f..6f7e3f8f8 100644
--- a/kernel/reduction.mli
+++ b/kernel/reduction.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Term
+open Constr
 open Environ
 
 (***********************************************************************
@@ -35,23 +35,25 @@ type 'a extended_conversion_function =
 
 type conv_pb = CONV | CUMUL
 
-type 'a universe_compare = 
+type 'a universe_compare =
   { (* Might raise NotConvertible *)
-    compare : env -> conv_pb -> sorts -> sorts -> 'a -> 'a;
+    compare_sorts : env -> conv_pb -> Sorts.t -> Sorts.t -> 'a -> 'a;
     compare_instances: flex:bool -> Univ.Instance.t -> Univ.Instance.t -> 'a -> 'a;
-    conv_inductives : conv_pb -> (Declarations.mutual_inductive_body * int) -> Univ.Instance.t -> int ->
-      Univ.Instance.t -> int -> 'a -> 'a;
-    conv_constructors : (Declarations.mutual_inductive_body * int * int) ->
-      Univ.Instance.t -> int -> Univ.Instance.t -> int -> 'a -> 'a;
-  } 
+    compare_cumul_instances : Univ.Constraint.t -> 'a -> 'a }
 
 type 'a universe_state = 'a * 'a universe_compare
 
 type ('a,'b) generic_conversion_function = env -> 'b universe_state -> 'a -> 'a -> 'b
 
-type 'a infer_conversion_function = env -> UGraph.t -> 'a -> 'a -> Univ.constraints
+type 'a infer_conversion_function = env -> UGraph.t -> 'a -> 'a -> Univ.Constraint.t
 
-val sort_cmp_universes : env -> conv_pb -> sorts -> sorts ->
+val get_cumulativity_constraints : conv_pb -> Univ.ACumulativityInfo.t ->
+  Univ.Instance.t -> Univ.Instance.t -> Univ.Constraint.t
+
+val inductive_cumulativity_arguments : (Declarations.mutual_inductive_body * int) -> int
+val constructor_cumulativity_arguments : (Declarations.mutual_inductive_body * int * int) -> int
+
+val sort_cmp_universes : env -> conv_pb -> Sorts.t -> Sorts.t ->
   'a * 'a universe_compare -> 'a * 'a universe_compare
 
 (* [flex] should be true for constants, false for inductive types and
@@ -103,6 +105,12 @@ val beta_app : constr -> constr -> constr
 (** Pseudo-reduction rule  Prod(x,A,B) a --> B[x\a] *)
 val hnf_prod_applist : env -> types -> constr list -> types
 
+(** In [hnf_prod_applist_assum n c args], [c] is supposed to (whd-)reduce to
+    the form [∀Γ.t] with [Γ] of length [n] and possibly with let-ins; it
+    returns [t] with the assumptions of [Γ] instantiated by [args] and
+    the local definitions of [Γ] expanded. *)
+val hnf_prod_applist_assum : env -> int -> types -> constr list -> types
+
 (** Compatibility alias for Term.lambda_appvect_assum *)
 val betazeta_appvect : int -> constr -> constr array -> constr
 
@@ -115,7 +123,7 @@ val dest_lam_assum  : env -> types -> Context.Rel.t * types
 
 exception NotArity
 
-val dest_arity : env -> types -> arity (* raises NotArity if not an arity *)
+val dest_arity : env -> types -> Term.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/retroknowledge.ml b/kernel/retroknowledge.ml
index 5fbd914f3..24d022d69 100644
--- a/kernel/retroknowledge.ml
+++ b/kernel/retroknowledge.ml
@@ -14,7 +14,7 @@
    for evaluation in the bytecode virtual machine *)
 
 open Names
-open Term
+open Constr
 
 (* The retroknowledge defines a bijective correspondance between some
    [entry]-s (which are, in fact, merely terms) and [field]-s which
@@ -102,22 +102,20 @@ module Reactive = Map.Make (EntryOrd)
 type reactive_info = {(*information required by the compiler of the VM *)
   vm_compiling :
       (*fastcomputation flag -> continuation -> result *)
-      (bool->Cbytecodes.comp_env->constr array ->
-       int->Cbytecodes.bytecodes->Cbytecodes.bytecodes)
+      (bool -> Cinstr.lambda array -> Cinstr.lambda)
       option;
   vm_constant_static :
       (*fastcomputation flag -> constructor -> args -> result*)
-      (bool->constr array->Cbytecodes.structured_constant)
+      (bool -> constr array -> Cinstr.lambda)
       option;
   vm_constant_dynamic :
       (*fastcomputation flag -> constructor -> reloc -> args -> sz -> cont -> result *)
-      (bool->Cbytecodes.comp_env->Cbytecodes.block array->int->
-         Cbytecodes.bytecodes->Cbytecodes.bytecodes)
+      (bool -> Cinstr.lambda array -> Cinstr.lambda)
       option;
   (* fastcomputation flag -> cont -> result *)
-  vm_before_match : (bool -> Cbytecodes.bytecodes -> Cbytecodes.bytecodes) option;
+  vm_before_match : (bool -> Cinstr.lambda -> Cinstr.lambda) option;
   (* tag (= compiled int for instance) -> result *)
-  vm_decompile_const : (int -> Term.constr) option;
+  vm_decompile_const : (int -> constr) option;
 
   native_compiling :
       (bool -> Nativeinstr.prefix -> Nativeinstr.lambda array ->
diff --git a/kernel/retroknowledge.mli b/kernel/retroknowledge.mli
index 18a12a4ef..134b4b4f7 100644
--- a/kernel/retroknowledge.mli
+++ b/kernel/retroknowledge.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 
 type retroknowledge
 
@@ -82,9 +82,8 @@ val initial_retroknowledge : retroknowledge
    and the continuation cont of the bytecode compilation
    returns the compilation of id in cont if it has a specific treatment
    or raises Not_found if id should be compiled as usual *)
-val get_vm_compiling_info  : retroknowledge -> entry -> Cbytecodes.comp_env ->
-                             constr array ->
-                             int -> Cbytecodes.bytecodes-> Cbytecodes.bytecodes
+val get_vm_compiling_info  : retroknowledge -> entry ->
+                             Cinstr.lambda array -> Cinstr.lambda
 (*Given an identifier id (usually Construct _)
    and its argument array, returns a function that tries an ad-hoc optimisated
    compilation (in the case of the 31-bit integers it means compiling them
@@ -93,8 +92,7 @@ val get_vm_compiling_info  : retroknowledge -> entry -> Cbytecodes.comp_env ->
    CBytecodes.NotClosed if the term is not a closed constructor pattern
    (a constant for the compiler) *)
 val get_vm_constant_static_info : retroknowledge -> entry ->
-                                   constr array ->
-                                   Cbytecodes.structured_constant
+                                   constr array -> Cinstr.lambda
 
 (*Given an identifier id (usually Construct _ )
    its argument array and a continuation, returns the compiled version
@@ -102,22 +100,20 @@ val get_vm_constant_static_info : retroknowledge -> entry ->
    31-bit integers, that would be the dynamic compilation into integers)
    or raises Not_found if id should be compiled as usual *)
 val get_vm_constant_dynamic_info : retroknowledge -> entry ->
-                                Cbytecodes.comp_env ->
-                                Cbytecodes.block array ->
-                                int -> Cbytecodes.bytecodes -> Cbytecodes.bytecodes
+                                   Cinstr.lambda array -> Cinstr.lambda
 
 (** Given a type identifier, this function is used before compiling a match
    over this type. In the case of 31-bit integers for instance, it is used
    to add the instruction sequence which would perform a dynamic decompilation
    in case the argument of the match is not in coq representation *)
-val get_vm_before_match_info : retroknowledge -> entry -> Cbytecodes.bytecodes
-                                                       -> Cbytecodes.bytecodes
+val get_vm_before_match_info : retroknowledge -> entry -> Cinstr.lambda
+                                                       -> Cinstr.lambda
 
 (** Given a type identifier, this function is used by pretyping/vnorm.ml to
    recover the elements of that type from their compiled form if it's non
    standard (it is used (and can be used) only when the compiled form
    is not a block *)
-val get_vm_decompile_constant_info : retroknowledge -> entry -> int -> Term.constr
+val get_vm_decompile_constant_info : retroknowledge -> entry -> int -> constr
 
 
 val get_native_compiling_info  : retroknowledge -> entry -> Nativeinstr.prefix ->
@@ -148,22 +144,20 @@ val find : retroknowledge -> field -> entry
 type reactive_info = {(*information required by the compiler of the VM *)
   vm_compiling :
       (*fastcomputation flag -> continuation -> result *)
-      (bool->Cbytecodes.comp_env->constr array ->
-       int->Cbytecodes.bytecodes->Cbytecodes.bytecodes)
+      (bool -> Cinstr.lambda array -> Cinstr.lambda)
       option;
   vm_constant_static :
       (*fastcomputation flag -> constructor -> args -> result*)
-      (bool->constr array->Cbytecodes.structured_constant)
+      (bool -> constr array -> Cinstr.lambda)
       option;
   vm_constant_dynamic :
       (*fastcomputation flag -> constructor -> reloc -> args -> sz -> cont -> result *)
-      (bool->Cbytecodes.comp_env->Cbytecodes.block array->int->
-         Cbytecodes.bytecodes->Cbytecodes.bytecodes)
+      (bool -> Cinstr.lambda array -> Cinstr.lambda)
       option;
   (* fastcomputation flag -> cont -> result *)
-  vm_before_match : (bool -> Cbytecodes.bytecodes -> Cbytecodes.bytecodes) option;
+  vm_before_match : (bool -> Cinstr.lambda -> Cinstr.lambda) option;
   (* tag (= compiled int for instance) -> result *)
-  vm_decompile_const : (int -> Term.constr) option;
+  vm_decompile_const : (int -> constr) option;
 
   native_compiling :
       (bool -> Nativeinstr.prefix -> Nativeinstr.lambda array ->
diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml
index 04051f2e2..93b8e278f 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -114,7 +114,7 @@ module DPMap = Map.Make(DirPath)
 
 type safe_environment =
   { env : Environ.env;
-    modpath : module_path;
+    modpath : ModPath.t;
     modvariant : modvariant;
     modresolver : Mod_subst.delta_resolver;
     paramresolver : Mod_subst.delta_resolver;
@@ -125,7 +125,7 @@ type safe_environment =
     future_cst : Univ.ContextSet.t Future.computation list;
     engagement : engagement option;
     required : vodigest DPMap.t;
-    loads : (module_path * module_body) list;
+    loads : (ModPath.t * module_body) list;
     local_retroknowledge : Retroknowledge.action list;
     native_symbols : Nativecode.symbols DPMap.t }
 
@@ -143,7 +143,7 @@ let rec library_dp_of_senv senv =
 
 let empty_environment =
   { env = Environ.empty_env;
-    modpath = initial_path;
+    modpath = ModPath.initial;
     modvariant = NONE;
     modresolver = Mod_subst.empty_delta_resolver;
     paramresolver = Mod_subst.empty_delta_resolver;
@@ -160,7 +160,7 @@ let empty_environment =
 
 let is_initial senv =
   match senv.revstruct, senv.modvariant with
-  | [], NONE -> ModPath.equal senv.modpath initial_path
+  | [], NONE -> ModPath.equal senv.modpath ModPath.initial
   | _ -> false
 
 let delta_of_senv senv = senv.modresolver,senv.paramresolver
@@ -249,14 +249,14 @@ let universes_of_private eff =
               in
               match cb.const_universes with
               | Monomorphic_const ctx ->
-                (Univ.ContextSet.of_context ctx) :: acc
+                ctx :: acc
               | Polymorphic_const _ -> acc
            )
            acc l
        | Entries.SEsubproof (c, cb, e) ->
          match cb.const_universes with
               | Monomorphic_const ctx ->
-                (Univ.ContextSet.of_context ctx) :: acc
+                ctx :: acc
               | Polymorphic_const _ -> acc
     )
     [] (Term_typing.uniq_seff eff)
@@ -382,24 +382,9 @@ let safe_push_named d env =
 
 
 let push_named_def (id,de) senv =
-  let open Entries in
-  let trust = Term_typing.SideEffects senv.revstruct in
-  let c,typ,univs = Term_typing.translate_local_def trust senv.env id de in
-  let poly = match de.Entries.const_entry_universes with
-  | Monomorphic_const_entry _ -> false
-  | Polymorphic_const_entry _ -> true
-  in
-  let univs = Univ.ContextSet.of_context univs in
-  let c, univs = match c with
-    | Def c -> Mod_subst.force_constr c, univs
-    | OpaqueDef o ->
-        Opaqueproof.force_proof (Environ.opaque_tables senv.env) o,
-        Univ.ContextSet.union univs 
-	(Opaqueproof.force_constraints (Environ.opaque_tables senv.env) o)
-    | _ -> assert false in
-  let senv' = push_context_set poly univs senv in
-  let env'' = safe_push_named (LocalDef (id,c,typ)) senv'.env in
-    univs, {senv' with env=env''}
+  let c, typ = Term_typing.translate_local_def senv.env id de in
+  let env'' = safe_push_named (LocalDef (id, c, typ)) senv.env in
+  { senv with env = env'' }
 
 let push_named_assum ((id,t,poly),ctx) senv =
   let senv' = push_context_set poly ctx senv in
@@ -425,9 +410,8 @@ let labels_of_mib mib =
 
 let globalize_constant_universes env cb =
   match cb.const_universes with
-  | Monomorphic_const ctx ->
-    let cstrs = Univ.ContextSet.of_context ctx in
-    Now (false, cstrs) ::  
+  | Monomorphic_const cstrs ->
+    Now (false, cstrs) ::
     (match cb.const_body with
      | (Undef _ | Def _) -> []
      | OpaqueDef lc ->
@@ -443,7 +427,7 @@ let globalize_constant_universes env cb =
 let globalize_mind_universes mb =
   match mb.mind_universes with
   | Monomorphic_ind ctx ->
-    [Now (false, Univ.ContextSet.of_context ctx)]
+    [Now (false, ctx)]
   | Polymorphic_ind _ -> [Now (true, Univ.ContextSet.empty)]
   | Cumulative_ind _ -> [Now (true, Univ.ContextSet.empty)]
 
@@ -458,8 +442,8 @@ let constraints_of_sfb env sfb =
     It also performs the corresponding [add_constraints]. *)
 
 type generic_name =
-  | C of constant
-  | I of mutual_inductive
+  | C of Constant.t
+  | I of MutInd.t
   | M (** name already known, cf the mod_mp field *)
   | MT (** name already known, cf the mod_mp field *)
 
@@ -502,7 +486,7 @@ type global_declaration =
   | GlobalRecipe of Cooking.recipe
 
 type exported_private_constant = 
-  constant * private_constant_role
+  Constant.t * private_constant_role
 
 let add_constant_aux no_section senv (kn, cb) =
   let l = pi3 (Constant.repr3 kn) in
@@ -521,7 +505,7 @@ let add_constant_aux no_section senv (kn, cb) =
   let senv'' = match cb.const_body with
     | Undef (Some lev) ->
       update_resolver
-        (Mod_subst.add_inline_delta_resolver (user_con kn) (lev,None)) senv'
+        (Mod_subst.add_inline_delta_resolver (Constant.user kn) (lev,None)) senv'
     | _ -> senv'
   in
   senv''
@@ -535,7 +519,7 @@ let export_private_constants ~in_section ce senv =
   (ce, exported), senv
 
 let add_constant dir l decl senv =
-  let kn = make_con senv.modpath dir l in
+  let kn = Constant.make3 senv.modpath dir l in
   let no_section = DirPath.is_empty dir in
   let senv =
     let cb = 
@@ -562,7 +546,7 @@ let check_mind mie lab =
 
 let add_mind dir l mie senv =
   let () = check_mind mie l in
-  let kn = make_mind senv.modpath dir l in
+  let kn = MutInd.make3 senv.modpath dir l in
   let mib = Term_typing.translate_mind senv.env kn mie in
   let mib =
     match mib.mind_hyps with [] -> Declareops.hcons_mind mib | _ -> mib
@@ -574,7 +558,7 @@ let add_mind dir l mie senv =
 let add_modtype l params_mte inl senv =
   let mp = MPdot(senv.modpath, l) in
   let mtb = Mod_typing.translate_modtype senv.env mp inl params_mte  in
-  let mtb = Declareops.hcons_module_body mtb in
+  let mtb = Declareops.hcons_module_type mtb in
   let senv' = add_field (l,SFBmodtype mtb) MT senv in
   mp, senv'
 
@@ -677,18 +661,21 @@ let build_module_body params restype senv =
       (struc,None,senv.modresolver,senv.univ) restype'
   in
   let mb' = functorize_module params mb in
-  { mb' with mod_retroknowledge = senv.local_retroknowledge }
+  { mb' with mod_retroknowledge = ModBodyRK senv.local_retroknowledge }
 
 (** Returning back to the old pre-interactive-module environment,
     with one extra component and some updated fields
     (constraints, required, etc) *)
 
+let allow_delayed_constants = ref false
+
 let propagate_senv newdef newenv newresolver senv oldsenv =
   let now_cst, later_cst = List.partition Future.is_val senv.future_cst in
   (* This asserts that after Paral-ITP, standard vo compilation is behaving
    * exctly as before: the same universe constraints are added to modules *)
-  if !Flags.compilation_mode = Flags.BuildVo &&
-     !Flags.async_proofs_mode = Flags.APoff then assert(later_cst = []);
+  if not !allow_delayed_constants && later_cst <> [] then
+    CErrors.anomaly ~label:"safe_typing"
+      Pp.(str "True Future.t were created for opaque constants even if -async-proofs is off");
   { oldsenv with
     env = newenv;
     modresolver = newresolver;
@@ -732,12 +719,12 @@ let end_module l restype senv =
 
 let build_mtb mp sign cst delta =
   { mod_mp = mp;
-    mod_expr = Abstract;
+    mod_expr = ();
     mod_type = sign;
     mod_type_alg = None;
     mod_constraints = cst;
     mod_delta = delta;
-    mod_retroknowledge = [] }
+    mod_retroknowledge = ModTypeRK }
 
 let end_modtype l senv =
   let mp = senv.modpath in
@@ -853,11 +840,11 @@ let export ?except senv dir =
       mod_type_alg = None;
       mod_constraints = senv.univ;
       mod_delta = senv.modresolver;
-      mod_retroknowledge = senv.local_retroknowledge
+      mod_retroknowledge = ModBodyRK senv.local_retroknowledge
     }
   in
   let ast, symbols =
-    if !Flags.native_compiler then
+    if !Flags.output_native_objects then
       Nativelibrary.dump_library mp dir senv.env str
     else [], Nativecode.empty_symbols
   in
diff --git a/kernel/safe_typing.mli b/kernel/safe_typing.mli
index 752fdd793..757b803a3 100644
--- a/kernel/safe_typing.mli
+++ b/kernel/safe_typing.mli
@@ -60,8 +60,8 @@ val concat_private : private_constants -> private_constants -> private_constants
 (** [concat_private e1 e2] adds the constants of [e1] to [e2], i.e. constants in
     [e1] must be more recent than those of [e2]. *)
 
-val private_con_of_con : safe_environment -> constant -> private_constant
-val private_con_of_scheme : kind:string -> safe_environment -> (inductive * constant) list -> private_constant
+val private_con_of_con : safe_environment -> Constant.t -> private_constant
+val private_con_of_scheme : kind:string -> safe_environment -> (inductive * Constant.t) list -> private_constant
 
 val mk_pure_proof : Constr.constr -> private_constants Entries.proof_output
 val inline_private_constants_in_constr :
@@ -69,7 +69,7 @@ val inline_private_constants_in_constr :
 val inline_private_constants_in_definition_entry :
   Environ.env -> private_constants Entries.definition_entry -> unit Entries.definition_entry
 
-val universes_of_private : private_constants -> Univ.universe_context_set list
+val universes_of_private : private_constants -> Univ.ContextSet.t list
 
 val is_curmod_library : safe_environment -> bool
 
@@ -84,13 +84,13 @@ val is_joined_environment : safe_environment -> bool
 (** Insertion of local declarations (Local or Variables) *)
 
 val push_named_assum :
-  (Id.t * Term.types * bool (* polymorphic *))
+  (Id.t * Constr.types * bool (* polymorphic *))
     Univ.in_universe_context_set -> safe_transformer0
 
 (** Returns the full universe context necessary to typecheck the definition
   (futures are forced) *)
 val push_named_def :
-  Id.t * private_constants Entries.definition_entry -> Univ.universe_context_set safe_transformer
+  Id.t * Entries.section_def_entry -> safe_transformer0
 
 (** Insertion of global axioms or definitions *)
 
@@ -103,43 +103,43 @@ type global_declaration =
   | GlobalRecipe of Cooking.recipe
 
 type exported_private_constant = 
-  constant * private_constant_role
+  Constant.t * private_constant_role
 
 val export_private_constants : in_section:bool ->
-  private_constants Entries.constant_entry ->
-  (unit Entries.constant_entry * exported_private_constant list) safe_transformer
+  private_constants Entries.definition_entry ->
+  (unit Entries.definition_entry * exported_private_constant list) safe_transformer
 
 (** returns the main constant plus a list of auxiliary constants (empty
     unless one requires the side effects to be exported) *)
 val add_constant :
   DirPath.t -> Label.t -> global_declaration ->
-    constant safe_transformer
+    Constant.t safe_transformer
 
 (** Adding an inductive type *)
 
 val add_mind :
   DirPath.t -> Label.t -> Entries.mutual_inductive_entry ->
-    mutual_inductive safe_transformer
+    MutInd.t safe_transformer
 
 (** Adding a module or a module type *)
 
 val add_module :
   Label.t -> Entries.module_entry -> Declarations.inline ->
-    (module_path * Mod_subst.delta_resolver) safe_transformer
+    (ModPath.t * Mod_subst.delta_resolver) safe_transformer
 val add_modtype :
   Label.t -> Entries.module_type_entry -> Declarations.inline ->
-    module_path safe_transformer
+    ModPath.t safe_transformer
 
 (** Adding universe constraints *)
 
 val push_context_set :
-  bool -> Univ.universe_context_set -> safe_transformer0
+  bool -> Univ.ContextSet.t -> safe_transformer0
 
 val push_context :
-  bool -> Univ.universe_context -> safe_transformer0
+  bool -> Univ.UContext.t -> safe_transformer0
 
 val add_constraints :
-  Univ.constraints -> safe_transformer0
+  Univ.Constraint.t -> safe_transformer0
 
 (* (\** Generator of universes *\) *)
 (* val next_universe : int safe_transformer *)
@@ -150,29 +150,33 @@ val set_typing_flags : Declarations.typing_flags -> safe_transformer0
 
 (** {6 Interactive module functions } *)
 
-val start_module : Label.t -> module_path safe_transformer
+val start_module : Label.t -> ModPath.t safe_transformer
 
-val start_modtype : Label.t -> module_path safe_transformer
+val start_modtype : Label.t -> ModPath.t safe_transformer
 
 val add_module_parameter :
   MBId.t -> Entries.module_struct_entry -> Declarations.inline ->
     Mod_subst.delta_resolver safe_transformer
 
+(** Traditional mode: check at end of module that no future was
+    created. *)
+val allow_delayed_constants : bool ref
+
 (** The optional result type is given without its functorial part *)
 
 val end_module :
   Label.t -> (Entries.module_struct_entry * Declarations.inline) option ->
-    (module_path * MBId.t list * Mod_subst.delta_resolver) safe_transformer
+    (ModPath.t * MBId.t list * Mod_subst.delta_resolver) safe_transformer
 
-val end_modtype : Label.t -> (module_path * MBId.t list) safe_transformer
+val end_modtype : Label.t -> (ModPath.t * MBId.t list) safe_transformer
 
 val add_include :
   Entries.module_struct_entry -> bool -> Declarations.inline ->
    Mod_subst.delta_resolver safe_transformer
 
-val current_modpath : safe_environment -> module_path
+val current_modpath : safe_environment -> ModPath.t
 
-val current_dirpath : safe_environment -> dir_path
+val current_dirpath : safe_environment -> DirPath.t
 
 (** {6 Libraries : loading and saving compilation units } *)
 
@@ -182,26 +186,26 @@ type native_library = Nativecode.global list
 
 val get_library_native_symbols : safe_environment -> DirPath.t -> Nativecode.symbols
 
-val start_library : DirPath.t -> module_path safe_transformer
+val start_library : DirPath.t -> ModPath.t safe_transformer
 
 val export :
   ?except:Future.UUIDSet.t ->
   safe_environment -> DirPath.t ->
-    module_path * compiled_library * native_library
+    ModPath.t * compiled_library * native_library
 
 (* Constraints are non empty iff the file is a vi2vo *)
-val import : compiled_library -> Univ.universe_context_set -> vodigest ->
-  module_path safe_transformer
+val import : compiled_library -> Univ.ContextSet.t -> vodigest ->
+  ModPath.t safe_transformer
 
 (** {6 Safe typing judgments } *)
 
 type judgment
 
-val j_val : judgment -> Term.constr
-val j_type : judgment -> Term.constr
+val j_val : judgment -> Constr.constr
+val j_type : judgment -> Constr.constr
 
 (** The safe typing of a term returns a typing judgment. *)
-val typing : safe_environment -> Term.constr -> judgment
+val typing : safe_environment -> Constr.constr -> judgment
 
 (** {6 Queries } *)
 
@@ -217,9 +221,9 @@ open Retroknowledge
 val retroknowledge : (retroknowledge-> 'a) -> safe_environment -> 'a
 
 val register :
-  field -> Retroknowledge.entry -> Term.constr -> safe_transformer0
+  field -> Retroknowledge.entry -> Constr.constr -> safe_transformer0
 
-val register_inline : constant -> safe_transformer0
+val register_inline : Constant.t -> safe_transformer0
 
 val set_strategy :
-  safe_environment -> Names.constant Names.tableKey -> Conv_oracle.level -> safe_environment
+  safe_environment -> Names.Constant.t Names.tableKey -> Conv_oracle.level -> safe_environment
diff --git a/kernel/sorts.ml b/kernel/sorts.ml
index cf5207e8d..07688840d 100644
--- a/kernel/sorts.ml
+++ b/kernel/sorts.ml
@@ -14,7 +14,7 @@ type family = InProp | InSet | InType
 
 type t =
   | Prop of contents                      (* proposition types *)
-  | Type of universe
+  | Type of Universe.t
 
 let prop = Prop Null
 let set = Prop Pos
@@ -91,7 +91,7 @@ module Hsorts =
     struct
       type _t = t
       type t = _t
-      type u = universe -> universe
+      type u = Universe.t -> Universe.t
 
       let hashcons huniv = function
         | Type u as c -> 
diff --git a/kernel/sorts.mli b/kernel/sorts.mli
index 3426d6fd3..65ea75138 100644
--- a/kernel/sorts.mli
+++ b/kernel/sorts.mli
@@ -14,7 +14,7 @@ type family = InProp | InSet | InType
 
 type t =
 | Prop of contents       (** Prop and Set *)
-| Type of Univ.universe  (** Type *)
+| Type of Univ.Universe.t  (** Type *)
 
 val set  : t
 val prop : t
@@ -38,5 +38,5 @@ module List : sig
   val intersect : family list -> family list -> family list
 end
 
-val univ_of_sort : t -> Univ.universe
-val sort_of_univ : Univ.universe -> t
+val univ_of_sort : t -> Univ.Universe.t
+val sort_of_univ : Univ.Universe.t -> t
diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml
index b311165f1..e95d5d2b5 100644
--- a/kernel/subtyping.ml
+++ b/kernel/subtyping.ml
@@ -12,10 +12,11 @@
 (* This module checks subtyping of module types *)
 
 (*i*)
-open Util
 open Names
 open Univ
+open Util
 open Term
+open Constr
 open Declarations
 open Declareops
 open Reduction
@@ -63,11 +64,11 @@ let empty_labmap = { objs = Label.Map.empty; mods = Label.Map.empty }
 
 let get_obj mp map l =
   try Label.Map.find l map.objs
-  with Not_found -> error_no_such_label_sub l (string_of_mp mp)
+  with Not_found -> error_no_such_label_sub l (ModPath.to_string mp)
 
 let get_mod mp map l =
   try Label.Map.find l map.mods
-  with Not_found -> error_no_such_label_sub l (string_of_mp mp)
+  with Not_found -> error_no_such_label_sub l (ModPath.to_string mp)
 
 let make_labmap mp list =
   let add_one (l,e) map =
@@ -77,7 +78,7 @@ let make_labmap mp list =
     | SFBmodule mb -> { map with mods = Label.Map.add l (Module mb) map.mods }
     | SFBmodtype mtb -> { map with mods = Label.Map.add l (Modtype mtb) map.mods }
   in
-  List.fold_right add_one list empty_labmap
+  CList.fold_right add_one list empty_labmap
 
 
 let check_conv_error error why cst poly f env a1 a2 =
@@ -117,6 +118,15 @@ let check_inductive cst env mp1 l info1 mp2 mib2 spec2 subst1 subst2 reso1 reso2
       let env = check_polymorphic_instance error env auctx auctx' in
       env, Univ.make_abstract_instance auctx'
     | Cumulative_ind cumi, Cumulative_ind cumi' ->
+      (** Currently there is no way to control variance of inductive types, but
+          just in case we require that they are in a subtyping relation. *)
+      let () =
+        let v = ACumulativityInfo.variance cumi in
+        let v' = ACumulativityInfo.variance cumi' in
+        if not (Array.for_all2 Variance.check_subtype v' v) then
+          CErrors.anomaly Pp.(str "Variance of " ++ KerName.print kn1 ++
+            str " is not compatible with the one of " ++ KerName.print kn2)
+      in
       let auctx = Univ.ACumulativityInfo.univ_context cumi in
       let auctx' = Univ.ACumulativityInfo.univ_context cumi' in
       let env = check_polymorphic_instance error env auctx auctx' in
@@ -153,7 +163,7 @@ let check_inductive cst env mp1 l info1 mp2 mib2 spec2 subst1 subst2 reso1 reso2
     let (ctx2,s2) = dest_arity env t2 in
     let s1,s2 =
       match s1, s2 with
-      | Type _, Type _ -> (* shortcut here *) prop_sort, prop_sort
+      | Type _, Type _ -> (* shortcut here *) Sorts.prop, Sorts.prop
       | (Prop _, Type _) | (Type _,Prop _) ->
 	error (NotConvertibleInductiveField name)
       | _ -> (s1, s2) in
@@ -181,7 +191,7 @@ let check_inductive cst env mp1 l info1 mp2 mib2 spec2 subst1 subst2 reso1 reso2
       let cst = check_inductive_type cst p2.mind_typename ty1 ty2 in
 	cst
   in
-  let mind = mind_of_kn kn1 in
+  let mind = MutInd.make1 kn1 in
   let check_cons_types i cst p1 p2 =
     Array.fold_left3
       (fun cst id t1 t2 -> check_conv (NotConvertibleConstructorField id) cst
@@ -192,7 +202,7 @@ let check_inductive cst env mp1 l info1 mp2 mib2 spec2 subst1 subst2 reso1 reso2
       (arities_of_specif (mind, inst) (mib2, p2))
   in
   let check f test why = if not (test (f mib1) (f mib2)) then error (why (f mib2)) in
-  check (fun mib -> mib.mind_finite<>Decl_kinds.CoFinite) (==) (fun x -> FiniteInductiveFieldExpected x);
+  check (fun mib -> mib.mind_finite<>CoFinite) (==) (fun x -> FiniteInductiveFieldExpected x);
   check (fun mib -> mib.mind_ntypes) Int.equal (fun x -> InductiveNumbersFieldExpected x);
   assert (List.is_empty mib1.mind_hyps && List.is_empty mib2.mind_hyps);
   assert (Array.length mib1.mind_packets >= 1
@@ -216,7 +226,7 @@ let check_inductive cst env mp1 l info1 mp2 mib2 spec2 subst1 subst2 reso1 reso2
   (* we check that records and their field names are preserved. *)
   check (fun mib -> mib.mind_record <> None) (==) (fun x -> RecordFieldExpected x);
   if mib1.mind_record <> None then begin
-    let rec names_prod_letin t = match kind_of_term t with
+    let rec names_prod_letin t = match kind t with
       | Prod(n,_,t) -> n::(names_prod_letin t)
       | LetIn(n,_,_,t) -> n::(names_prod_letin t)
       | Cast(t,_,_) -> names_prod_letin t
@@ -272,13 +282,13 @@ let check_constant cst env mp1 l info1 cb2 spec2 subst1 subst2 =
             | Type u when not (is_univ_variable u) ->
               (* Both types are inferred, no need to recheck them. We
                  cheat and collapse the types to Prop *)
-                mkArity (ctx1,prop_sort), mkArity (ctx2,prop_sort)
+                mkArity (ctx1,Sorts.prop), mkArity (ctx2,Sorts.prop)
             | Prop _ ->
               (* The type in the interface is inferred, it may be the case
                  that the type in the implementation is smaller because
                  the body is more reduced. We safely collapse the upper
                  type to Prop *)
-                mkArity (ctx1,prop_sort), mkArity (ctx2,prop_sort)
+                mkArity (ctx1,Sorts.prop), mkArity (ctx2,Sorts.prop)
             | Type _ ->
               (* The type in the interface is inferred and the type in the
                  implementation is not inferred or is inferred but from a
@@ -416,7 +426,7 @@ and check_modtypes cst env mtb1 mtb2 subst1 subst2 equiv =
 	     mod_type = subst_signature subst1 body_t1;
 	     mod_type_alg = None;
 	     mod_constraints = mtb1.mod_constraints;
-	     mod_retroknowledge = [];
+	     mod_retroknowledge = ModBodyRK [];
 	     mod_delta = mtb1.mod_delta} env
 	in
 	check_structure cst env body_t1 body_t2 equiv subst1 subst2
diff --git a/kernel/subtyping.mli b/kernel/subtyping.mli
index b24c20aa0..67df3759e 100644
--- a/kernel/subtyping.mli
+++ b/kernel/subtyping.mli
@@ -10,4 +10,4 @@ open Univ
 open Declarations
 open Environ
 
-val check_subtypes : env -> module_type_body -> module_type_body -> constraints
+val check_subtypes : env -> module_type_body -> module_type_body -> Constraint.t
diff --git a/kernel/term.ml b/kernel/term.ml
index 0e0af2f59..a4c92bd33 100644
--- a/kernel/term.ml
+++ b/kernel/term.ml
@@ -11,6 +11,7 @@ open Pp
 open CErrors
 open Names
 open Vars
+open Constr
 
 (**********************************************************************)
 (**         Redeclaration of types from module Constr                 *)
@@ -20,7 +21,7 @@ type contents = Sorts.contents = Pos | Null
 
 type sorts = Sorts.t =
   | Prop of contents       (** Prop and Set *)
-  | Type of Univ.universe  (** Type *)
+  | Type of Univ.Universe.t  (** Type *)
 
 type sorts_family = Sorts.family = InProp | InSet | InType
 
@@ -30,7 +31,7 @@ type constr = Constr.t
 type types = Constr.t
 (** Same as [constr], for documentation purposes. *)
 
-type existential_key = Constr.existential_key
+type existential_key = Evar.t
 type existential = Constr.existential
 
 type metavariable = Constr.metavariable
@@ -67,7 +68,7 @@ type ('constr, 'types) pcofixpoint = ('constr, 'types) Constr.pcofixpoint
 type 'a puniverses = 'a Univ.puniverses
 
 (** Simply type aliases *)
-type pconstant = constant puniverses
+type pconstant = Constant.t puniverses
 type pinductive = inductive puniverses
 type pconstructor = constructor puniverses
 
@@ -83,7 +84,7 @@ type ('constr, 'types, 'sort, 'univs) kind_of_term =
   | Lambda    of Name.t * 'types * 'constr
   | LetIn     of Name.t * 'constr * 'types * 'constr
   | App       of 'constr * 'constr array
-  | Const     of (constant * 'univs)
+  | Const     of (Constant.t * 'univs)
   | Ind       of (inductive * 'univs)
   | Construct of (constructor * 'univs)
   | Case      of case_info * 'constr * 'constr * 'constr array
@@ -91,7 +92,7 @@ type ('constr, 'types, 'sort, 'univs) kind_of_term =
   | CoFix     of ('constr, 'types) pcofixpoint
   | Proj      of projection * 'constr
 
-type values = Constr.values
+type values = Vmvalues.values
 
 (**********************************************************************)
 (**         Redeclaration of functions from module Constr             *)
@@ -165,167 +166,52 @@ let hcons_types = Constr.hcons
 (*          Non primitive term destructors                            *)
 (**********************************************************************)
 
-(* Destructor operations : partial functions
-   Raise [DestKO] if the const has not the expected form *)
-
-exception DestKO
-
+exception DestKO = DestKO
 (* Destructs a de Bruijn index *)
-let destRel c = match kind_of_term c with
-  | Rel n -> n
-  | _ -> raise DestKO
-
-(* Destructs an existential variable *)
-let destMeta c = match kind_of_term c with
-  | Meta n -> n
-  | _ -> raise DestKO
-
-let isMeta c = match kind_of_term c with Meta _ -> true | _ -> false
-
-(* Destructs a variable *)
-let destVar c = match kind_of_term c with
-  | Var id -> id
-  | _ -> raise DestKO
-
-(* Destructs a type *)
-let isSort c = match kind_of_term c with
-  | Sort _ -> true
-  | _ -> false
-
-let destSort c = match kind_of_term c with
-  | Sort s -> s
-  | _ -> raise DestKO
-
-let rec isprop c = match kind_of_term c with
-  | Sort (Prop _) -> true
-  | Cast (c,_,_) -> isprop c
-  | _ -> false
-
-let rec is_Prop c = match kind_of_term c with
-  | Sort (Prop Null) -> true
-  | Cast (c,_,_) -> is_Prop c
-  | _ -> false
-
-let rec is_Set c = match kind_of_term c with
-  | Sort (Prop Pos) -> true
-  | Cast (c,_,_) -> is_Set c
-  | _ -> false
-
-let rec is_Type c = match kind_of_term c with
-  | Sort (Type _) -> true
-  | Cast (c,_,_) -> is_Type c
-  | _ -> false
-
-let is_small = Sorts.is_small
-
-let iskind c = isprop c || is_Type c
-
-(* Tests if an evar *)
-let isEvar c = match kind_of_term c with Evar _ -> true | _ -> false
-
-let isEvar_or_Meta c = match kind_of_term c with
-  | Evar _ | Meta _ -> true
-  | _ -> false
-
-(* Destructs a casted term *)
-let destCast c = match kind_of_term c with
-  | Cast (t1,k,t2) -> (t1,k,t2)
-  | _ -> raise DestKO
-
-let isCast c = match kind_of_term c with Cast _ -> true | _ -> false
-
-
-(* Tests if a de Bruijn index *)
-let isRel c = match kind_of_term c with Rel _ -> true | _ -> false
-let isRelN n c =
-  match kind_of_term c with Rel n' -> Int.equal n n' | _ -> false
-
-(* Tests if a variable *)
-let isVar c = match kind_of_term c with Var _ -> true | _ -> false
-let isVarId id c =
-  match kind_of_term c with Var id' -> Id.equal id id' | _ -> false
-
-(* Tests if an inductive *)
-let isInd c = match kind_of_term c with Ind _ -> true | _ -> false
-
-(* Destructs the product (x:t1)t2 *)
-let destProd c = match kind_of_term c with
-  | Prod (x,t1,t2) -> (x,t1,t2)
-  | _ -> raise DestKO
-
-let isProd c = match kind_of_term c with | Prod _ -> true | _ -> false
-
-(* Destructs the abstraction [x:t1]t2 *)
-let destLambda c = match kind_of_term c with
-  | Lambda (x,t1,t2) -> (x,t1,t2)
-  | _ -> raise DestKO
-
-let isLambda c = match kind_of_term c with | Lambda _ -> true | _ -> false
-
-(* Destructs the let [x:=b:t1]t2 *)
-let destLetIn c = match kind_of_term c with
-  | LetIn (x,b,t1,t2) -> (x,b,t1,t2)
-  | _ -> raise DestKO
-
-let isLetIn c =  match kind_of_term c with LetIn _ -> true | _ -> false
-
-(* Destructs an application *)
-let destApp c = match kind_of_term c with
-  | App (f,a) -> (f, a)
-  | _ -> raise DestKO
-
+let destRel = destRel
+let destMeta = destRel
+let isMeta = isMeta
+let destVar = destVar
+let isSort = isSort
+let destSort = destSort
+let isprop = isprop
+let is_Prop = is_Prop
+let is_Set = is_Set
+let is_Type = is_Type
+let is_small = is_small
+let iskind = iskind
+let isEvar = isEvar
+let isEvar_or_Meta = isEvar_or_Meta
+let destCast = destCast
+let isCast = isCast
+let isRel = isRel
+let isRelN = isRelN
+let isVar = isVar
+let isVarId = isVarId
+let isInd = isInd
+let destProd = destProd
+let isProd = isProd
+let destLambda = destLambda
+let isLambda = isLambda
+let destLetIn = destLetIn
+let isLetIn = isLetIn
+let destApp = destApp
 let destApplication = destApp
-
-let isApp c = match kind_of_term c with App _ -> true | _ -> false
-
-(* Destructs a constant *)
-let destConst c = match kind_of_term c with
-  | Const kn -> kn
-  | _ -> raise DestKO
-
-let isConst c = match kind_of_term c with Const _ -> true | _ -> false
-
-(* Destructs an existential variable *)
-let destEvar c = match kind_of_term c with
-  | Evar (kn, a as r) -> r
-  | _ -> raise DestKO
-
-(* Destructs a (co)inductive type named kn *)
-let destInd c = match kind_of_term c with
-  | Ind (kn, a as r) -> r
-  | _ -> raise DestKO
-
-(* Destructs a constructor *)
-let destConstruct c = match kind_of_term c with
-  | Construct (kn, a as r) -> r
-  | _ -> raise DestKO
-
-let isConstruct c = match kind_of_term c with Construct _ -> true | _ -> false
-
-(* Destructs a term <p>Case c of lc1 | lc2 .. | lcn end *)
-let destCase c = match kind_of_term c with
-  | Case (ci,p,c,v) -> (ci,p,c,v)
-  | _ -> raise DestKO
-
-let isCase c =  match kind_of_term c with Case _ -> true | _ -> false
-
-let isProj c =  match kind_of_term c with Proj _ -> true | _ -> false
-
-let destProj c = match kind_of_term c with
-  | Proj (p, c) -> (p, c)
-  | _ -> raise DestKO
-
-let destFix c = match kind_of_term c with
-  | Fix fix -> fix
-  | _ -> raise DestKO
-
-let isFix c =  match kind_of_term c with Fix _ -> true | _ -> false
-
-let destCoFix c = match kind_of_term c with
-  | CoFix cofix -> cofix
-  | _ -> raise DestKO
-
-let isCoFix c =  match kind_of_term c with CoFix _ -> true | _ -> false
+let isApp = isApp
+let destConst = destConst
+let isConst = isConst
+let destEvar = destEvar
+let destInd = destInd
+let destConstruct = destConstruct
+let isConstruct = isConstruct
+let destCase = destCase
+let isCase = isCase
+let isProj = isProj
+let destProj = destProj
+let destFix = destFix
+let isFix = isFix
+let destCoFix = destCoFix
+let isCoFix = isCoFix
 
 (******************************************************************)
 (* Flattening and unflattening of embedded applications and casts *)
@@ -466,10 +352,11 @@ let lambda_applist_assum n c l =
   let rec app n subst t l =
     if Int.equal n 0 then
       if l == [] then substl subst t
-      else anomaly (Pp.str "Not enough arguments.")
+      else anomaly (Pp.str "Too many arguments.")
     else match kind_of_term t, l with
     | Lambda(_,_,c), arg::l -> app (n-1) (arg::subst) c l
     | LetIn(_,b,_,c), _ -> app (n-1) (substl subst b::subst) c l
+    | _, [] -> anomaly (Pp.str "Not enough arguments.")
     | _ -> anomaly (Pp.str "Not enough lambda/let's.") in
   app n [] c l
 
@@ -491,10 +378,11 @@ let prod_applist_assum n c l =
   let rec app n subst t l =
     if Int.equal n 0 then
       if l == [] then substl subst t
-      else anomaly (Pp.str "Not enough arguments.")
+      else anomaly (Pp.str "Too many arguments.")
     else match kind_of_term t, l with
     | Prod(_,_,c), arg::l -> app (n-1) (arg::subst) c l
     | LetIn(_,b,_,c), _ -> app (n-1) (substl subst b::subst) c l
+    | _, [] -> anomaly (Pp.str "Not enough arguments.")
     | _ -> anomaly (Pp.str "Not enough prod/let's.") in
   app n [] c l
 
diff --git a/kernel/term.mli b/kernel/term.mli
index d5aaf6ad0..b4597676a 100644
--- a/kernel/term.mli
+++ b/kernel/term.mli
@@ -7,6 +7,7 @@
 (************************************************************************)
 
 open Names
+open Constr
 
 (** {5 Redeclaration of types from module Constr and Sorts}
 
@@ -15,166 +16,133 @@ open Names
 
 *)
 
-type contents = Sorts.contents = Pos | Null
-
-type sorts = Sorts.t =
-  | Prop of contents       (** Prop and Set *)
-  | Type of Univ.universe  (** Type *)
-
-type sorts_family = Sorts.family = InProp | InSet | InType
-
-type 'a puniverses = 'a Univ.puniverses
-
-(** Simply type aliases *)
-type pconstant = constant puniverses
-type pinductive = inductive puniverses
-type pconstructor = constructor puniverses
-
-type constr = Constr.constr
-(** Alias types, for compatibility. *)
-
-type types = Constr.types
-(** Same as [constr], for documentation purposes. *)
-
-type existential_key = Constr.existential_key
-
-type existential = Constr.existential
-
-type metavariable = Constr.metavariable
-
-type case_style = Constr.case_style =
-  LetStyle | IfStyle | LetPatternStyle | MatchStyle | RegularStyle
-
-type case_printing = Constr.case_printing =
-  { ind_tags : bool list; cstr_tags : bool list array; style : case_style }
-
-type case_info = Constr.case_info =
-  { ci_ind        : inductive;
-    ci_npar       : int;
-    ci_cstr_ndecls : int array;
-    ci_cstr_nargs : int array;
-    ci_pp_info    : case_printing
-  }
-
-type cast_kind = Constr.cast_kind =
-  VMcast | NATIVEcast | DEFAULTcast | REVERTcast
-
-type rec_declaration = Constr.rec_declaration
-type fixpoint = Constr.fixpoint
-type cofixpoint = Constr.cofixpoint
-type 'constr pexistential = 'constr Constr.pexistential
-type ('constr, 'types) prec_declaration =
-  ('constr, 'types) Constr.prec_declaration
-type ('constr, 'types) pfixpoint = ('constr, 'types) Constr.pfixpoint
-type ('constr, 'types) pcofixpoint = ('constr, 'types) Constr.pcofixpoint
-
-type ('constr, 'types, 'sort, 'univs) kind_of_term =
-  ('constr, 'types, 'sort, 'univs) Constr.kind_of_term =
-  | Rel       of int
-  | Var       of Id.t
-  | Meta      of metavariable
-  | Evar      of 'constr pexistential
-  | Sort      of 'sort
-  | Cast      of 'constr * cast_kind * 'types
-  | Prod      of Name.t * 'types * 'types
-  | Lambda    of Name.t * 'types * 'constr
-  | LetIn     of Name.t * 'constr * 'types * 'constr
-  | App       of 'constr * 'constr array
-  | Const     of (constant * 'univs)
-  | Ind       of (inductive * 'univs)
-  | Construct of (constructor * 'univs)
-  | Case      of case_info * 'constr * 'constr * 'constr array
-  | Fix       of ('constr, 'types) pfixpoint
-  | CoFix     of ('constr, 'types) pcofixpoint
-  | Proj      of projection * 'constr
-
-type values = Constr.values
+exception DestKO
+[@@ocaml.deprecated "Alias for [Constr.DestKO]"]
 
 (** {5 Simple term case analysis. } *)
-
 val isRel  : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isRel]"]
 val isRelN : int -> constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isRelN]"]
 val isVar  : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isVar]"]
 val isVarId : Id.t -> constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isVarId]"]
 val isInd  : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isInd]"]
 val isEvar : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isEvar]"]
 val isMeta : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isMeta]"]
 val isEvar_or_Meta : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isEvar_or_Meta]"]
 val isSort : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isSort]"]
 val isCast : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isCast]"]
 val isApp : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isApp]"]
 val isLambda : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isLambda]"]
 val isLetIn : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isletIn]"]
 val isProd : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isProp]"]
 val isConst : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isConst]"]
 val isConstruct : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isConstruct]"]
 val isFix : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isFix]"]
 val isCoFix : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isCoFix]"]
 val isCase : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isCase]"]
 val isProj : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isProj]"]
 
 val is_Prop : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.is_Prop]"]
 val is_Set  : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.is_Set]"]
 val isprop : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.isprop]"]
 val is_Type : constr -> bool
+[@@ocaml.deprecated "Alias for [Constr.is_Type]"]
 val iskind : constr -> bool
-val is_small : sorts -> bool
+[@@ocaml.deprecated "Alias for [Constr.is_kind]"]
+val is_small : Sorts.t -> bool
+[@@ocaml.deprecated "Alias for [Constr.is_small]"]
 
 
 (** {5 Term destructors } *)
 (** Destructor operations are partial functions and
     @raise DestKO if the term has not the expected form. *)
 
-exception DestKO
-
 (** Destructs a de Bruijn index *)
 val destRel : constr -> int
+[@@ocaml.deprecated "Alias for [Constr.destRel]"]
 
 (** Destructs an existential variable *)
 val destMeta : constr -> metavariable
+[@@ocaml.deprecated "Alias for [Constr.destMeta]"]
 
 (** Destructs a variable *)
 val destVar : constr -> Id.t
+[@@ocaml.deprecated "Alias for [Constr.destVar]"]
 
 (** Destructs a sort. [is_Prop] recognizes the sort {% \textsf{%}Prop{% }%}, whether
    [isprop] recognizes both {% \textsf{%}Prop{% }%} and {% \textsf{%}Set{% }%}. *)
-val destSort : constr -> sorts
+val destSort : constr -> Sorts.t
+[@@ocaml.deprecated "Alias for [Constr.destSort]"]
 
 (** Destructs a casted term *)
 val destCast : constr -> constr * cast_kind * constr
+[@@ocaml.deprecated "Alias for [Constr.destCast]"]
 
 (** Destructs the product {% $ %}(x:t_1)t_2{% $ %} *)
 val destProd : types -> Name.t * types * types
+[@@ocaml.deprecated "Alias for [Constr.destProd]"]
 
 (** Destructs the abstraction {% $ %}[x:t_1]t_2{% $ %} *)
 val destLambda : constr -> Name.t * types * constr
+[@@ocaml.deprecated "Alias for [Constr.destLambda]"]
 
 (** Destructs the let {% $ %}[x:=b:t_1]t_2{% $ %} *)
 val destLetIn : constr -> Name.t * constr * types * constr
+[@@ocaml.deprecated "Alias for [Constr.destLetIn]"]
 
 (** Destructs an application *)
 val destApp : constr -> constr * constr array
+[@@ocaml.deprecated "Alias for [Constr.destApp]"]
 
 (** Obsolete synonym of destApp *)
 val destApplication : constr -> constr * constr array
+[@@ocaml.deprecated "Alias for [Constr.destApplication]"]
 
 (** Decompose any term as an applicative term; the list of args can be empty *)
 val decompose_app : constr -> constr * constr list
+[@@ocaml.deprecated "Alias for [Constr.decompose_app]"]
 
 (** Same as [decompose_app], but returns an array. *)
 val decompose_appvect : constr -> constr * constr array
+[@@ocaml.deprecated "Alias for [Constr.decompose_appvect]"]
 
 (** Destructs a constant *)
-val destConst : constr -> constant puniverses
+val destConst : constr -> Constant.t Univ.puniverses
+[@@ocaml.deprecated "Alias for [Constr.destConst]"]
 
 (** Destructs an existential variable *)
 val destEvar : constr -> existential
+[@@ocaml.deprecated "Alias for [Constr.destEvar]"]
 
 (** Destructs a (co)inductive type *)
-val destInd : constr -> inductive puniverses
+val destInd : constr -> inductive Univ.puniverses
+[@@ocaml.deprecated "Alias for [Constr.destInd]"]
 
 (** Destructs a constructor *)
-val destConstruct : constr -> constructor puniverses
+val destConstruct : constr -> constructor Univ.puniverses
+[@@ocaml.deprecated "Alias for [Constr.destConstruct]"]
 
 (** Destructs a [match c as x in I args return P with ... |
 Ci(...yij...) => ti | ... end] (or [let (..y1i..) := c as x in I args
@@ -182,9 +150,11 @@ return P in t1], or [if c then t1 else t2])
 @return [(info,c,fun args x => P,[|...|fun yij => ti| ...|])]
 where [info] is pretty-printing information *)
 val destCase : constr -> case_info * constr * constr * constr array
+[@@ocaml.deprecated "Alias for [Constr.destCase]"]
 
 (** Destructs a projection *)
 val destProj : constr -> projection * constr
+[@@ocaml.deprecated "Alias for [Constr.destProj]"]
 
 (** Destructs the {% $ %}i{% $ %}th function of the block
    [Fixpoint f{_ 1} ctx{_ 1} = b{_ 1}
@@ -194,9 +164,10 @@ val destProj : constr -> projection * constr
    where the length of the {% $ %}j{% $ %}th context is {% $ %}ij{% $ %}.
 *)
 val destFix : constr -> fixpoint
+[@@ocaml.deprecated "Alias for [Constr.destFix]"]
 
 val destCoFix : constr -> cofixpoint
-
+[@@ocaml.deprecated "Alias for [Constr.destCoFix]"]
 
 (** {5 Derived constructors} *)
 
@@ -271,7 +242,7 @@ val lambda_applist : constr -> constr list -> constr
 val lambda_appvect : constr -> constr array -> constr
 
 (** In [lambda_applist_assum n c args], [c] is supposed to have the
-    form [λΓ.c] with [Γ] of length [m] and possibly with let-ins; it
+    form [λΓ.c] with [Γ] of length [n] and possibly with let-ins; it
     returns [c] with the assumptions of [Γ] instantiated by [args] and
     the local definitions of [Γ] expanded. *)
 val lambda_applist_assum : int -> constr -> constr list -> constr
@@ -280,15 +251,15 @@ val lambda_appvect_assum : int -> constr -> constr array -> constr
 (** pseudo-reduction rule *)
 
 (** [prod_appvect] [forall (x1:B1;...;xn:Bn), B] [a1...an] @return [B[a1...an]] *)
-val prod_appvect : constr -> constr array -> constr
-val prod_applist : constr -> constr list -> constr
+val prod_appvect : types -> constr array -> types
+val prod_applist : types -> constr list -> types
 
 (** In [prod_appvect_assum n c args], [c] is supposed to have the
-    form [∀Γ.c] with [Γ] of length [m] and possibly with let-ins; it
+    form [∀Γ.c] with [Γ] of length [n] and possibly with let-ins; it
     returns [c] with the assumptions of [Γ] instantiated by [args] and
     the local definitions of [Γ] expanded. *)
-val prod_appvect_assum : int -> constr -> constr array -> constr
-val prod_applist_assum : int -> constr -> constr list -> constr
+val prod_appvect_assum : int -> types -> constr array -> types
+val prod_applist_assum : int -> types -> constr list -> types
 
 (** {5 Other term destructors. } *)
 
@@ -354,7 +325,7 @@ val strip_lam_assum : constr -> constr
     Such a term can canonically be seen as the pair of a context of types
     and of a sort *)
 
-type arity = Context.Rel.t * sorts
+type arity = Context.Rel.t * Sorts.t
 
 (** Build an "arity" from its canonical form *)
 val mkArity : arity -> types
@@ -368,7 +339,7 @@ val isArity : types -> bool
 (** {5 Kind of type} *)
 
 type ('constr, 'types) kind_of_type =
-  | SortType   of sorts
+  | SortType   of Sorts.t
   | CastType   of 'types * 'types
   | ProdType   of Name.t * 'types * 'types
   | LetInType  of Name.t * 'constr * 'types * 'types
@@ -378,23 +349,23 @@ val kind_of_type : types -> (constr, types) kind_of_type
 
 (** {5 Redeclaration of stuff from module [Sorts]} *)
 
-val set_sort  : sorts
-(** Alias for Sorts.set *)
+val set_sort  : Sorts.t
+[@@ocaml.deprecated "Alias for Sorts.set"]
 
-val prop_sort : sorts
-(** Alias for Sorts.prop *)
+val prop_sort : Sorts.t
+[@@ocaml.deprecated "Alias for Sorts.prop"]
 
-val type1_sort  : sorts
-(** Alias for Sorts.type1 *)
+val type1_sort  : Sorts.t
+[@@ocaml.deprecated "Alias for Sorts.type1"]
 
-val sorts_ord : sorts -> sorts -> int
-(** Alias for Sorts.compare *)
+val sorts_ord : Sorts.t -> Sorts.t -> int
+[@@ocaml.deprecated "Alias for Sorts.compare"]
 
-val is_prop_sort : sorts -> bool
-(** Alias for Sorts.is_prop *)
+val is_prop_sort : Sorts.t -> bool
+[@@ocaml.deprecated "Alias for Sorts.is_prop"]
 
-val family_of_sort : sorts -> sorts_family
-(** Alias for Sorts.family *)
+val family_of_sort : Sorts.t -> Sorts.family
+[@@ocaml.deprecated "Alias for Sorts.family"]
 
 (** {5 Redeclaration of stuff from module [Constr]}
 
@@ -403,90 +374,215 @@ val family_of_sort : sorts -> sorts_family
 (** {6 Term constructors. } *)
 
 val mkRel : int -> constr
+[@@ocaml.deprecated "Alias for Constr.mkRel"]
 val mkVar : Id.t -> constr
+[@@ocaml.deprecated "Alias for Constr.mkVar"]
 val mkMeta : metavariable -> constr
+[@@ocaml.deprecated "Alias for Constr.mkMeta"]
 val mkEvar : existential -> constr
-val mkSort : sorts -> types
+[@@ocaml.deprecated "Alias for Constr.mkEvar"]
+val mkSort : Sorts.t -> types
+[@@ocaml.deprecated "Alias for Constr.mkSort"]
 val mkProp : types
+[@@ocaml.deprecated "Alias for Constr.mkProp"]
 val mkSet  : types
-val mkType : Univ.universe -> types
+[@@ocaml.deprecated "Alias for Constr.mkSet"]
+val mkType : Univ.Universe.t -> types
+[@@ocaml.deprecated "Alias for Constr.mkType"]
 val mkCast : constr * cast_kind * constr -> constr
+[@@ocaml.deprecated "Alias for Constr"]
 val mkProd : Name.t * types * types -> types
+[@@ocaml.deprecated "Alias for Constr"]
 val mkLambda : Name.t * types * constr -> constr
+[@@ocaml.deprecated "Alias for Constr"]
 val mkLetIn : Name.t * constr * types * constr -> constr
+[@@ocaml.deprecated "Alias for Constr"]
 val mkApp : constr * constr array -> constr
-val mkConst : constant -> constr
+[@@ocaml.deprecated "Alias for Constr"]
+val mkConst : Constant.t -> constr
+[@@ocaml.deprecated "Alias for Constr"]
 val mkProj : projection * constr -> constr
+[@@ocaml.deprecated "Alias for Constr"]
 val mkInd : inductive -> constr
+[@@ocaml.deprecated "Alias for Constr"]
 val mkConstruct : constructor -> constr
-val mkConstU : constant puniverses -> constr
-val mkIndU : inductive puniverses -> constr
-val mkConstructU : constructor puniverses -> constr
+[@@ocaml.deprecated "Alias for Constr"]
+val mkConstU : Constant.t Univ.puniverses -> constr
+[@@ocaml.deprecated "Alias for Constr"]
+val mkIndU : inductive Univ.puniverses -> constr
+[@@ocaml.deprecated "Alias for Constr"]
+val mkConstructU : constructor Univ.puniverses -> constr
+[@@ocaml.deprecated "Alias for Constr"]
 val mkConstructUi : (pinductive * int) -> constr
+[@@ocaml.deprecated "Alias for Constr"]
 val mkCase : case_info * constr * constr * constr array -> constr
+[@@ocaml.deprecated "Alias for Constr.mkCase"]
 val mkFix : fixpoint -> constr
+[@@ocaml.deprecated "Alias for Constr.mkFix"]
 val mkCoFix : cofixpoint -> constr
+[@@ocaml.deprecated "Alias for Constr.mkCoFix"]
 
 (** {6 Aliases} *)
 
 val eq_constr : constr -> constr -> bool
-(** Alias for [Constr.equal] *)
+[@@ocaml.deprecated "Alias for Constr.equal"]
 
 (** [eq_constr_univs u a b] is [true] if [a] equals [b] modulo alpha, casts,
    application grouping and the universe constraints in [u]. *)
 val eq_constr_univs : constr UGraph.check_function
+[@@ocaml.deprecated "Alias for Constr.eq_constr_univs"]
 
 (** [leq_constr_univs u a b] is [true] if [a] is convertible to [b] modulo 
     alpha, casts, application grouping and the universe constraints in [u]. *)
 val leq_constr_univs : constr UGraph.check_function
+[@@ocaml.deprecated "Alias for Constr.leq_constr_univs"]
 
 (** [eq_constr_univs a b] [true, c] if [a] equals [b] modulo alpha, casts,
    application grouping and ignoring universe instances. *)
 val eq_constr_nounivs : constr -> constr -> bool
+[@@ocaml.deprecated "Alias for Constr.qe_constr_nounivs"]
 
 val kind_of_term : constr -> (constr, types, Sorts.t, Univ.Instance.t) kind_of_term
-(** Alias for [Constr.kind] *)
+[@@ocaml.deprecated "Alias for Constr.kind"]
 
 val compare : constr -> constr -> int
-(** Alias for [Constr.compare] *)
+[@@ocaml.deprecated "Alias for [Constr.compare]"]
 
 val constr_ord : constr -> constr -> int
-(** Alias for [Term.compare] *)
+[@@ocaml.deprecated "Alias for [Term.compare]"]
 
 val fold_constr : ('a -> constr -> 'a) -> 'a -> constr -> 'a
-(** Alias for [Constr.fold] *)
+[@@ocaml.deprecated "Alias for [Constr.fold]"]
 
 val map_constr : (constr -> constr) -> constr -> constr
-(** Alias for [Constr.map] *)
+[@@ocaml.deprecated "Alias for [Constr.map]"]
 
 val map_constr_with_binders :
   ('a -> 'a) -> ('a -> constr -> constr) -> 'a -> constr -> constr
-(** Alias for [Constr.map_with_binders] *)
+[@@ocaml.deprecated "Alias for [Constr.map_with_binders]"]
 
-val map_puniverses : ('a -> 'b) -> 'a puniverses -> 'b puniverses
-val univ_of_sort : sorts -> Univ.universe
-val sort_of_univ : Univ.universe -> sorts
+val map_puniverses : ('a -> 'b) -> 'a Univ.puniverses -> 'b Univ.puniverses
+[@@ocaml.deprecated "Alias for [Constr.map_puniverses]"]
+val univ_of_sort : Sorts.t -> Univ.Universe.t
+[@@ocaml.deprecated "Alias for [Sorts.univ_of_sort]"]
+val sort_of_univ : Univ.Universe.t -> Sorts.t
+[@@ocaml.deprecated "Alias for [Sorts.sort_of_univ]"]
 
 val iter_constr : (constr -> unit) -> constr -> unit
-(** Alias for [Constr.iter] *)
+[@@ocaml.deprecated "Alias for [Constr.iter]"]
 
 val iter_constr_with_binders :
   ('a -> 'a) -> ('a -> constr -> unit) -> 'a -> constr -> unit
-(** Alias for [Constr.iter_with_binders] *)
+[@@ocaml.deprecated "Alias for [Constr.iter_with_binders]"]
 
 val compare_constr : (constr -> constr -> bool) -> constr -> constr -> bool
-(** Alias for [Constr.compare_head] *)
+[@@ocaml.deprecated "Alias for [Constr.compare_head]"]
+
+type constr = Constr.constr
+[@@ocaml.deprecated "Alias for Constr.t"]
+
+(** Alias types, for compatibility. *)
+
+type types = Constr.types
+[@@ocaml.deprecated "Alias for Constr.types"]
+
+type contents = Sorts.contents = Pos | Null
+[@@ocaml.deprecated "Alias for Sorts.contents"]
+
+type sorts = Sorts.t =
+  | Prop of Sorts.contents   (** Prop and Set *)
+  | Type of Univ.Universe.t  (** Type *)
+[@@ocaml.deprecated "Alias for Sorts.t"]
+
+type sorts_family = Sorts.family = InProp | InSet | InType
+[@@ocaml.deprecated "Alias for Sorts.family"]
+
+type 'a puniverses = 'a Univ.puniverses
+[@@ocaml.deprecated "Alias for Constr.puniverses"]
+
+(** Simply type aliases *)
+type pconstant = Constr.pconstant
+[@@ocaml.deprecated "Alias for Constr.pconstant"]
+type pinductive = Constr.pinductive
+[@@ocaml.deprecated "Alias for Constr.pinductive"]
+type pconstructor = Constr.pconstructor
+[@@ocaml.deprecated "Alias for Constr.pconstructor"]
+type existential_key = Evar.t
+[@@ocaml.deprecated "Alias for Evar.t"]
+type existential = Constr.existential
+[@@ocaml.deprecated "Alias for Constr.existential"]
+type metavariable = Constr.metavariable
+[@@ocaml.deprecated "Alias for Constr.metavariable"]
+
+type case_style = Constr.case_style =
+  LetStyle | IfStyle | LetPatternStyle | MatchStyle | RegularStyle
+[@@ocaml.deprecated "Alias for Constr.case_style"]
+
+type case_printing = Constr.case_printing =
+  { ind_tags : bool list; cstr_tags : bool list array; style : Constr.case_style }
+[@@ocaml.deprecated "Alias for Constr.case_printing"]
+
+type case_info = Constr.case_info =
+  { ci_ind         : inductive;
+    ci_npar        : int;
+    ci_cstr_ndecls : int array;
+    ci_cstr_nargs  : int array;
+    ci_pp_info     : Constr.case_printing
+  }
+[@@ocaml.deprecated "Alias for Constr.case_info"]
+
+type cast_kind = Constr.cast_kind =
+  VMcast | NATIVEcast | DEFAULTcast | REVERTcast
+[@@ocaml.deprecated "Alias for Constr.cast_kind"]
+
+type rec_declaration = Constr.rec_declaration
+[@@ocaml.deprecated "Alias for Constr.rec_declaration"]
+type fixpoint = Constr.fixpoint
+[@@ocaml.deprecated "Alias for Constr.fixpoint"]
+type cofixpoint = Constr.cofixpoint
+[@@ocaml.deprecated "Alias for Constr.cofixpoint"]
+type 'constr pexistential = 'constr Constr.pexistential
+[@@ocaml.deprecated "Alias for Constr.pexistential"]
+type ('constr, 'types) prec_declaration =
+  ('constr, 'types) Constr.prec_declaration
+[@@ocaml.deprecated "Alias for Constr.prec_declaration"]
+type ('constr, 'types) pfixpoint = ('constr, 'types) Constr.pfixpoint
+[@@ocaml.deprecated "Alias for Constr.pfixpoint"]
+type ('constr, 'types) pcofixpoint = ('constr, 'types) Constr.pcofixpoint
+[@@ocaml.deprecated "Alias for Constr.pcofixpoint"]
+
+type ('constr, 'types, 'sort, 'univs) kind_of_term =
+  ('constr, 'types, 'sort, 'univs) Constr.kind_of_term =
+  | Rel       of int
+  | Var       of Id.t
+  | Meta      of Constr.metavariable
+  | Evar      of 'constr Constr.pexistential
+  | Sort      of 'sort
+  | Cast      of 'constr * Constr.cast_kind * 'types
+  | Prod      of Name.t * 'types * 'types
+  | Lambda    of Name.t * 'types * 'constr
+  | LetIn     of Name.t * 'constr * 'types * 'constr
+  | App       of 'constr * 'constr array
+  | Const     of (Constant.t * 'univs)
+  | Ind       of (inductive * 'univs)
+  | Construct of (constructor * 'univs)
+  | Case      of Constr.case_info * 'constr * 'constr * 'constr array
+  | Fix       of ('constr, 'types) Constr.pfixpoint
+  | CoFix     of ('constr, 'types) Constr.pcofixpoint
+  | Proj      of projection * 'constr
+[@@ocaml.deprecated "Alias for Constr.kind_of_term"]
 
-val hash_constr : constr -> int
-(** Alias for [Constr.hash] *)
+type values = Vmvalues.values
+[@@ocaml.deprecated "Alias for Vmvalues.values"]
 
-(*********************************************************************)
+val hash_constr : Constr.constr -> int
+[@@ocaml.deprecated "Alias for Constr.hash"]
 
-val hcons_sorts : sorts -> sorts
-(** Alias for [Constr.hashcons_sorts] *)
+val hcons_sorts : Sorts.t -> Sorts.t
+[@@ocaml.deprecated "Alias for [Sorts.hcons]"]
 
-val hcons_constr : constr -> constr
-(** Alias for [Constr.hashcons] *)
+val hcons_constr : Constr.constr -> Constr.constr
+[@@ocaml.deprecated "Alias for [Constr.hcons]"]
 
-val hcons_types : types -> types
-(** Alias for [Constr.hashcons] *)
+val hcons_types : Constr.types -> Constr.types
+[@@ocaml.deprecated "Alias for [Constr.hcons]"]
diff --git a/kernel/term_typing.ml b/kernel/term_typing.ml
index 3f42c348f..9b864440d 100644
--- a/kernel/term_typing.ml
+++ b/kernel/term_typing.ml
@@ -15,7 +15,7 @@
 open CErrors
 open Util
 open Names
-open Term
+open Constr
 open Declarations
 open Environ
 open Entries
@@ -125,11 +125,10 @@ let inline_side_effects env body ctx side_eff =
       | _ -> assert false
       in
       match cb.const_universes with
-      | Monomorphic_const cnstctx ->
+      | Monomorphic_const univs ->
         (** Abstract over the term at the top of the proof *)
         let ty = cb.const_type in
         let subst = Cmap_env.add c (Inr var) subst in
-        let univs = Univ.ContextSet.of_context cnstctx in
         let ctx = Univ.ContextSet.union ctx univs in
         (subst, var + 1, ctx, (cname c, b, ty, opaque) :: args)
       | Polymorphic_const auctx ->
@@ -154,7 +153,7 @@ let inline_side_effects env body ctx side_eff =
       (** Lift free rel variables *)
       if n <= k then t
       else mkRel (n + len - i - 1)
-    | _ -> map_constr_with_binders ((+) 1) (fun k t -> subst_const i k t) k t
+    | _ -> Constr.map_with_binders ((+) 1) (fun k t -> subst_const i k t) k t
     in
     let map_args i (na, b, ty, opaque) =
       (** Both the type and the body may mention other constants *)
@@ -199,13 +198,13 @@ let check_signatures curmb sl =
 let skip_trusted_seff sl b e =
   let rec aux sl b e acc =
     let open Context.Rel.Declaration in
-    match sl, kind_of_term b with
+    match sl, kind b with
     | (None|Some 0), _ -> b, e, acc
     | Some sl, LetIn (n,c,ty,bo) ->
        aux (Some (sl-1)) bo
          (Environ.push_rel (LocalDef (n,c,ty)) e) (`Let(n,c,ty)::acc)
     | Some sl, App(hd,arg) ->
-       begin match kind_of_term hd with
+       begin match kind hd with
        | Lambda (n,ty,bo) ->
            aux (Some (sl-1)) bo
              (Environ.push_rel (LocalAssum (n,ty)) e) (`Cut(n,ty,arg)::acc)
@@ -224,28 +223,28 @@ let rec unzip ctx j =
       unzip ctx { j with uj_val = mkApp (mkLambda (n,ty,j.uj_val),arg) }
 
 let feedback_completion_typecheck =
-  let open Feedback in
   Option.iter (fun state_id ->
-      feedback ~id:state_id Feedback.Complete)
+      Feedback.feedback ~id:state_id Feedback.Complete)
 
-let abstract_constant_universes abstract uctx =
-  if not abstract then
+let abstract_constant_universes = function
+  | Monomorphic_const_entry uctx ->
     Univ.empty_level_subst, Monomorphic_const uctx
-  else
+  | Polymorphic_const_entry uctx ->
     let sbst, auctx = Univ.abstract_universes uctx in
+    let sbst = Univ.make_instance_subst sbst in
     sbst, Polymorphic_const auctx
 
-let infer_declaration (type a) ~(trust : a trust) env kn (dcl : a constant_entry) =
+let infer_declaration (type a) ~(trust : a trust) env (dcl : a constant_entry) =
   match dcl with
-  | ParameterEntry (ctx,poly,(t,uctx),nl) ->
-      let env = push_context ~strict:(not poly) uctx env in
-      let j = infer env t in
-      let abstract = poly && not (Option.is_empty kn) in
-      let usubst, univs = 
-        abstract_constant_universes abstract uctx
+    | ParameterEntry (ctx,(t,uctx),nl) ->
+      let env = match uctx with
+        | Monomorphic_const_entry uctx -> push_context_set ~strict:true uctx env
+        | Polymorphic_const_entry uctx -> push_context ~strict:false uctx env
       in
+      let j = infer env t in
+      let usubst, univs = abstract_constant_universes uctx in
       let c = Typeops.assumption_of_judgment env j in
-      let t = hcons_constr (Vars.subst_univs_level_constr usubst c) in
+      let t = Constr.hcons (Vars.subst_univs_level_constr usubst c) in
       {
         Cooking.cook_body = Undef nl;
         cook_type = t;
@@ -262,11 +261,11 @@ let infer_declaration (type a) ~(trust : a trust) env kn (dcl : a constant_entry
   | DefinitionEntry ({ const_entry_type = Some typ;
                        const_entry_opaque = true;
 		       const_entry_universes = Monomorphic_const_entry univs } as c) ->
-      let env = push_context ~strict:true univs env in
+      let env = push_context_set ~strict:true univs env in
       let { const_entry_body = body; const_entry_feedback = feedback_id } = c in
       let tyj = infer_type env typ in
       let proofterm =
-        Future.chain ~pure:true body (fun ((body,uctx),side_eff) ->
+        Future.chain body (fun ((body,uctx),side_eff) ->
           let j, uctx = match trust with
           | Pure ->
             let env = push_context_set uctx env in
@@ -283,7 +282,7 @@ let infer_declaration (type a) ~(trust : a trust) env kn (dcl : a constant_entry
             let _ = judge_of_cast env j DEFAULTcast tyj in
             j, uctx
           in
-          let c = hcons_constr j.uj_val in
+          let c = Constr.hcons j.uj_val in
           feedback_completion_typecheck feedback_id;
           c, uctx) in
       let def = OpaqueDef (Opaqueproof.create proofterm) in
@@ -301,21 +300,29 @@ let infer_declaration (type a) ~(trust : a trust) env kn (dcl : a constant_entry
       let { const_entry_type = typ; const_entry_opaque = opaque } = c in
       let { const_entry_body = body; const_entry_feedback = feedback_id } = c in
       let (body, ctx), side_eff = Future.join body in
-      let poly, univs = match c.const_entry_universes with
-      | Monomorphic_const_entry univs -> false, univs
-      | Polymorphic_const_entry univs -> true, univs
-      in
-      let univsctx = Univ.ContextSet.of_context univs in
-      let ctx = Univ.ContextSet.union univsctx ctx in
       let body, ctx, _ = match trust with
       | Pure -> body, ctx, []
       | SideEffects _ -> inline_side_effects env body ctx side_eff
       in
-      let env = push_context_set ~strict:(not poly) ctx env in
-      let abstract = poly && not (Option.is_empty kn) in
-      let usubst, univs =
-        abstract_constant_universes abstract (Univ.ContextSet.to_context ctx)
-      in      
+      let env, usubst, univs = match c.const_entry_universes with
+      | Monomorphic_const_entry univs ->
+        let ctx = Univ.ContextSet.union univs ctx in
+        let env = push_context_set ~strict:true ctx env in
+        env, Univ.empty_level_subst, Monomorphic_const ctx
+      | Polymorphic_const_entry uctx ->
+        (** Ensure not to generate internal constraints in polymorphic mode.
+            The only way for this to happen would be that either the body
+            contained deferred universes, or that it contains monomorphic
+            side-effects. The first property is ruled out by upper layers,
+            and the second one is ensured by the fact we currently
+            unconditionally export side-effects from polymorphic definitions,
+            i.e. [trust] is always [Pure]. *)
+        let () = assert (Univ.ContextSet.is_empty ctx) in
+        let env = push_context ~strict:false uctx env in
+        let sbst, auctx = Univ.abstract_universes uctx in
+        let sbst = Univ.make_instance_subst sbst in
+        env, sbst, Polymorphic_const auctx
+      in
       let j = infer env body in
       let typ = match typ with
         | None ->
@@ -325,7 +332,7 @@ let infer_declaration (type a) ~(trust : a trust) env kn (dcl : a constant_entry
            let _ = judge_of_cast env j DEFAULTcast tj in
            Vars.subst_univs_level_constr usubst t
       in
-      let def = hcons_constr (Vars.subst_univs_level_constr usubst j.uj_val) in
+      let def = Constr.hcons (Vars.subst_univs_level_constr usubst j.uj_val) in
       let def = 
 	if opaque then OpaqueDef (Opaqueproof.create (Future.from_val (def, Univ.ContextSet.empty)))
 	else Def (Mod_subst.from_val def) 
@@ -359,7 +366,7 @@ let infer_declaration (type a) ~(trust : a trust) env kn (dcl : a constant_entry
     in
     let term, typ = pb.proj_eta in
     {
-      Cooking.cook_body = Def (Mod_subst.from_val (hcons_constr term));
+      Cooking.cook_body = Def (Mod_subst.from_val (Constr.hcons term));
       cook_type = typ;
       cook_proj = Some pb;
       cook_universes = univs;
@@ -367,7 +374,7 @@ let infer_declaration (type a) ~(trust : a trust) env kn (dcl : a constant_entry
       cook_context = None;
     }
 
-let record_aux env s_ty s_bo suggested_expr =
+let record_aux env s_ty s_bo =
   let in_ty = keep_hyps env s_ty in
   let v =
     String.concat " "
@@ -376,10 +383,7 @@ let record_aux env s_ty s_bo suggested_expr =
           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)
-
-let suggest_proof_using = ref (fun _ _ _ _ _ -> "")
-let set_suggest_proof_using f = suggest_proof_using := f
+  Aux_file.record_in_aux "context_used" v
 
 let build_constant_declaration kn env result =
   let open Cooking in
@@ -388,10 +392,10 @@ let build_constant_declaration kn env result =
     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 l = Id.Set.elements (Id.Set.diff inferred_set declared_set) in
       let n = List.length l in
-      let declared_vars = Pp.pr_sequence Id.print (Idset.elements declared_set) in
-      let inferred_vars = Pp.pr_sequence Id.print (Idset.elements inferred_set) in
+      let declared_vars = Pp.pr_sequence Id.print (Id.Set.elements declared_set) in
+      let inferred_vars = Pp.pr_sequence Id.print (Id.Set.elements inferred_set) in
       let missing_vars  = Pp.pr_sequence Id.print (List.rev l) in
       user_err Pp.(prlist str
          ["The following section "; (String.plural n "variable"); " ";
@@ -417,7 +421,7 @@ let build_constant_declaration kn env result =
            we must look at the body NOW, if any *)
         let ids_typ = global_vars_set env typ in
         let ids_def = match def with
-        | Undef _ -> Idset.empty
+        | Undef _ -> Id.Set.empty
         | Def cs -> global_vars_set env (Mod_subst.force_constr cs)
         | OpaqueDef lc ->
             let vars =
@@ -425,17 +429,13 @@ let build_constant_declaration kn env result =
                 (Opaqueproof.force_proof (opaque_tables env) lc) in
             (* we force so that cst are added to the env immediately after *)
             ignore(Opaqueproof.force_constraints (opaque_tables env) lc);
-            let expr =
-              !suggest_proof_using (Constant.to_string kn)
-                env vars ids_typ context_ids in
-            if !Flags.compilation_mode = Flags.BuildVo then
-              record_aux env ids_typ vars expr;
+            if !Flags.record_aux_file then record_aux env ids_typ vars;
             vars
         in
-        keep_hyps env (Idset.union ids_typ ids_def), def
+        keep_hyps env (Id.Set.union ids_typ ids_def), def
     | None ->
-        if !Flags.compilation_mode = Flags.BuildVo then
-          record_aux env Id.Set.empty Id.Set.empty "";
+        if !Flags.record_aux_file then
+          record_aux env Id.Set.empty Id.Set.empty;
         [], def (* Empty section context: no need to check *)
     | Some declared ->
         (* We use the declared set and chain a check of correctness *)
@@ -445,14 +445,14 @@ let build_constant_declaration kn env result =
         | Def cs as x ->
             let ids_typ = global_vars_set env typ in
             let ids_def = global_vars_set env (Mod_subst.force_constr cs) in
-            let inferred = keep_hyps env (Idset.union ids_typ ids_def) in
+            let inferred = keep_hyps env (Id.Set.union ids_typ ids_def) in
             check declared inferred;
             x
         | OpaqueDef lc -> (* In this case we can postpone the check *)
             OpaqueDef (Opaqueproof.iter_direct_opaque (fun c ->
               let ids_typ = global_vars_set env typ in
               let ids_def = global_vars_set env c in
-              let inferred = keep_hyps env (Idset.union ids_typ ids_def) in
+              let inferred = keep_hyps env (Id.Set.union ids_typ ids_def) in
               check declared inferred) lc) in
   let univs = result.cook_universes in
   let tps = 
@@ -494,7 +494,7 @@ let build_constant_declaration kn env result =
 
 let translate_constant mb env kn ce =
   build_constant_declaration kn env
-    (infer_declaration ~trust:mb env (Some kn) ce)
+    (infer_declaration ~trust:mb env ce)
 
 let constant_entry_of_side_effect cb u =
   let univs =
@@ -532,17 +532,13 @@ type side_effect_role =
   | Schema of inductive * string
 
 type exported_side_effect = 
-  constant * constant_body * side_effect_role
+  Constant.t * constant_body * side_effect_role
 
-let export_side_effects mb env ce =
-  match ce with
-  | ParameterEntry e -> [], ParameterEntry e
-  | ProjectionEntry e -> [], ProjectionEntry e
-  | DefinitionEntry c ->
+let export_side_effects mb env c =
       let { const_entry_body = body } = c in
       let _, eff = Future.force body in
-      let ce = DefinitionEntry { c with
-        const_entry_body = Future.chain ~pure:true body
+      let ce = { c with
+        const_entry_body = Future.chain body
           (fun (b_ctx, _) -> b_ctx, ()) } in
       let not_exists (c,_,_,_) =
         try ignore(Environ.lookup_constant c env); false
@@ -563,7 +559,7 @@ let export_side_effects mb env ce =
             let env = Environ.add_constant kn cb env in
             match cb.const_universes with
             | Monomorphic_const ctx ->
-              Environ.push_context ~strict:true ctx env
+              Environ.push_context_set ~strict:true ctx env
             | Polymorphic_const _ -> env
           end
         | kn, cb, `Opaque(_, ctx), _ ->
@@ -571,7 +567,7 @@ let export_side_effects mb env ce =
             let env = Environ.add_constant kn cb env in
             match cb.const_universes with
             | Monomorphic_const cstctx ->
-              let env = Environ.push_context ~strict:true cstctx env in
+              let env = Environ.push_context_set ~strict:true cstctx env in
               Environ.push_context_set ~strict:true ctx env
             | Polymorphic_const _ -> env
           end
@@ -610,36 +606,53 @@ let translate_recipe env kn r =
   let hcons = DirPath.is_empty dir in
   build_constant_declaration kn env (Cooking.cook_constant ~hcons env r)
 
-let translate_local_def mb env id centry =
+let translate_local_def env id centry =
   let open Cooking in
-  let decl = infer_declaration ~trust:mb env None (DefinitionEntry centry) in
+  let body = Future.from_val ((centry.secdef_body, Univ.ContextSet.empty), ()) in
+  let centry = {
+    const_entry_body = body;
+    const_entry_secctx = centry.secdef_secctx;
+    const_entry_feedback = centry.secdef_feedback;
+    const_entry_type = centry.secdef_type;
+    const_entry_universes = Monomorphic_const_entry Univ.ContextSet.empty;
+    const_entry_opaque = false;
+    const_entry_inline_code = false;
+  } in
+  let decl = infer_declaration ~trust:Pure env (DefinitionEntry centry) in
   let typ = decl.cook_type in
-  if Option.is_empty decl.cook_context && !Flags.compilation_mode = Flags.BuildVo then begin
+  if Option.is_empty decl.cook_context && !Flags.record_aux_file then begin
     match decl.cook_body with
     | Undef _ -> ()
     | Def _ -> ()
     | OpaqueDef lc ->
-       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
-       let expr =
-         !suggest_proof_using (Id.to_string id)
-           env ids_def ids_typ context_ids in
-       record_aux env ids_typ ids_def expr
+       record_aux env ids_typ ids_def
   end;
-  let univs = match decl.cook_universes with
-  | Monomorphic_const ctx -> ctx
+  let () = match decl.cook_universes with
+  | Monomorphic_const ctx -> assert (Univ.ContextSet.is_empty ctx)
   | Polymorphic_const _ -> assert false
   in
-  decl.cook_body, typ, univs
+  let c = match decl.cook_body with
+  | Def c -> Mod_subst.force_constr c
+  | OpaqueDef o ->
+    let p = Opaqueproof.force_proof (Environ.opaque_tables env) o in
+    let cst = Opaqueproof.force_constraints (Environ.opaque_tables env) o in
+    (** Let definitions are ensured to have no extra constraints coming from
+        the body by virtue of the typing of [Entries.section_def_entry]. *)
+    let () = assert (Univ.ContextSet.is_empty cst) in
+    p
+  | Undef _ -> assert false
+  in
+  c, typ
 
 (* Insertion of inductive types. *)
 
 let translate_mind env kn mie = Indtypes.check_inductive env kn mie
 
 let inline_entry_side_effects env ce = { ce with
-  const_entry_body = Future.chain ~pure:true
+  const_entry_body = Future.chain
     ce.const_entry_body (fun ((body, ctx), side_eff) ->
       let body, ctx',_ = inline_side_effects env body ctx side_eff in
       (body, ctx'), ());
diff --git a/kernel/term_typing.mli b/kernel/term_typing.mli
index 24153343e..7bc029010 100644
--- a/kernel/term_typing.mli
+++ b/kernel/term_typing.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
 open Declarations
 open Entries
@@ -18,8 +18,8 @@ type _ trust =
 | Pure : unit trust
 | SideEffects : structure_body -> side_effects trust
 
-val translate_local_def : 'a trust -> env -> Id.t -> 'a definition_entry ->
-  constant_def * types * Univ.universe_context
+val translate_local_def : env -> Id.t -> section_def_entry ->
+  constr * types
 
 val translate_local_assum : env -> types -> types
 
@@ -47,7 +47,7 @@ val uniq_seff : side_effects -> side_effect list
 val equal_eff : side_effect -> side_effect -> bool
 
 val translate_constant :
-  'a trust -> env -> constant -> 'a constant_entry ->
+  'a trust -> env -> Constant.t -> 'a constant_entry ->
     constant_body
 
 type side_effect_role =
@@ -55,28 +55,25 @@ type side_effect_role =
   | Schema of inductive * string
 
 type exported_side_effect = 
-  constant * constant_body * side_effect_role
+  Constant.t * constant_body * side_effect_role
   
 (* Given a constant entry containing side effects it exports them (either
  * by re-checking them or trusting them).  Returns the constant bodies to
  * be pushed in the safe_env by safe typing.  The main constant entry
  * needs to be translated as usual after this step. *)
 val export_side_effects :
-  structure_body -> env -> side_effects constant_entry ->
-    exported_side_effect list * unit constant_entry
+  structure_body -> env -> side_effects definition_entry ->
+    exported_side_effect list * unit definition_entry
 
 val translate_mind :
-  env -> mutual_inductive -> mutual_inductive_entry -> mutual_inductive_body
+  env -> MutInd.t -> mutual_inductive_entry -> mutual_inductive_body
 
-val translate_recipe : env -> constant -> Cooking.recipe -> constant_body
+val translate_recipe : env -> Constant.t -> Cooking.recipe -> constant_body
 
 (** Internal functions, mentioned here for debug purpose only *)
 
-val infer_declaration : trust:'a trust -> env -> constant option -> 
+val infer_declaration : trust:'a trust -> env ->
   'a constant_entry -> Cooking.result
 
 val build_constant_declaration :
-  constant -> env -> Cooking.result -> constant_body
-
-val set_suggest_proof_using :
-  (string -> env -> Id.Set.t -> Id.Set.t -> Id.t list -> string) -> unit
+  Constant.t -> env -> Cooking.result -> constant_body
diff --git a/kernel/type_errors.ml b/kernel/type_errors.ml
index bbaf569d3..781c6bfbc 100644
--- a/kernel/type_errors.ml
+++ b/kernel/type_errors.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
 open Reduction
 
@@ -44,9 +44,9 @@ type ('constr, 'types) ptype_error =
   | UnboundVar of variable
   | NotAType of ('constr, 'types) punsafe_judgment
   | BadAssumption of ('constr, 'types) punsafe_judgment
-  | ReferenceVariables of identifier * 'constr
-  | ElimArity of pinductive * sorts_family list * 'constr * ('constr, 'types) punsafe_judgment
-      * (sorts_family * sorts_family * arity_error) option
+  | ReferenceVariables of Id.t * 'constr
+  | ElimArity of pinductive * Sorts.family list * 'constr * ('constr, 'types) punsafe_judgment
+      * (Sorts.family * Sorts.family * arity_error) option
   | CaseNotInductive of ('constr, 'types) punsafe_judgment
   | WrongCaseInfo of pinductive * case_info
   | NumberBranches of ('constr, 'types) punsafe_judgment * int
@@ -59,7 +59,7 @@ type ('constr, 'types) ptype_error =
   | IllFormedRecBody of 'constr pguard_error * Name.t array * int * env * ('constr, 'types) punsafe_judgment array
   | IllTypedRecBody of
       int * Name.t array * ('constr, 'types) punsafe_judgment array * 'types array
-  | UnsatisfiedConstraints of Univ.constraints
+  | UnsatisfiedConstraints of Univ.Constraint.t
 
 type type_error = (constr, types) ptype_error
 
@@ -115,6 +115,7 @@ let error_ill_typed_rec_body env i lna vdefj vargs =
   raise (TypeError (env, IllTypedRecBody (i,lna,vdefj,vargs)))
 
 let error_elim_explain kp ki =
+  let open Sorts in
   match kp,ki with
   | (InType | InSet), InProp -> NonInformativeToInformative
   | InType, InSet -> StrongEliminationOnNonSmallType (* if Set impredicative *)
diff --git a/kernel/type_errors.mli b/kernel/type_errors.mli
index 1b2ccf8f8..72861f6e4 100644
--- a/kernel/type_errors.mli
+++ b/kernel/type_errors.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
 
 (** Type errors. {% \label{%}typeerrors{% }%} *)
@@ -45,9 +45,9 @@ type ('constr, 'types) ptype_error =
   | UnboundVar of variable
   | NotAType of ('constr, 'types) punsafe_judgment
   | BadAssumption of ('constr, 'types) punsafe_judgment
-  | ReferenceVariables of identifier * 'constr
-  | ElimArity of pinductive * sorts_family list * 'constr * ('constr, 'types) punsafe_judgment
-      * (sorts_family * sorts_family * arity_error) option
+  | ReferenceVariables of Id.t * 'constr
+  | ElimArity of pinductive * Sorts.family list * 'constr * ('constr, 'types) punsafe_judgment
+      * (Sorts.family * Sorts.family * arity_error) option
   | CaseNotInductive of ('constr, 'types) punsafe_judgment
   | WrongCaseInfo of pinductive * case_info
   | NumberBranches of ('constr, 'types) punsafe_judgment * int
@@ -60,7 +60,7 @@ type ('constr, 'types) ptype_error =
   | IllFormedRecBody of 'constr pguard_error * Name.t array * int * env * ('constr, 'types) punsafe_judgment array
   | IllTypedRecBody of
       int * Name.t array * ('constr, 'types) punsafe_judgment array * 'types array
-  | UnsatisfiedConstraints of Univ.constraints
+  | UnsatisfiedConstraints of Univ.Constraint.t
 
 type type_error = (constr, types) ptype_error
 
@@ -74,11 +74,11 @@ val error_not_type : env -> unsafe_judgment -> 'a
 
 val error_assumption : env -> unsafe_judgment -> 'a
 
-val error_reference_variables : env -> identifier -> constr -> 'a
+val error_reference_variables : env -> Id.t -> constr -> 'a
 
 val error_elim_arity :
-  env -> pinductive -> sorts_family list -> constr -> unsafe_judgment ->
-      (sorts_family * sorts_family * arity_error) option -> 'a
+  env -> pinductive -> Sorts.family list -> constr -> unsafe_judgment ->
+      (Sorts.family * Sorts.family * arity_error) option -> 'a
 
 val error_case_not_inductive : env -> unsafe_judgment -> 'a
 
@@ -103,6 +103,6 @@ val error_ill_formed_rec_body :
 val error_ill_typed_rec_body  :
   env -> int -> Name.t array -> unsafe_judgment array -> types array -> 'a
 
-val error_elim_explain : sorts_family -> sorts_family -> arity_error
+val error_elim_explain : Sorts.family -> Sorts.family -> arity_error
 
-val error_unsatisfied_constraints : env -> Univ.constraints -> 'a
+val error_unsatisfied_constraints : env -> Univ.Constraint.t -> 'a
diff --git a/kernel/typeops.ml b/kernel/typeops.ml
index 044877e82..4a935f581 100644
--- a/kernel/typeops.ml
+++ b/kernel/typeops.ml
@@ -10,7 +10,8 @@ open CErrors
 open Util
 open Names
 open Univ
-open Term
+open Sorts
+open Constr
 open Vars
 open Declarations
 open Environ
@@ -38,7 +39,7 @@ let check_constraints cst env =
 
 (* 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
+  match kind(whd_all env t) with
   | Sort s -> s
   | _ -> error_not_type env (make_judge c t)
 
@@ -57,7 +58,7 @@ let check_assumption env t ty =
 
 (* Prop and Set *)
 
-let type1 = mkSort type1_sort
+let type1 = mkSort Sorts.type1
 
 (* Type of Type(i). *)
 
@@ -65,6 +66,10 @@ let type_of_type u =
   let uu = Universe.super u in
     mkType uu
 
+let type_of_sort = function
+  | Prop c -> type1
+  | Type u -> type_of_type u
+
 (*s Type of a de Bruijn index. *)
 
 let type_of_relative env n =
@@ -148,7 +153,7 @@ let type_of_apply env func funt argsv argstv =
   let rec apply_rec i typ = 
     if Int.equal i len then typ
     else 
-      (match kind_of_term (whd_all env typ) with
+      (match kind (whd_all env typ) with
       | Prod (_,c1,c2) ->
 	let arg = argsv.(i) and argt = argstv.(i) in
 	  (try
@@ -294,9 +299,9 @@ let type_of_projection env p c ct =
     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));
+  assert(MutInd.equal pb.proj_ind (fst ind));
   let ty = Vars.subst_instance_constr u pb.Declarations.proj_type in
-  substl (c :: List.rev args) ty
+  substl (c :: CList.rev args) ty
       
 
 (* Fixpoints. *)
@@ -321,13 +326,9 @@ let check_fixpoint env lna lar vdef vdeft =
     arbitraires et non plus des variables *)
 let rec execute env cstr =
   let open Context.Rel.Declaration in
-  match kind_of_term cstr with
+  match kind cstr with
     (* Atomic terms *)
-    | Sort (Prop c) ->
-      type1
-	
-    | Sort (Type u) ->
-      type_of_type u
+    | Sort s -> type_of_sort s
 
     | Rel n ->
       type_of_relative env n
@@ -346,7 +347,7 @@ let rec execute env cstr =
     | App (f,args) ->
         let argst = execute_array env args in
 	let ft =
-	  match kind_of_term f with
+	  match kind f with
 	  | Ind ind when Environ.template_polymorphic_pind ind env ->
 	    let args = Array.map (fun t -> lazy t) argst in
               type_of_inductive_knowing_parameters env ind args
@@ -434,8 +435,8 @@ let infer env constr =
 
 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)
+    let infer_key = CProfile.declare_profile "Fast_infer" in
+      CProfile.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} =
diff --git a/kernel/typeops.mli b/kernel/typeops.mli
index a8f7fba9a..5584b6ab4 100644
--- a/kernel/typeops.mli
+++ b/kernel/typeops.mli
@@ -7,8 +7,8 @@
 (************************************************************************)
 
 open Names
+open Constr
 open Univ
-open Term
 open Environ
 open Entries
 
@@ -37,15 +37,19 @@ val assumption_of_judgment :  env -> unsafe_judgment -> types
 val type_judgment          :  env -> unsafe_judgment -> unsafe_type_judgment
 
 (** {6 Type of sorts. } *)
+val type1 : types
+val type_of_sort : Sorts.t -> types
 val judge_of_prop : unsafe_judgment
 val judge_of_set  : unsafe_judgment
-val judge_of_prop_contents  : contents -> unsafe_judgment
-val judge_of_type           : universe -> unsafe_judgment
+val judge_of_prop_contents  : Sorts.contents -> unsafe_judgment
+val judge_of_type           : Universe.t -> unsafe_judgment
 
 (** {6 Type of a bound variable. } *)
+val type_of_relative : env -> int -> types
 val judge_of_relative : env -> int -> unsafe_judgment
 
 (** {6 Type of variables } *)
+val type_of_variable : env -> variable -> types
 val judge_of_variable : env -> variable -> unsafe_judgment
 
 (** {6 type of a constant } *)
@@ -66,9 +70,9 @@ val judge_of_abstraction :
   env -> Name.t -> unsafe_type_judgment -> unsafe_judgment
     -> unsafe_judgment
 
-val sort_of_product : env -> sorts -> sorts -> sorts
-
 (** {6 Type of a product. } *)
+val sort_of_product : env -> Sorts.t -> Sorts.t -> Sorts.t
+val type_of_product : env -> Name.t -> Sorts.t -> Sorts.t -> types
 val judge_of_product :
   env -> Name.t -> unsafe_type_judgment -> unsafe_type_judgment
     -> unsafe_judgment
diff --git a/kernel/uGraph.ml b/kernel/uGraph.ml
index 9793dd881..f1e8d1031 100644
--- a/kernel/uGraph.ml
+++ b/kernel/uGraph.ml
@@ -890,23 +890,24 @@ let dump_universes output g =
 
 let merge_constraints = 
   if Flags.profile then 
-    let key = Profile.declare_profile "merge_constraints" in
-      Profile.profile2 key merge_constraints
+    let key = CProfile.declare_profile "merge_constraints" in
+      CProfile.profile2 key merge_constraints
   else merge_constraints
 let check_constraints =
   if Flags.profile then
-    let key = Profile.declare_profile "check_constraints" in
-      Profile.profile2 key check_constraints
+    let key = CProfile.declare_profile "check_constraints" in
+      CProfile.profile2 key check_constraints
   else check_constraints
 
 let check_eq = 
   if Flags.profile then
-    let check_eq_key = Profile.declare_profile "check_eq" in
-      Profile.profile3 check_eq_key check_eq
+    let check_eq_key = CProfile.declare_profile "check_eq" in
+      CProfile.profile3 check_eq_key check_eq
   else check_eq
 
 let check_leq = 
   if Flags.profile then 
-    let check_leq_key = Profile.declare_profile "check_leq" in
-      Profile.profile3 check_leq_key check_leq
+    let check_leq_key = CProfile.declare_profile "check_leq" in
+      CProfile.profile3 check_leq_key check_leq
   else check_leq
+
diff --git a/kernel/uGraph.mli b/kernel/uGraph.mli
index 2fe555018..f71d83d85 100644
--- a/kernel/uGraph.mli
+++ b/kernel/uGraph.mli
@@ -9,63 +9,64 @@
 open Univ
 
 (** {6 Graphs of universes. } *)
-
 type t
-
 type universes = t
+[@@ocaml.deprecated "Use UGraph.t"]
 
-type 'a check_function = universes -> 'a -> 'a -> bool
-val check_leq : universe check_function
-val check_eq : universe check_function
-val check_eq_level : universe_level check_function
+type 'a check_function = t -> 'a -> 'a -> bool
 
-(** The empty graph of universes *)
-val empty_universes : universes
+val check_leq : Universe.t check_function
+val check_eq : Universe.t check_function
+val check_eq_level : Level.t check_function
 
 (** The initial graph of universes: Prop < Set *)
-val initial_universes : universes
+val initial_universes : t
+
+(** Check if we are in the initial case *)
+val is_initial_universes : t -> bool
+
+(** Check equality of instances w.r.t. a universe graph *)
+val check_eq_instances : Instance.t check_function
+
+(** {6 ... } *)
+(** Merge of constraints in a universes graph.
+  The function [merge_constraints] merges a set of constraints in a given
+  universes graph. It raises the exception [UniverseInconsistency] if the
+  constraints are not satisfiable. *)
 
-val is_initial_universes : universes -> bool
+val enforce_constraint : univ_constraint -> t -> t
+val merge_constraints : Constraint.t -> t -> t
 
-val sort_universes : universes -> universes
+val check_constraint  : t -> univ_constraint -> bool
+val check_constraints : Constraint.t -> t -> bool
 
 (** Adds a universe to the graph, ensuring it is >= or > Set.
    @raises AlreadyDeclared if the level is already declared in the graph. *)
 
 exception AlreadyDeclared
 
-val add_universe : universe_level -> bool -> universes -> universes
+val add_universe : Level.t -> bool -> t -> t
 
-(** {6 ... } *)
-(** Merge of constraints in a universes graph.
-  The function [merge_constraints] merges a set of constraints in a given
-  universes graph. It raises the exception [UniverseInconsistency] if the
-  constraints are not satisfiable. *)
+(** {6 Pretty-printing of universes. } *)
 
-val enforce_constraint : univ_constraint -> universes -> universes
-val merge_constraints : constraints -> universes -> universes
+val pr_universes : (Level.t -> Pp.t) -> t -> Pp.t
 
-val constraints_of_universes : universes -> constraints
+(** The empty graph of universes *)
+val empty_universes : t
+[@@ocaml.deprecated "Use UGraph.initial_universes"]
 
-val check_constraint  : universes -> univ_constraint -> bool
-val check_constraints : constraints -> universes -> bool
+val sort_universes : t -> t
 
-val check_eq_instances : Instance.t check_function
-(** Check equality of instances w.r.t. a universe graph *)
+val constraints_of_universes : t -> Constraint.t
 
 val check_subtype : AUContext.t check_function
 (** [check_subtype univ ctx1 ctx2] checks whether [ctx2] is an instance of
     [ctx1]. *)
 
-(** {6 Pretty-printing of universes. } *)
-
-val pr_universes : (Level.t -> Pp.t) -> universes -> Pp.t
-
 (** {6 Dumping to a file } *)
 
 val dump_universes :
-  (constraint_type -> string -> string -> unit) ->
-  universes -> unit
+  (constraint_type -> string -> string -> unit) -> t -> unit
 
 (** {6 Debugging} *)
-val check_universes_invariants : universes -> unit
+val check_universes_invariants : t -> unit
diff --git a/kernel/univ.ml b/kernel/univ.ml
index d915fb8c9..c42b66749 100644
--- a/kernel/univ.ml
+++ b/kernel/univ.ml
@@ -31,133 +31,6 @@ open Util
    union-find algorithm. The assertions $<$ and $\le$ are represented by
    adjacency lists *)
 
-module type Hashconsed =
-sig
-  type t
-  val hash : t -> int
-  val eq : t -> t -> bool
-  val hcons : t -> t
-end
-
-module HashedList (M : Hashconsed) :
-sig
-  type t = private Nil | Cons of M.t * int * t
-  val nil : t
-  val cons : M.t -> t -> t
-end =
-struct
-  type t = Nil | Cons of M.t * int * t
-  module Self =
-  struct
-    type _t = t
-    type t = _t
-    type u = (M.t -> M.t)
-    let hash = function Nil -> 0 | Cons (_, h, _) -> h
-    let eq l1 l2 = match l1, l2 with
-    | Nil, Nil -> true
-    | Cons (x1, _, l1), Cons (x2, _, l2) -> x1 == x2 && l1 == l2
-    | _ -> false
-    let hashcons hc = function
-    | Nil -> Nil
-    | Cons (x, h, l) -> Cons (hc x, h, l)
-  end
-  module Hcons = Hashcons.Make(Self)
-  let hcons = Hashcons.simple_hcons Hcons.generate Hcons.hcons M.hcons
-  (** No recursive call: the interface guarantees that all HLists from this
-      program are already hashconsed. If we get some external HList, we can
-      still reconstruct it by traversing it entirely. *)
-  let nil = Nil
-  let cons x l =
-    let h = M.hash x in
-    let hl = match l with Nil -> 0 | Cons (_, h, _) -> h in
-    let h = Hashset.Combine.combine h hl in
-    hcons (Cons (x, h, l))
-end
-
-module HList = struct
-
-  module type S = sig
-    type elt
-    type t = private Nil | Cons of elt * int * t
-    val hash : t -> int
-    val nil : t
-    val cons : elt -> t -> t
-    val tip : elt -> t
-    val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a
-    val map : (elt -> elt) -> t -> t
-    val smartmap : (elt -> elt) -> t -> t
-    val exists : (elt -> bool) -> t -> bool
-    val for_all : (elt -> bool) -> t -> bool
-    val for_all2 : (elt -> elt -> bool) -> t -> t -> bool
-    val mem : elt -> t -> bool
-    val remove : elt -> t -> t
-    val to_list : t -> elt list
-    val compare : (elt -> elt -> int) -> t -> t -> int
-  end
-
-  module Make (H : Hashconsed) : S with type elt = H.t =
-  struct
-  type elt = H.t
-  include HashedList(H)
-
-  let hash = function Nil -> 0 | Cons (_, h, _) -> h
-
-  let tip e = cons e nil
-
-  let rec fold f l accu = match l with
-  | Nil -> accu
-  | Cons (x, _, l) -> fold f l (f x accu)
-
-  let rec map f = function
-  | Nil -> nil
-  | Cons (x, _, l) -> cons (f x) (map f l)
-
-  let smartmap = map
-  (** Apriori hashconsing ensures that the map is equal to its argument *)
-
-  let rec exists f = function
-  | Nil -> false
-  | Cons (x, _, l) -> f x || exists f l
-
-  let rec for_all f = function
-  | Nil -> true
-  | Cons (x, _, l) -> f x && for_all f l
-
-  let rec for_all2 f l1 l2 = match l1, l2 with
-  | Nil, Nil -> true
-  | Cons (x1, _, l1), Cons (x2, _, l2) -> f x1 x2 && for_all2 f l1 l2
-  | _ -> false
-
-  let rec to_list = function
-  | Nil -> []
-  | Cons (x, _, l) -> x :: to_list l
-
-  let rec remove x = function
-  | Nil -> nil
-  | Cons (y, _, l) ->
-    if H.eq x y then l
-    else cons y (remove x l)
-
-  let rec mem x = function
-  | Nil -> false
-  | Cons (y, _, l) -> H.eq x y || mem x l
-
-  let rec compare cmp l1 l2 = match l1, l2 with
-  | Nil, Nil -> 0
-  | Cons (x1, h1, l1), Cons (x2, h2, l2) ->
-    let c = Int.compare h1 h2 in
-    if c == 0 then
-      let c = cmp x1 x2 in
-      if c == 0 then
-        compare cmp l1 l2
-      else c
-    else c
-  | Cons _, Nil -> 1
-  | Nil, Cons _ -> -1
-
-  end
-end
-
 module RawLevel =
 struct
   open Names
@@ -248,8 +121,7 @@ module Level = struct
   (** Hashcons on levels + their hash *)
 
   module Self = struct
-    type _t = t
-    type t = _t
+    type nonrec t = t
     type u = unit
     let eq x y = x.hash == y.hash && RawLevel.hequal x.data y.data
     let hash x = x.hash
@@ -320,6 +192,10 @@ module Level = struct
 
   let make m n = make (Level (n, Names.DirPath.hcons m))
 
+  let name u =
+    match data u with
+    | Level (n, d) -> Some (d, n)
+    | _ -> None
 end
 
 (** Level maps *)
@@ -390,12 +266,11 @@ struct
   module Expr = 
   struct
     type t = Level.t * int
-    type _t = t
-	
+
     (* Hashing of expressions *)
     module ExprHash = 
     struct
-      type t = _t
+      type t = Level.t * int
       type u = Level.t -> Level.t
       let hashcons hdir (b,n as x) = 
 	let b' = hdir b in 
@@ -409,25 +284,12 @@ struct
 
     end
 
-    module HExpr = 
-    struct 
+    module H = Hashcons.Make(ExprHash)
 
-      module H = Hashcons.Make(ExprHash)
+    let hcons =
+      Hashcons.simple_hcons H.generate H.hcons Level.hcons
 
-      type t = ExprHash.t
-
-      let hcons =
-	Hashcons.simple_hcons H.generate H.hcons Level.hcons
-      let hash = ExprHash.hash
-      let eq x y = x == y ||
-	(let (u,n) = x and (v,n') = y in
-	   Int.equal n n' && Level.equal u v)
-
-    end
-
-    let hcons = HExpr.hcons
-
-    let make l = hcons (l, 0)
+    let make l = (l, 0)
 
     let compare u v =
       if u == v then 0
@@ -436,8 +298,8 @@ struct
 	  if Int.equal n n' then Level.compare x x'
 	  else n - n'
 
-    let prop = make Level.prop
-    let set = make Level.set
+    let prop = hcons (Level.prop, 0)
+    let set = hcons (Level.set, 0)
     let type1 = hcons (Level.set, 1)
 
     let is_small = function
@@ -448,6 +310,8 @@ struct
       (let (u,n) = x and (v,n') = y in
 	 Int.equal n n' && Level.equal u v)
 
+    let hash = ExprHash.hash
+
     let leq (u,n) (v,n') =
       let cmp = Level.compare u v in
 	if Int.equal cmp 0 then n <= n'
@@ -457,13 +321,13 @@ struct
 
     let successor (u,n) =
       if Level.is_prop u then type1
-      else hcons (u, n + 1)
+      else (u, n + 1)
 
     let addn k (u,n as x) = 
       if k = 0 then x 
       else if Level.is_prop u then
-	hcons (Level.set,n+k)
-      else hcons (u,n+k)
+	(Level.set,n+k)
+      else (u,n+k)
 
     type super_result =
 	SuperSame of bool
@@ -477,19 +341,16 @@ struct
        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 super (u,n) (v,n') =
       let cmp = Level.compare u v in
 	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 open RawLevel in
+          match Level.data u, n, Level.data v, n' with
+          | Prop, _, Prop, _ -> SuperSame (n < n')
+          | Prop, 0, _, _ -> SuperSame true
+          | _, _, Prop, 0 -> SuperSame false
+          | _, _, _, _ -> SuperDiff cmp
 
     let to_string (v, n) =
       if Int.equal n 0 then Level.to_string v
@@ -515,71 +376,63 @@ struct
       let v' = f v in 
 	if v' == v then x
 	else if Level.is_prop v' && n != 0 then
-	  hcons (Level.set, n)
-	else hcons (v', n)
+	  (Level.set, n)
+	else (v', n)
 
   end
-    
-  let compare_expr = Expr.compare
 
-  module Huniv = HList.Make(Expr.HExpr)
-  type t = Huniv.t
-  open Huniv
-    
-  let equal x y = x == y || 
-    (Huniv.hash x == Huniv.hash y && 
-       Huniv.for_all2 Expr.equal x y)
+  type t = Expr.t list
 
-  let hash = Huniv.hash
+  let tip l = [l]
+  let cons x l = x :: l
 
-  let compare x y =
-    if x == y then 0
-    else 
-      let hx = Huniv.hash x and hy = Huniv.hash y in
-      let c = Int.compare hx hy in 
-	if c == 0 then
-	  Huniv.compare (fun e1 e2 -> compare_expr e1 e2) x y
-	else c
+  let rec hash = function
+  | [] -> 0
+  | e :: l -> Hashset.Combine.combinesmall (Expr.ExprHash.hash e) (hash l)
+
+  let equal x y = x == y || List.equal Expr.equal x y
+
+  let compare x y = if x == y then 0 else List.compare Expr.compare x y
+
+  module Huniv = Hashcons.Hlist(Expr)
 
-  let rec hcons = function
-  | Nil -> Huniv.nil
-  | Cons (x, _, l) -> Huniv.cons x (hcons l)
+  let hcons = Hashcons.recursive_hcons Huniv.generate Huniv.hcons Expr.hcons
 
-  let make l = Huniv.tip (Expr.make l)
-  let tip x = Huniv.tip x
+  let make l = tip (Expr.make l)
+  let tip x = tip x
 
   let pr l = match l with
-    | Cons (u, _, Nil) -> Expr.pr u
+    | [u] -> Expr.pr u
     | _ -> 
       str "max(" ++ hov 0
-	(prlist_with_sep pr_comma Expr.pr (to_list l)) ++
+	(prlist_with_sep pr_comma Expr.pr l) ++
         str ")"
 
   let pr_with f l = match l with
-    | Cons (u, _, Nil) -> Expr.pr_with f u
+    | [u] -> Expr.pr_with f u
     | _ -> 
       str "max(" ++ hov 0
-	(prlist_with_sep pr_comma (Expr.pr_with f) (to_list l)) ++
+	(prlist_with_sep pr_comma (Expr.pr_with f) l) ++
         str ")"
 
   let is_level l = match l with
-    | Cons (l, _, Nil) -> Expr.is_level l
+    | [l] -> Expr.is_level l
     | _ -> false
 
   let rec is_levels l = match l with
-    | Cons (l, _, r) -> Expr.is_level l && is_levels r
-    | Nil -> true
+    | l :: r -> Expr.is_level l && is_levels r
+    | [] -> true
 
   let level l = match l with
-    | Cons (l, _, Nil) -> Expr.level l
+    | [l] -> Expr.level l
     | _ -> None
 
   let levels l = 
-    fold (fun x acc -> LSet.add (Expr.get_level x) acc) l LSet.empty
+    List.fold_left (fun acc x -> LSet.add (Expr.get_level x) acc) LSet.empty l
 
   let is_small u = 
     match u with
-    | Cons (l, _, Nil) -> Expr.is_small l
+    | [l] -> Expr.is_small l
     | _ -> false
 
   (* The lower predicative level of the hierarchy that contains (impredicative)
@@ -601,16 +454,16 @@ struct
   let super l = 
     if is_small l then type1
     else
-      Huniv.map (fun x -> Expr.successor x) l
+      List.smartmap (fun x -> Expr.successor x) l
 
   let addn n l =
-    Huniv.map (fun x -> Expr.addn n x) l
+    List.smartmap (fun x -> Expr.addn n x) l
 
   let rec merge_univs l1 l2 =
     match l1, l2 with
-    | Nil, _ -> l2
-    | _, Nil -> l1
-    | Cons (h1, _, t1), Cons (h2, _, t2) ->
+    | [], _ -> l2
+    | _, [] -> l1
+    | h1 :: t1, h2 :: t2 ->
        let open Expr in
        (match super h1 h2 with
 	| SuperSame true (* h1 < h2 *) -> merge_univs t1 l2
@@ -623,7 +476,7 @@ struct
   let sort u =
     let rec aux a l = 
       match l with
-      | Cons (b, _, l') ->
+      | b :: l' ->
 	let open Expr in
         (match super a b with
 	 | SuperSame false -> aux a l'
@@ -631,22 +484,56 @@ struct
 	 | SuperDiff c ->
 	    if c <= 0 then cons a l
 	    else cons b (aux a l'))
-      | Nil -> cons a l
+      | [] -> cons a l
     in 
-      fold (fun a acc -> aux a acc) u nil
-	
+      List.fold_right (fun a acc -> aux a acc) u []
+
+  (** [max_var_pred p u] returns the maximum variable level in [u] satisfying
+      [p], -1 if not found *)
+  let rec max_var_pred p u =
+    let open Level in
+    match u with
+    | [] -> -1
+    | (v, _) :: u ->
+      match var_index v with
+      | Some i when p i -> max i (max_var_pred p u)
+      | _ -> max_var_pred p u
+
+  let rec remap_var u i j =
+    let open Level in
+    match u with
+    | [] -> []
+    | (v, incr) :: u when var_index v = Some i ->
+      (Level.var j, incr) :: remap_var u i j
+    | _ :: u -> remap_var u i j
+
+  let rec compact u max_var i =
+    if i >= max_var then (u,[]) else
+    let j = max_var_pred (fun j -> j < i) u in
+    if Int.equal i (j+1) then
+      let (u,s) = compact u max_var (i+1) in
+      (u, i :: s)
+    else
+      let (u,s) = compact (remap_var u i j) max_var (i+1) in
+      (u, j+1 :: s)
+
+  let compact u =
+    let max_var = max_var_pred (fun _ -> true) u in
+    compact u max_var 0
+
   (* Returns the formal universe that is greater than the universes u and v.
      Used to type the products. *)
   let sup x y = merge_univs x y
 
-  let empty = nil
+  let empty = []
 
-  let exists = Huniv.exists
+  let exists = List.exists
 
-  let for_all = Huniv.for_all
+  let for_all = List.for_all
 
-  let smartmap = Huniv.smartmap
+  let smartmap = List.smartmap
 
+  let map = List.map
 end
 
 type universe = Universe.t
@@ -818,12 +705,11 @@ let check_univ_leq u v =
   Universe.for_all (fun u -> check_univ_leq_one u v) u
 
 let enforce_leq u v c =
-  let open Universe.Huniv in
   let rec aux acc v =
   match v with
-  | Cons (v, _, l) ->
-    aux (fold (fun u -> constraint_add_leq u v) u c) l
-  | Nil -> acc
+  | v :: l ->
+    aux (List.fold_right (fun u -> constraint_add_leq u v) u c) l
+  | [] -> acc
   in aux c v
 
 let enforce_leq u v c =
@@ -833,21 +719,16 @@ let enforce_leq u v c =
 let enforce_leq_level u v c =
   if Level.equal u v then c else Constraint.add (u,Le,v) c
 
-let enforce_univ_constraint (u,d,v) =
-  match d with
-  | Eq -> enforce_eq u v
-  | Le -> enforce_leq u v
-  | Lt -> enforce_leq (super u) v
-
 (* Miscellaneous functions to remove or test local univ assumed to
    occur in a universe *)
 
-let univ_level_mem u v = Huniv.mem (Expr.make u) v
+let univ_level_mem u v =
+  List.exists (fun (l, n) -> Int.equal n 0 && Level.equal u l) v
 
 let univ_level_rem u v min = 
   match Universe.level v with
   | Some u' -> if Level.equal u u' then min else v
-  | None -> Huniv.remove (Universe.Expr.make u) v
+  | None -> List.filter (fun (l, n) -> not (Int.equal n 0 && Level.equal u l)) v
 
 (* Is u mentionned in v (or equals to v) ? *)
 
@@ -864,15 +745,55 @@ type universe_level_subst = universe_level universe_map
 (** A full substitution might involve algebraic universes *)
 type universe_subst = universe universe_map
 
-let level_subst_of f = 
-  fun l -> 
-    try let u = f l in 
-	  match Universe.level u with
-	  | None -> l
-	  | Some l -> l
-    with Not_found -> l
-     
-module Instance : sig 
+module Variance =
+struct
+  (** A universe position in the instance given to a cumulative
+     inductive can be the following. Note there is no Contravariant
+     case because [forall x : A, B <= forall x : A', B'] requires [A =
+     A'] as opposed to [A' <= A]. *)
+  type t = Irrelevant | Covariant | Invariant
+
+  let sup x y =
+    match x, y with
+    | Irrelevant, s | s, Irrelevant -> s
+    | Invariant, _ | _, Invariant -> Invariant
+    | Covariant, Covariant -> Covariant
+
+  let check_subtype x y = match x, y with
+  | (Irrelevant | Covariant | Invariant), Irrelevant -> true
+  | Irrelevant, Covariant -> false
+  | (Covariant | Invariant), Covariant -> true
+  | (Irrelevant | Covariant), Invariant -> false
+  | Invariant, Invariant -> true
+
+  let pr = function
+    | Irrelevant -> str "*"
+    | Covariant -> str "+"
+    | Invariant -> str "="
+
+  let leq_constraint csts variance u u' =
+    match variance with
+    | Irrelevant -> csts
+    | Covariant -> enforce_leq_level u u' csts
+    | Invariant -> enforce_eq_level u u' csts
+
+  let eq_constraint csts variance u u' =
+    match variance with
+    | Irrelevant -> csts
+    | Covariant | Invariant -> enforce_eq_level u u' csts
+
+  let leq_constraints variance u u' csts =
+    let len = Array.length u in
+    assert (len = Array.length u' && len = Array.length variance);
+    Array.fold_left3 leq_constraint csts variance u u'
+
+  let eq_constraints variance u u' csts =
+    let len = Array.length u in
+    assert (len = Array.length u' && len = Array.length variance);
+    Array.fold_left3 eq_constraint csts variance u u'
+end
+
+module Instance : sig
     type t = Level.t array
 
     val empty : t
@@ -892,7 +813,7 @@ module Instance : sig
 
     val subst_fn : universe_level_subst_fn -> t -> t
     
-    val pr : (Level.t -> Pp.t) -> t -> Pp.t
+    val pr : (Level.t -> Pp.t) -> ?variance:Variance.t array -> t -> Pp.t
     val levels : t -> LSet.t
 end = 
 struct
@@ -902,8 +823,7 @@ struct
 
   module HInstancestruct =
   struct
-    type _t = t
-    type t = _t
+    type nonrec t = t
     type u = Level.t -> Level.t
 
     let hashcons huniv a = 
@@ -969,8 +889,12 @@ struct
 
   let levels x = LSet.of_array x
 
-  let pr =
-    prvect_with_sep spc
+  let pr prl ?variance =
+    let ppu i u =
+      let v = Option.map (fun v -> v.(i)) variance in
+      pr_opt_no_spc Variance.pr v ++ prl u
+    in
+    prvecti_with_sep spc ppu
 
   let equal t u = 
     t == u ||
@@ -1034,9 +958,9 @@ struct
   let empty = (Instance.empty, Constraint.empty)
   let is_empty (univs, cst) = Instance.is_empty univs && Constraint.is_empty cst
 
-  let pr prl (univs, cst as ctx) =
+  let pr prl ?variance (univs, cst as ctx) =
     if is_empty ctx then mt() else
-      h 0 (Instance.pr prl univs ++ str " |= ") ++ h 0 (v 0 (Constraint.pr prl cst))
+      h 0 (Instance.pr prl ?variance univs ++ str " |= ") ++ h 0 (v 0 (Constraint.pr prl cst))
 
   let hcons (univs, cst) =
     (Instance.hcons univs, hcons_constraints cst)
@@ -1072,66 +996,42 @@ end
 type abstract_universe_context = AUContext.t
 let hcons_abstract_universe_context = AUContext.hcons
 
-(** Universe info for cumulative inductive types:
-    A context of universe levels
-    with universe constraints, representing local universe variables
-    and constraints, together with a context of universe levels with
-    universe constraints, representing conditions for subtyping used
-    for inductive types.
+(** Universe info for cumulative inductive types: A context of
+   universe levels with universe constraints, representing local
+   universe variables and constraints, together with an array of
+   Variance.t.
 
-    This data structure maintains the invariant that the context for
-    subtyping constraints is exactly twice as big as the context for
-    universe constraints. *)
+    This data structure maintains the invariant that the variance
+   array has the same length as the universe instance. *)
 module CumulativityInfo =
 struct
-  type t = universe_context * universe_context
+  type t = universe_context * Variance.t array
 
   let make x =
-    if (Instance.length (UContext.instance (snd x))) =
-       (Instance.length (UContext.instance (fst x))) * 2 then x
+    if (Instance.length (UContext.instance (fst x))) =
+       (Array.length (snd x)) then x
     else anomaly (Pp.str "Invalid subtyping information encountered!")
 
-  let empty = (UContext.empty, UContext.empty)
-  let is_empty (univcst, subtypcst) = UContext.is_empty univcst && UContext.is_empty subtypcst
-
-  let halve_context ctx =
-    let len = Array.length (Instance.to_array ctx) in
-    let halflen = len / 2 in
-    (Instance.of_array (Array.sub (Instance.to_array ctx) 0 halflen),
-     Instance.of_array (Array.sub (Instance.to_array ctx) halflen halflen))
-
-  let pr prl (univcst, subtypcst) =
-    if UContext.is_empty univcst then mt() else
-      let (ctx, ctx') = halve_context (UContext.instance subtypcst) in
-      (UContext.pr prl univcst) ++ fnl () ++ fnl () ++
-        h 0 (str "~@{" ++ Instance.pr prl ctx ++ str "} <= ~@{" ++ Instance.pr prl ctx' ++ str "} iff ")
-         ++ fnl () ++ h 0 (v 0 (Constraint.pr prl (UContext.constraints subtypcst)))
+  let empty = (UContext.empty, [||])
+  let is_empty (univs, variance) = UContext.is_empty univs && Array.is_empty variance
 
-  let hcons (univcst, subtypcst) =
-    (UContext.hcons univcst, UContext.hcons subtypcst)
+  let pr prl (univs, variance) =
+    UContext.pr prl ~variance univs
 
-  let univ_context (univcst, subtypcst) = univcst
-  let subtyp_context (univcst, subtypcst) = subtypcst
+  let hcons (univs, variance) = (* should variance be hconsed? *)
+    (UContext.hcons univs, variance)
 
-  let create_trivial_subtyping ctx ctx' =
-    CArray.fold_left_i
-      (fun i cst l -> Constraint.add (l, Eq, Array.get ctx' i) cst)
-      Constraint.empty (Instance.to_array ctx)
+  let univ_context (univs, subtypcst) = univs
+  let variance (univs, variance) = variance
 
   (** This function takes a universe context representing constraints
-      of an inductive and a Instance.t of fresh universe names for the
-      subtyping (with the same length as the context in the given
-      universe context) and produces a UInfoInd.t that with the
-      trivial subtyping relation. *)
-  let from_universe_context univcst freshunivs =
-    let inst = (UContext.instance univcst) in
-    assert (Instance.length freshunivs = Instance.length inst);
-    (univcst, UContext.make (Instance.append inst freshunivs,
-                             create_trivial_subtyping inst freshunivs))
-
-  let subtyping_susbst (univcst, subtypcst) = 
-      let (ctx, ctx') = (halve_context (UContext.instance subtypcst))in
-      Array.fold_left2 (fun subst l1 l2 -> LMap.add l1 l2 subst) LMap.empty ctx ctx'
+     of an inductive and produces a CumulativityInfo.t with the
+     trivial subtyping relation. *)
+  let from_universe_context univs =
+    (univs, Array.init (UContext.size univs) (fun _ -> Variance.Invariant))
+
+  let leq_constraints (_,variance) u u' csts = Variance.leq_constraints variance u u' csts
+  let eq_constraints (_,variance) u u' csts = Variance.eq_constraints variance u u' csts
 
 end
 
@@ -1202,6 +1102,7 @@ struct
   let constraints (univs, cst) = cst
   let levels (univs, cst) = univs
 
+  let size (univs,_) = LSet.cardinal univs
 end
 
 type universe_context_set = ContextSet.t
@@ -1260,7 +1161,7 @@ let subst_univs_expr_opt fn (l,n) =
 
 let subst_univs_universe fn ul =
   let subst, nosubst = 
-    Universe.Huniv.fold (fun u (subst,nosubst) -> 
+    List.fold_right (fun u (subst,nosubst) -> 
       try let a' = subst_univs_expr_opt fn u in
 	    (a' :: subst, nosubst)
       with Not_found -> (subst, u :: nosubst))
@@ -1271,27 +1172,9 @@ let subst_univs_universe fn ul =
       let substs = 
 	List.fold_left Universe.merge_univs Universe.empty subst
       in
-	List.fold_left (fun acc u -> Universe.merge_univs acc (Universe.Huniv.tip u))
+	List.fold_left (fun acc u -> Universe.merge_univs acc (Universe.tip u))
 	  substs nosubst
 
-let subst_univs_level fn l = 
-  try Some (fn l)
-  with Not_found -> None
-
-let subst_univs_constraint fn (u,d,v as c) cstrs =
-  let u' = subst_univs_level fn u in
-  let v' = subst_univs_level fn v in
-  match u', v' with
-  | None, None -> Constraint.add c cstrs
-  | Some u, None -> enforce_univ_constraint (u,d,make v) cstrs
-  | None, Some v -> enforce_univ_constraint (make u,d,v) cstrs
-  | Some u, Some v -> enforce_univ_constraint (u,d,v) cstrs
-
-let subst_univs_constraints subst csts =
-  Constraint.fold 
-    (fun c cstrs -> subst_univs_constraint subst c cstrs)
-    csts Constraint.empty 
-
 let make_instance_subst i = 
   let arr = Instance.to_array i in
     Array.fold_left_i (fun i acc l ->
@@ -1314,12 +1197,11 @@ let abstract_universes ctx =
       (UContext.constraints ctx)
   in
   let ctx = UContext.make (instance, cstrs) in
-  subst, ctx
+  instance, ctx
 
-let abstract_cumulativity_info (univcst, substcst) = 
-  let instance, univcst = abstract_universes univcst in
-  let _, substcst = abstract_universes substcst in
-  (instance, (univcst, substcst))
+let abstract_cumulativity_info (univs, variance) =
+  let subst, univs = abstract_universes univs in
+  subst, (univs, variance)
 
 (** Pretty-printing *)
 
diff --git a/kernel/univ.mli b/kernel/univ.mli
index a4f2e26b6..74d1bfd3a 100644
--- a/kernel/univ.mli
+++ b/kernel/univ.mli
@@ -7,7 +7,6 @@
 (************************************************************************)
 
 (** Universes. *)
-
 module Level :
 sig
   type t
@@ -20,11 +19,11 @@ sig
 
   val is_small : t -> bool
   (** Is the universe set or prop? *)
-		       
+
   val is_prop : t -> bool
   val is_set : t -> bool
   (** Is it specifically Prop or Set *)
-		       
+
   val compare : t -> t -> int
   (** Comparison function *)
 
@@ -46,21 +45,24 @@ sig
   val var : int -> t
 
   val var_index : t -> int option
+
+  val name : t -> (Names.DirPath.t * int) option
 end
 
 type universe_level = Level.t
-(** Alias name. *)
+[@@ocaml.deprecated "Use Level.t"]
 
 (** Sets of universe levels *)
-module LSet : 
-sig 
-  include CSig.SetS with type elt = universe_level
-	      
+module LSet :
+sig
+  include CSig.SetS with type elt = Level.t
+
   val pr : (Level.t -> Pp.t) -> t -> Pp.t
   (** Pretty-printing *)
 end
 
 type universe_set = LSet.t
+[@@ocaml.deprecated "Use LSet.t"]
 
 module Universe :
 sig
@@ -106,83 +108,93 @@ sig
 
   val super : t -> t
   (** The universe strictly above *)
-    
+
   val sup   : t -> t -> t
   (** The l.u.b. of 2 universes *)
 
-  val type0m : t  
+  val type0m : t
   (** image of Prop in the universes hierarchy *)
-  
-  val type0 : t  
+
+  val type0 : t
   (** image of Set in the universes hierarchy *)
-  
-  val type1 : t 
+
+  val type1 : t
   (** the universe of the type of Prop/Set *)
 
   val exists : (Level.t * int -> bool) -> t -> bool
   val for_all : (Level.t * int -> bool) -> t -> bool
+
+  val map : (Level.t * int -> 'a) -> t -> 'a list
+
+  (** [compact u] remaps local variables in [u] such that their indices become
+       consecutive. It returns the new universe and the mapping.
+       Example: compact [(Var 0, i); (Prop, 0); (Var 2; j))] =
+         [(Var 0,i); (Prop, 0); (Var 1; j)], [0; 2]
+  *)
+  val compact : t -> t * int list
 end
 
 type universe = Universe.t
+[@@ocaml.deprecated "Use Universe.t"]
 
 (** Alias name. *)
 
-val pr_uni : universe -> Pp.t
-	      
-(** The universes hierarchy: Type 0- = Prop <= Type 0 = Set <= Type 1 <= ... 
+val pr_uni : Universe.t -> Pp.t
+
+(** The universes hierarchy: Type 0- = Prop <= Type 0 = Set <= Type 1 <= ...
    Typing of universes: Type 0-, Type 0 : Type 1; Type i : Type (i+1) if i>0 *)
-val type0m_univ : universe
-val type0_univ : universe
-val type1_univ : universe
+val type0m_univ : Universe.t
+val type0_univ : Universe.t
+val type1_univ : Universe.t
 
-val is_type0_univ : universe -> bool
-val is_type0m_univ : universe -> bool
-val is_univ_variable : universe -> bool
-val is_small_univ : universe -> bool
+val is_type0_univ : Universe.t -> bool
+val is_type0m_univ : Universe.t -> bool
+val is_univ_variable : Universe.t -> bool
+val is_small_univ : Universe.t -> bool
 
-val sup : universe -> universe -> universe
-val super : universe -> universe
+val sup : Universe.t -> Universe.t -> Universe.t
+val super : Universe.t -> Universe.t
 
-val universe_level : universe -> universe_level option
+val universe_level : Universe.t -> Level.t option
 
 (** [univ_level_mem l u] Is l is mentionned in u ? *)
 
-val univ_level_mem : universe_level -> universe -> bool
+val univ_level_mem : Level.t -> Universe.t -> bool
 
 (** [univ_level_rem u v min] removes [u] from [v], resulting in [min]
     if [v] was exactly [u]. *)
 
-val univ_level_rem : universe_level -> universe -> universe -> universe
+val univ_level_rem : Level.t -> Universe.t -> Universe.t -> Universe.t
 
 (** {6 Constraints. } *)
 
 type constraint_type = Lt | Le | Eq
-type univ_constraint = universe_level * constraint_type * universe_level
+type univ_constraint = Level.t * constraint_type * Level.t
 
 module Constraint : sig
  include Set.S with type elt = univ_constraint
 end
 
 type constraints = Constraint.t
+[@@ocaml.deprecated "Use Constraint.t"]
 
-val empty_constraint : constraints
-val union_constraint : constraints -> constraints -> constraints
-val eq_constraint : constraints -> constraints -> bool
+val empty_constraint : Constraint.t
+val union_constraint : Constraint.t -> Constraint.t -> Constraint.t
+val eq_constraint : Constraint.t -> Constraint.t -> bool
 
-(** A value with universe constraints. *)
-type 'a constrained = 'a * constraints
+(** A value with universe Constraint.t. *)
+type 'a constrained = 'a * Constraint.t
 
 (** Constrained *)
-val constraints_of : 'a constrained -> constraints
+val constraints_of : 'a constrained -> Constraint.t
 
-(** Enforcing constraints. *)
+(** Enforcing Constraint.t. *)
+type 'a constraint_function = 'a -> 'a -> Constraint.t -> Constraint.t
 
-type 'a constraint_function = 'a -> 'a -> constraints -> constraints
-
-val enforce_eq : universe constraint_function
-val enforce_leq : universe constraint_function
-val enforce_eq_level : universe_level constraint_function
-val enforce_leq_level : universe_level constraint_function
+val enforce_eq : Universe.t constraint_function
+val enforce_leq : Universe.t constraint_function
+val enforce_eq_level : Level.t constraint_function
+val enforce_leq_level : Level.t constraint_function
 
 (** Type explanation is used to decorate error messages to provide
   useful explanation why a given constraint is rejected. It is composed
@@ -194,19 +206,19 @@ val enforce_leq_level : universe_level constraint_function
   universes in the path are canonical. Note that each step does not
   necessarily correspond to an actual constraint, but reflect how the
   system stores the graph and may result from combination of several
-  constraints...
+  Constraint.t...
 *)
-type explanation = (constraint_type * universe) list
-type univ_inconsistency = constraint_type * universe * universe * explanation option
+type explanation = (constraint_type * Universe.t) list
+type univ_inconsistency = constraint_type * Universe.t * Universe.t * explanation option
 
 exception UniverseInconsistency of univ_inconsistency
 
 (** {6 Support for universe polymorphism } *)
 
 (** Polymorphic maps from universe levels to 'a *)
-module LMap : 
+module LMap :
 sig
-  include CMap.ExtS with type key = universe_level and module Set := LSet
+  include CMap.ExtS with type key = Level.t and module Set := LSet
 
   val union : 'a t -> 'a t -> 'a t
   (** [union x y] favors the bindings in the first map. *)
@@ -226,18 +238,33 @@ type 'a universe_map = 'a LMap.t
 
 (** {6 Substitution} *)
 
-type universe_subst_fn = universe_level -> universe
-type universe_level_subst_fn = universe_level -> universe_level
+type universe_subst_fn = Level.t -> Universe.t
+type universe_level_subst_fn = Level.t -> Level.t
 
 (** A full substitution, might involve algebraic universes *)
-type universe_subst = universe universe_map
-type universe_level_subst = universe_level universe_map
+type universe_subst = Universe.t universe_map
+type universe_level_subst = Level.t universe_map
+
+module Variance :
+sig
+  (** A universe position in the instance given to a cumulative
+     inductive can be the following. Note there is no Contravariant
+     case because [forall x : A, B <= forall x : A', B'] requires [A =
+     A'] as opposed to [A' <= A]. *)
+  type t = Irrelevant | Covariant | Invariant
+
+  (** [check_subtype x y] holds if variance [y] is also an instance of [x] *)
+  val check_subtype : t -> t -> bool
+
+  val sup : t -> t -> t
+
+  val pr : t -> Pp.t
 
-val level_subst_of : universe_subst_fn -> universe_level_subst_fn
+end
 
 (** {6 Universe instances} *)
 
-module Instance : 
+module Instance :
 sig
   type t
   (** A universe instance represents a vector of argument universes
@@ -270,7 +297,7 @@ sig
   val subst_fn : universe_level_subst_fn -> t -> t
   (** Substitution by a level-to-level function. *)
 
-  val pr : (Level.t -> Pp.t) -> t -> Pp.t
+  val pr : (Level.t -> Pp.t) -> ?variance:Variance.t array -> t -> Pp.t
   (** Pretty-printing, no comments *)
 
   val levels : t -> LSet.t
@@ -279,49 +306,51 @@ sig
 end
 
 type universe_instance = Instance.t
+[@@ocaml.deprecated "Use Instance.t"]
 
-val enforce_eq_instances : universe_instance constraint_function
+val enforce_eq_instances : Instance.t constraint_function
 
-type 'a puniverses = 'a * universe_instance
+type 'a puniverses = 'a * Instance.t
 val out_punivs : 'a puniverses -> 'a
 val in_punivs : 'a -> 'a puniverses
 
 val eq_puniverses : ('a -> 'a -> bool) -> 'a puniverses -> 'a puniverses -> bool
 
-(** A vector of universe levels with universe constraints,
-    representiong local universe variables and associated constraints *)
+(** A vector of universe levels with universe Constraint.t,
+    representiong local universe variables and associated Constraint.t *)
 
 module UContext :
-sig 
+sig
   type t
 
   val make : Instance.t constrained -> t
 
   val empty : t
   val is_empty : t -> bool
-    
+
   val instance : t -> Instance.t
-  val constraints : t -> constraints
+  val constraints : t -> Constraint.t
 
-  val dest : t -> Instance.t * constraints
+  val dest : t -> Instance.t * Constraint.t
 
   (** Keeps the order of the instances *)
   val union : t -> t -> t
 
-  (* the number of universes in the context *)
+  (** the number of universes in the context *)
   val size : t -> int
 
 end
 
 type universe_context = UContext.t
+[@@ocaml.deprecated "Use UContext.t"]
 
 module AUContext :
-sig 
+sig
   type t
 
   val repr : t -> UContext.t
   (** [repr ctx] is [(Var(0), ... Var(n-1) |= cstr] where [n] is the length of
-      the context and [cstr] the abstracted constraints. *)
+      the context and [cstr] the abstracted Constraint.t. *)
 
   val empty : t
   val is_empty : t -> bool
@@ -335,68 +364,69 @@ sig
   val union : t -> t -> t
 
   val instantiate : Instance.t -> t -> Constraint.t
-  (** Generate the set of instantiated constraints **)
+  (** Generate the set of instantiated Constraint.t **)
 
 end
 
 type abstract_universe_context = AUContext.t
+[@@ocaml.deprecated "Use AUContext.t"]
 
-(** Universe info for inductive types: A context of universe levels
-    with universe constraints, representing local universe variables
-    and constraints, together with a context of universe levels with
-    universe constraints, representing conditions for subtyping used
-    for inductive types.
+(** Universe info for cumulative inductive types: A context of
+   universe levels with universe constraints, representing local
+   universe variables and constraints, together with an array of
+   Variance.t.
 
-    This data structure maintains the invariant that the context for
-    subtyping constraints is exactly twice as big as the context for
-    universe constraints. *)
+    This data structure maintains the invariant that the variance
+   array has the same length as the universe instance. *)
 module CumulativityInfo :
 sig
   type t
 
-  val make : universe_context * universe_context -> t
+  val make : UContext.t * Variance.t array -> t
 
   val empty : t
   val is_empty : t -> bool
 
-  val univ_context : t -> universe_context
-  val subtyp_context : t -> universe_context
+  val univ_context : t -> UContext.t
+  val variance : t -> Variance.t array
 
   (** This function takes a universe context representing constraints
-      of an inductive and a Instance.t of fresh universe names for the
-      subtyping (with the same length as the context in the given
-      universe context) and produces a UInfoInd.t that with the
-      trivial subtyping relation. *)
-  val from_universe_context : universe_context -> universe_instance -> t
-
-  val subtyping_susbst : t -> universe_level_subst
+     of an inductive and produces a CumulativityInfo.t with the
+     trivial subtyping relation. *)
+  val from_universe_context : UContext.t -> t
 
+  val leq_constraints : t -> Instance.t constraint_function
+  val eq_constraints : t -> Instance.t constraint_function
 end
 
 type cumulativity_info = CumulativityInfo.t
+[@@ocaml.deprecated "Use CumulativityInfo.t"]
 
 module ACumulativityInfo :
 sig
   type t
 
-  val univ_context : t -> abstract_universe_context
-  val subtyp_context : t -> abstract_universe_context
+  val univ_context : t -> AUContext.t
+  val variance : t -> Variance.t array
+  val leq_constraints : t -> Instance.t constraint_function
+  val eq_constraints : t -> Instance.t constraint_function
 end
 
 type abstract_cumulativity_info = ACumulativityInfo.t
+[@@ocaml.deprecated "Use ACumulativityInfo.t"]
 
 (** Universe contexts (as sets) *)
 
 module ContextSet :
-sig 
-  type t = universe_set constrained
+sig
+  type t = LSet.t constrained
 
   val empty : t
   val is_empty : t -> bool
 
-  val singleton : universe_level -> t
+  val singleton : Level.t -> t
   val of_instance : Instance.t -> t
-  val of_set : universe_set -> t
+  val of_set : LSet.t -> t
 
   val equal : t -> t -> bool
   val union : t -> t -> t
@@ -406,38 +436,43 @@ sig
       much smaller than the right one. *)
 
   val diff : t -> t -> t
-  val add_universe : universe_level -> t -> t
-  val add_constraints : constraints -> t -> t
+  val add_universe : Level.t -> t -> t
+  val add_constraints : Constraint.t -> t -> t
   val add_instance : Instance.t -> t -> t
 
   (** Arbitrary choice of linear order of the variables *)
-  val to_context : t -> universe_context
-  val of_context : universe_context -> t
+  val sort_levels : Level.t array -> Level.t array
+  val to_context : t -> UContext.t
+  val of_context : UContext.t -> t
 
-  val constraints : t -> constraints
-  val levels : t -> universe_set
+  val constraints : t -> Constraint.t
+  val levels : t -> LSet.t
+
+  (** the number of universes in the context *)
+  val size : t -> int
 end
 
-(** A set of universes with universe constraints.
-    We linearize the set to a list after typechecking. 
+(** A set of universes with universe Constraint.t.
+    We linearize the set to a list after typechecking.
     Beware, representation could change.
 *)
 type universe_context_set = ContextSet.t
+[@@ocaml.deprecated "Use ContextSet.t"]
 
 (** A value in a universe context (resp. context set). *)
-type 'a in_universe_context = 'a * universe_context
-type 'a in_universe_context_set = 'a * universe_context_set
+type 'a in_universe_context = 'a * UContext.t
+type 'a in_universe_context_set = 'a * ContextSet.t
 
 val empty_level_subst : universe_level_subst
 val is_empty_level_subst : universe_level_subst -> bool
 
 (** Substitution of universes. *)
-val subst_univs_level_level : universe_level_subst -> universe_level -> universe_level
-val subst_univs_level_universe : universe_level_subst -> universe -> universe
-val subst_univs_level_constraints : universe_level_subst -> constraints -> constraints
+val subst_univs_level_level : universe_level_subst -> Level.t -> Level.t
+val subst_univs_level_universe : universe_level_subst -> Universe.t -> Universe.t
+val subst_univs_level_constraints : universe_level_subst -> Constraint.t -> Constraint.t
 val subst_univs_level_abstract_universe_context :
-  universe_level_subst -> abstract_universe_context -> abstract_universe_context
-val subst_univs_level_instance : universe_level_subst -> universe_instance -> universe_instance
+  universe_level_subst -> AUContext.t -> AUContext.t
+val subst_univs_level_instance : universe_level_subst -> Instance.t -> Instance.t
 
 (** Level to universe substitutions. *)
 
@@ -445,32 +480,37 @@ val empty_subst : universe_subst
 val is_empty_subst : universe_subst -> bool
 val make_subst : universe_subst -> universe_subst_fn
 
-val subst_univs_universe : universe_subst_fn -> universe -> universe
-val subst_univs_constraints : universe_subst_fn -> constraints -> constraints
+val subst_univs_universe : universe_subst_fn -> Universe.t -> Universe.t
+(** Only user in the kernel is template polymorphism. Ideally we get rid of
+    this code if it goes away. *)
 
 (** Substitution of instances *)
-val subst_instance_instance : universe_instance -> universe_instance -> universe_instance
-val subst_instance_universe : universe_instance -> universe -> universe
+val subst_instance_instance : Instance.t -> Instance.t -> Instance.t
+val subst_instance_universe : Instance.t -> Universe.t -> Universe.t
 
-val make_instance_subst : universe_instance -> universe_level_subst
-val make_inverse_instance_subst : universe_instance -> universe_level_subst
+val make_instance_subst : Instance.t -> universe_level_subst
+(** Creates [u(0) ↦ 0; ...; u(n-1) ↦ n - 1] out of [u(0); ...; u(n - 1)] *)
 
-val abstract_universes : universe_context -> universe_level_subst * abstract_universe_context
+val make_inverse_instance_subst : Instance.t -> universe_level_subst
 
-val abstract_cumulativity_info : cumulativity_info -> universe_level_subst * abstract_cumulativity_info
+val abstract_universes : UContext.t -> Instance.t * AUContext.t
+val abstract_cumulativity_info : CumulativityInfo.t -> Instance.t * ACumulativityInfo.t
+(** TODO: move universe abstraction out of the kernel *)
 
-val make_abstract_instance : abstract_universe_context -> universe_instance
+val make_abstract_instance : AUContext.t -> Instance.t
 
 (** {6 Pretty-printing of universes. } *)
 
 val pr_constraint_type : constraint_type -> Pp.t
-val pr_constraints : (Level.t -> Pp.t) -> constraints -> Pp.t
-val pr_universe_context : (Level.t -> Pp.t) -> universe_context -> Pp.t
-val pr_cumulativity_info : (Level.t -> Pp.t) -> cumulativity_info -> Pp.t
-val pr_abstract_universe_context : (Level.t -> Pp.t) -> abstract_universe_context -> Pp.t
-val pr_abstract_cumulativity_info : (Level.t -> Pp.t) -> abstract_cumulativity_info -> Pp.t
-val pr_universe_context_set : (Level.t -> Pp.t) -> universe_context_set -> Pp.t
-val explain_universe_inconsistency : (Level.t -> Pp.t) -> 
+val pr_constraints : (Level.t -> Pp.t) -> Constraint.t -> Pp.t
+val pr_universe_context : (Level.t -> Pp.t) -> ?variance:Variance.t array ->
+  UContext.t -> Pp.t
+val pr_cumulativity_info : (Level.t -> Pp.t) -> CumulativityInfo.t -> Pp.t
+val pr_abstract_universe_context : (Level.t -> Pp.t) -> ?variance:Variance.t array ->
+  AUContext.t -> Pp.t
+val pr_abstract_cumulativity_info : (Level.t -> Pp.t) -> ACumulativityInfo.t -> Pp.t
+val pr_universe_context_set : (Level.t -> Pp.t) -> ContextSet.t -> Pp.t
+val explain_universe_inconsistency : (Level.t -> Pp.t) ->
   univ_inconsistency -> Pp.t
 
 val pr_universe_level_subst : universe_level_subst -> Pp.t
@@ -478,23 +518,28 @@ val pr_universe_subst : universe_subst -> Pp.t
 
 (** {6 Hash-consing } *)
 
-val hcons_univ : universe -> universe
-val hcons_constraints : constraints -> constraints
-val hcons_universe_set : universe_set -> universe_set
-val hcons_universe_context : universe_context -> universe_context
-val hcons_abstract_universe_context : abstract_universe_context -> abstract_universe_context
-val hcons_universe_context_set : universe_context_set -> universe_context_set 
-val hcons_cumulativity_info : cumulativity_info -> cumulativity_info
-val hcons_abstract_cumulativity_info : abstract_cumulativity_info -> abstract_cumulativity_info
+val hcons_univ : Universe.t -> Universe.t
+val hcons_constraints : Constraint.t -> Constraint.t
+val hcons_universe_set : LSet.t -> LSet.t
+val hcons_universe_context : UContext.t -> UContext.t
+val hcons_abstract_universe_context : AUContext.t -> AUContext.t
+val hcons_universe_context_set : ContextSet.t -> ContextSet.t
+val hcons_cumulativity_info : CumulativityInfo.t -> CumulativityInfo.t
+val hcons_abstract_cumulativity_info : ACumulativityInfo.t -> ACumulativityInfo.t
 
 (******)
 
 (* deprecated: use qualified names instead *)
-val compare_levels : universe_level -> universe_level -> int
-val eq_levels : universe_level -> universe_level -> bool
+val compare_levels : Level.t -> Level.t -> int
+[@@ocaml.deprecated "Use Level.compare"]
+
+val eq_levels : Level.t -> Level.t -> bool
+[@@ocaml.deprecated "Use Level.equal"]
 
 (** deprecated: Equality of formal universe expressions. *)
-val equal_universes : universe -> universe -> bool
+val equal_universes : Universe.t -> Universe.t -> bool
+[@@ocaml.deprecated "Use Universe.equal"]
 
-(** Universes of constraints *)
-val universes_of_constraints : constraints -> universe_set
+(** Universes of Constraint.t *)
+val universes_of_constraints : Constraint.t -> LSet.t
+[@@ocaml.deprecated "Use Constraint.universes_of"]
diff --git a/kernel/vars.ml b/kernel/vars.ml
index d0dad02ec..b3b3eff62 100644
--- a/kernel/vars.ml
+++ b/kernel/vars.ml
@@ -133,8 +133,8 @@ let substn_many lamv n c =
     substrec n c
 
 (*
-let substkey = Profile.declare_profile "substn_many";;
-let substn_many lamv n c = Profile.profile3 substkey substn_many lamv n c;;
+let substkey = CProfile.declare_profile "substn_many";;
+let substn_many lamv n c = CProfile.profile3 substkey substn_many lamv n c;;
 *)
 
 let make_subst = function
@@ -235,49 +235,6 @@ let subst_vars subst c = substn_vars 1 subst c
 (** Universe substitutions *)
 open Constr
 
-let subst_univs_fn_puniverses fn =
-  let f = Univ.Instance.subst_fn fn in
-    fun ((c, u) as x) -> let u' = f u in if u' == u then x else (c, u')
-
-let subst_univs_fn_constr f c =
-  let changed = ref false in
-  let fu = Univ.subst_univs_universe f in
-  let fi = Univ.Instance.subst_fn (Univ.level_subst_of f) in
-  let rec aux t = 
-    match kind t with
-    | Sort (Sorts.Type u) -> 
-      let u' = fu u in
-	if u' == u then t else 
-	  (changed := true; mkSort (Sorts.sort_of_univ u'))
-    | Const (c, u) -> 
-      let u' = fi u in 
-	if u' == u then t
-	else (changed := true; mkConstU (c, u'))
-    | Ind (i, u) ->
-      let u' = fi u in 
-	if u' == u then t
-	else (changed := true; mkIndU (i, u'))
-    | Construct (c, u) ->
-      let u' = fi u in 
-	if u' == u then t
-	else (changed := true; mkConstructU (c, u'))
-    | _ -> map aux t
-  in 
-  let c' = aux c in
-    if !changed then c' else c
-
-let subst_univs_constr subst c =
-  if Univ.is_empty_subst subst then c
-  else 
-    let f = Univ.make_subst subst in
-      subst_univs_fn_constr f c
-
-let subst_univs_constr = 
-  if Flags.profile then
-    let subst_univs_constr_key = Profile.declare_profile "subst_univs_constr" in
-      Profile.profile2 subst_univs_constr_key subst_univs_constr
-  else subst_univs_constr
-
 let subst_univs_level_constr subst c =
   if Univ.is_empty_level_subst subst then c
   else 
@@ -347,12 +304,12 @@ let subst_instance_constr subst c =
     in
     aux c
 
-(* let substkey = Profile.declare_profile "subst_instance_constr";; *)
-(* let subst_instance_constr inst c = Profile.profile2 substkey subst_instance_constr inst c;; *)
+(* let substkey = CProfile.declare_profile "subst_instance_constr";; *)
+(* let subst_instance_constr inst c = CProfile.profile2 substkey subst_instance_constr inst c;; *)
 
 let subst_instance_context s ctx = 
   if Univ.Instance.is_empty s then ctx
   else Context.Rel.map (fun x -> subst_instance_constr s x) ctx
 
-type id_key = constant tableKey
+type id_key = Constant.t tableKey
 let eq_id_key x y = Names.eq_table_key Constant.equal x y
diff --git a/kernel/vars.mli b/kernel/vars.mli
index 59dc09a75..b74d25260 100644
--- a/kernel/vars.mli
+++ b/kernel/vars.mli
@@ -129,20 +129,14 @@ val subst_var : Id.t -> constr -> constr
 
 open Univ
 
-val subst_univs_fn_constr : universe_subst_fn -> constr -> constr
-val subst_univs_fn_puniverses : universe_level_subst_fn -> 
-  'a puniverses -> 'a puniverses
-
-val subst_univs_constr : universe_subst -> constr -> constr
-
 (** Level substitutions for polymorphism. *)
 
 val subst_univs_level_constr : universe_level_subst -> constr -> constr
 val subst_univs_level_context : Univ.universe_level_subst -> Context.Rel.t -> Context.Rel.t
 
 (** Instance substitution for polymorphism. *)
-val subst_instance_constr : universe_instance -> constr -> constr
-val subst_instance_context : universe_instance -> Context.Rel.t -> Context.Rel.t
+val subst_instance_constr : Instance.t -> constr -> constr
+val subst_instance_context : Instance.t -> Context.Rel.t -> Context.Rel.t
 
-type id_key = constant tableKey
+type id_key = Constant.t tableKey
 val eq_id_key : id_key -> id_key -> bool
diff --git a/kernel/vconv.ml b/kernel/vconv.ml
index 0e452621c..8c7658147 100644
--- a/kernel/vconv.ml
+++ b/kernel/vconv.ml
@@ -3,6 +3,7 @@ open Names
 open Environ
 open Reduction
 open Vm
+open Vmvalues
 open Csymtable
 
 let val_of_constr env c =
@@ -93,7 +94,7 @@ and conv_atom env pb k a1 stk1 a2 stk2 cu =
         let mib = Environ.lookup_mind mi env in
 	let ulen = 
           match mib.Declarations.mind_universes with
-          | Declarations.Monomorphic_ind ctx -> Univ.UContext.size ctx
+          | Declarations.Monomorphic_ind ctx -> Univ.ContextSet.size ctx
           | Declarations.Polymorphic_ind auctx -> Univ.AUContext.size auctx
           | Declarations.Cumulative_ind cumi -> 
             Univ.AUContext.size (Univ.ACumulativityInfo.univ_context cumi)
@@ -204,4 +205,4 @@ let vm_conv cv_pb env t1 t2 =
     let univs = (univs, checked_universes) in
     let _ = vm_conv_gen cv_pb env univs t1 t2 in ()
 
-let _ = Reduction.set_vm_conv vm_conv
+let _ = if Coq_config.bytecode_compiler then Reduction.set_vm_conv vm_conv
diff --git a/kernel/vconv.mli b/kernel/vconv.mli
index f4e680c69..c3c9636e8 100644
--- a/kernel/vconv.mli
+++ b/kernel/vconv.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Term
+open Constr
 open Environ
 open Reduction
 
@@ -19,4 +19,4 @@ val vm_conv : conv_pb -> types kernel_conversion_function
 val vm_conv_gen : conv_pb -> (types, 'a) generic_conversion_function
 
 (** Precompute a VM value from a constr *)
-val val_of_constr : env -> constr -> values
+val val_of_constr : env -> constr -> Vmvalues.values
diff --git a/kernel/vm.ml b/kernel/vm.ml
index 6b7a86d6f..352ea74a4 100644
--- a/kernel/vm.ml
+++ b/kernel/vm.ml
@@ -6,46 +6,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Names
-open Term
 open Cbytecodes
+open Vmvalues
 
 external set_drawinstr : unit -> unit = "coq_set_drawinstr"
 
-(******************************************)
-(* Utility Functions about Obj ************)
-(******************************************)
-
-external offset_closure : Obj.t -> int -> Obj.t = "coq_offset_closure"
-external offset : Obj.t -> int = "coq_offset"
-
-(*******************************************)
-(* Initalization of the abstract machine ***)
-(*******************************************)
-
-external init_vm : unit -> unit = "init_coq_vm"
-
-let _ = init_vm ()
-
-(*******************************************)
-(* Machine code *** ************************)
-(*******************************************)
-
-type tcode
-let tcode_of_obj v = ((Obj.obj v):tcode)
-let fun_code v = tcode_of_obj (Obj.field (Obj.repr v) 0)
-
-external mkAccuCode : int -> tcode = "coq_makeaccu"
 external mkPopStopCode : int -> tcode = "coq_pushpop"
 
-external offset_tcode : tcode -> int -> tcode = "coq_offset_tcode"
-external int_tcode : tcode -> int -> int = "coq_int_tcode"
-
-external accumulate : unit -> tcode = "accumulate_code"
-let accumulate = accumulate ()
-
-external is_accumulate : tcode -> bool = "coq_is_accumulate_code"
-
 let popstop_tbl =  ref (Array.init 30 mkPopStopCode)
 
 let popstop_code i =
@@ -61,106 +28,6 @@ let popstop_code i =
 
 let stop = popstop_code 0
 
-(******************************************************)
-(* Abstract data types and utility functions **********)
-(******************************************************)
-
-(* Values of the abstract machine *)
-let val_of_obj v = ((Obj.obj v):values)
-let crazy_val = (val_of_obj (Obj.repr 0))
-
-(* Abstract data *)
-type vprod
-type vfun
-type vfix
-type vcofix
-type vblock 
-type arguments
-
-type vm_env
-type vstack = values array
-
-type vswitch = {
-    sw_type_code : tcode;
-    sw_code : tcode;
-    sw_annot : annot_switch;
-    sw_stk : vstack;
-    sw_env : vm_env
-  }
-
-(* Representation of values *)
-(* + Products : *)
-(*   -   vprod = 0_[ dom | codom]                                         *)
-(*             dom : values, codom : vfun                                 *)
-(*                                                                        *)
-(* + Functions have two representations :                                 *)
-(*   - unapplied fun :  vf = Ct_[ C | fv1 | ... | fvn]                    *)
-(*                                       C:tcode, fvi : values            *)
-(*     Remark : a function and its environment is the same value.         *)
-(*   - partially applied fun : Ct_[Restart:C| vf | arg1 | ... argn]       *)
-(*                                                                        *)
-(* + Fixpoints :                                                          *)
-(*   -        Ct_[C1|Infix_t|C2|...|Infix_t|Cn|fv1|...|fvn]               *)
-(*     One single block to represent all of the fixpoints, each fixpoint  *)
-(*     is the pointer to the field holding the pointer to its code, and   *)
-(*     the infix tag is used to know where the block starts.              *)
-(*   - Partial application follows the scheme of partially applied        *)
-(*     functions. Note: only fixpoints not having been applied to its     *)
-(*     recursive argument are coded this way. When the rec. arg. is       *)
-(*     applied, either it's a constructor and the fix reduces, or it's    *)
-(*     and the fix is coded as an accumulator.                            *)
-(*                                                                        *)
-(* + Cofixpoints : see cbytegen.ml                                        *)
-(*                                                                        *)
-(* + vblock's encode (non constant) constructors as in Ocaml, but         *)
-(*   starting from 0 up. tag 0 ( = accu_tag) is reserved for              *)
-(*   accumulators.                                                        *)
-(*                                                                        *)
-(* + vm_env is the type of the machine environments (i.e. a function or   *)
-(*   a fixpoint)                                                          *)
-(*                                                                        *)
-(* + Accumulators : At_[accumulate| accu | arg1 | ... | argn ]            *)
-(*   - representation of [accu] : tag_[....]                              *)
-(*     -- tag <= 3 : encoding atom type (sorts, free vars, etc.)          *)
-(*     -- 10_[accu|proj name] : a projection blocked by an accu           *)
-(*     -- 11_[accu|fix_app] : a fixpoint blocked by an accu               *)
-(*     -- 12_[accu|vswitch] : a match blocked by an accu                  *)
-(*     -- 13_[fcofix]       : a cofix function                            *)
-(*     -- 14_[fcofix|val]   : a cofix function, val represent the value   *)
-(*        of the function applied to arg1 ... argn                        *)
-(* The [arguments] type, which is abstracted as an array, represents :    *)
-(*          tag[ _ | _ |v1|... | vn]                                      *)
-(* Generally the first field is a code pointer.                           *)
-
-(* Do not edit this type without editing C code, especially "coq_values.h" *)
-
-type atom =
-  | Aid of Vars.id_key
-  | Aind of inductive
-  | Atype of Univ.universe
-
-(* Zippers *)
-
-type zipper =
-  | Zapp of arguments
-  | Zfix of vfix*arguments  (* Possibly empty *)
-  | Zswitch of vswitch
-  | Zproj of Constant.t (* name of the projection *)
-
-type stack = zipper list
-
-type to_up = values
-
-type whd =
-  | Vsort of sorts
-  | Vprod of vprod
-  | Vfun of vfun
-  | Vfix of vfix * arguments option
-  | Vcofix of vcofix * to_up * arguments option
-  | Vconstr_const of int
-  | Vconstr_block of vblock
-  | Vatom_stk of atom * stack
-  | Vuniv_level of Univ.universe_level
 
 (************************************************)
 (* Abstract machine *****************************)
@@ -177,389 +44,72 @@ external push_vstack : vstack -> int -> unit = "coq_push_vstack"
 external interprete : tcode -> values -> vm_env -> int -> values =
   "coq_interprete_ml"
 
-
-
 (* Functions over arguments *)
-let nargs : arguments -> int = fun args -> (Obj.size (Obj.repr args)) - 2
-let arg args i =
-  if  0 <= i && i < (nargs args) then
-    val_of_obj (Obj.field (Obj.repr args) (i+2))
-  else invalid_arg
-		("Vm.arg size = "^(string_of_int (nargs args))^
-		 " acces "^(string_of_int i))
 
 (* Apply a value to arguments contained in [vargs] *)
 let apply_arguments vf vargs =
   let n = nargs vargs in
-  if Int.equal n 0 then vf
+  if Int.equal n 0 then fun_val vf
   else
    begin
      push_ra stop;
      push_arguments vargs;
-     interprete (fun_code vf) vf (Obj.magic vf) (n - 1)
+     interprete (fun_code vf) (fun_val vf) (fun_env vf) (n - 1)
    end
 
 (* Apply value [vf] to an array of argument values [varray] *)
 let apply_varray vf varray =
   let n = Array.length varray in
-  if Int.equal n 0 then vf
+  if Int.equal n 0 then fun_val vf
   else
     begin
       push_ra stop;
       (* 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)
+      interprete (fun_code vf) (fun_val vf) (fun_env vf) (n - 1)
     end
 
-(*************************************************)
-(* Destructors ***********************************)
-(*************************************************)
-
-let uni_lvl_val (v : values) : Univ.universe_level =
-    let whd = Obj.magic v in
-    match whd with
-    | Vuniv_level lvl -> lvl
-    | _ ->
-      let pr =
-        let open Pp in
-        match whd with
-        | Vsort _ -> str "Vsort"
-        | Vprod _ -> str "Vprod"
-        | Vfun _ -> str "Vfun"
-        | Vfix _ -> str "Vfix"
-        | Vcofix _ -> str "Vcofix"
-        | Vconstr_const i -> str "Vconstr_const"
-        | Vconstr_block b -> str "Vconstr_block"
-        | Vatom_stk (a,stk) -> str "Vatom_stk"
-        | _ -> assert false
-      in
-      CErrors.anomaly
-        Pp.(   strbrk "Parsing virtual machine value expected universe level, got "
-            ++ pr ++ str ".")
-
-let rec whd_accu a stk =
-  let stk =
-    if Int.equal (Obj.size a) 2 then stk
-    else Zapp (Obj.obj a) :: stk in
-  let at = Obj.field a 1 in
-  match Obj.tag at with
-  | i when Int.equal i type_atom_tag ->
-     begin match stk with
-     | [Zapp args] ->
-	let u = ref (Obj.obj (Obj.field at 0)) in
-	for i = 0 to nargs args - 1 do
-	  u := Univ.Universe.sup !u (Univ.Universe.make (uni_lvl_val (arg args i)))
-	done;
-	Vsort (Type !u)
-     | _ -> assert false
-     end
-  | i when i <= max_atom_tag ->
-      Vatom_stk(Obj.magic at, stk)
-  | i when Int.equal i proj_tag ->
-     let zproj = Zproj (Obj.obj (Obj.field at 0)) in
-     whd_accu (Obj.field at 1) (zproj :: stk)
-  | i when Int.equal i fix_app_tag ->
-      let fa = Obj.field at 1 in
-      let zfix  =
-	Zfix (Obj.obj (Obj.field fa 1), Obj.obj fa) in
-      whd_accu (Obj.field at 0) (zfix :: stk)
-  | i when Int.equal i switch_tag ->
-      let zswitch = Zswitch (Obj.obj (Obj.field at 1)) in
-      whd_accu (Obj.field at 0) (zswitch :: stk)
-  | i when Int.equal i cofix_tag ->
-      let vcfx = Obj.obj (Obj.field at 0) in
-      let to_up = Obj.obj a in
-      begin match stk with
-      | []          -> Vcofix(vcfx, to_up, None)
-      | [Zapp args] -> Vcofix(vcfx, to_up, Some args)
-      | _           -> assert false
-      end
-  | i when Int.equal i cofix_evaluated_tag ->
-      let vcofix = Obj.obj (Obj.field at 0) in
-      let res = Obj.obj a in
-      begin match stk with
-      | []          -> Vcofix(vcofix, res, None)
-      | [Zapp args] -> Vcofix(vcofix, res, Some args)
-      | _           -> assert false
-      end
-  | tg ->
-    CErrors.anomaly
-      Pp.(strbrk "Failed to parse VM value. Tag = " ++ int tg ++ str ".")
-
-external kind_of_closure : Obj.t -> int = "coq_kind_of_closure"
-
-let whd_val : values -> whd =
-  fun v ->
-    let o = Obj.repr v in
-    if Obj.is_int o then Vconstr_const (Obj.obj o)
-    else
-      let tag = Obj.tag o in
-      if tag = accu_tag then
-	(
-	if Int.equal (Obj.size o) 1 then Obj.obj o (* sort *)
-        else
-	  if is_accumulate (fun_code o) then whd_accu o []
-	  else Vprod(Obj.obj o))
-      else
-	if tag = Obj.closure_tag || tag = Obj.infix_tag then
-	  (match kind_of_closure o with
-	   | 0 -> Vfun(Obj.obj o)
-	   | 1 -> Vfix(Obj.obj o, None)
-	   | 2 -> Vfix(Obj.obj (Obj.field o 1), Some (Obj.obj o))
-	   | 3 -> Vatom_stk(Aid(RelKey(int_tcode (fun_code o) 1)), [])
-	   | _ -> CErrors.anomaly ~label:"Vm.whd " (Pp.str "kind_of_closure does not work."))
-	else
-           Vconstr_block(Obj.obj o)
-
-(**********************************************)
-(* Constructors *******************************)
-(**********************************************)
-
-let obj_of_atom : atom -> Obj.t =
-  fun a ->
-    let res = Obj.new_block accu_tag 2 in
-    Obj.set_field res 0 (Obj.repr accumulate);
-    Obj.set_field res 1 (Obj.repr a);
-    res
-
-(* obj_of_str_const : structured_constant -> Obj.t *)
-let rec obj_of_str_const str =
-  match str with
-  | Const_sorts s -> Obj.repr (Vsort s)
-  | Const_ind ind -> obj_of_atom (Aind ind)
-  | Const_proj p -> Obj.repr p
-  | Const_b0 tag -> Obj.repr tag
-  | Const_bn(tag, args) ->
-      let len = Array.length args in
-      let res = Obj.new_block tag len in
-      for i = 0 to len - 1 do
-	Obj.set_field res i (obj_of_str_const args.(i))
-      done;
-      res
-  | Const_univ_level l -> Obj.repr (Vuniv_level l)
-  | Const_type u -> obj_of_atom (Atype u)
-
-let val_of_obj o = ((Obj.obj o) : values)
-
-let val_of_str_const str = val_of_obj (obj_of_str_const str)
-
-let val_of_atom a = val_of_obj (obj_of_atom a)
-
-let atom_of_proj kn v =
-  let r = Obj.new_block proj_tag 2 in
-  Obj.set_field r 0 (Obj.repr kn);
-  Obj.set_field r 1 (Obj.repr v);
-  ((Obj.obj r) : atom)
-
-let val_of_proj kn v =
-  val_of_atom (atom_of_proj kn v)
-
-module IdKeyHash =
-struct
-  type t = constant tableKey
-  let equal = Names.eq_table_key Constant.equal
-  open Hashset.Combine
-  let hash = function
-  | ConstKey c -> combinesmall 1 (Constant.hash c)
-  | VarKey id -> combinesmall 2 (Id.hash id)
-  | RelKey i -> combinesmall 3 (Int.hash i)
-end
-
-module KeyTable = Hashtbl.Make(IdKeyHash)
-
-let idkey_tbl = KeyTable.create 31
-
-let val_of_idkey key =
-  try KeyTable.find idkey_tbl key
-  with Not_found ->
-    let v = val_of_atom (Aid key) in
-    KeyTable.add idkey_tbl key v;
-    v
-
-let val_of_rel k = val_of_idkey (RelKey k)
-
-let val_of_named id = val_of_idkey (VarKey id)
-
-let val_of_constant c = val_of_idkey (ConstKey c)
-
-external val_of_annot_switch : annot_switch -> values = "%identity"
-
+(* Functions over vfun *)
 let mkrel_vstack k arity =
   let max = k + arity - 1 in
   Array.init arity (fun i -> val_of_rel (max - i))
 
-
-(*************************************************)
-(** Operations manipulating data types ***********)
-(*************************************************)
-
-(* Functions over products *)
-
-let dom : vprod -> values = fun p -> val_of_obj (Obj.field (Obj.repr p) 0)
-let codom : vprod -> vfun = fun p -> (Obj.obj (Obj.field (Obj.repr p) 1))
-
-(* Functions over vfun *)
-
-external closure_arity : vfun -> int = "coq_closure_arity"
-
-let body_of_vfun k vf =
+let reduce_fun k vf =
   let vargs = mkrel_vstack k 1 in
-  apply_varray (Obj.magic vf) vargs
+  apply_varray vf vargs
 
 let decompose_vfun2 k vf1 vf2 =
   let arity = min (closure_arity vf1) (closure_arity vf2) in
   assert (0 < arity && arity < Sys.max_array_length);
   let vargs = mkrel_vstack k arity in
-  let v1 = apply_varray (Obj.magic vf1) vargs in
-  let v2 = apply_varray (Obj.magic vf2) vargs in
+  let v1 = apply_varray vf1 vargs in
+  let v2 = apply_varray vf2 vargs in
   arity, v1, v2
 
-(* Functions over fixpoint *)
-
-let first o = (offset_closure o (offset o))
-let last o = (Obj.field o (Obj.size o - 1))
-
-let current_fix vf = - (offset (Obj.repr vf) / 2)
-
-let unsafe_fb_code fb i = tcode_of_obj (Obj.field (Obj.repr fb) (2 * i))
-
-let unsafe_rec_arg fb i = int_tcode (unsafe_fb_code fb i) 1
-
-let rec_args vf =
-  let fb = first (Obj.repr vf) in
-  let size = Obj.size (last fb) in
-  Array.init size (unsafe_rec_arg fb)
-
-exception FALSE
-
-let check_fix f1 f2 =
-  let i1, i2 = current_fix f1, current_fix f2 in
-  (* Checking starting point *)
-  if i1 = i2 then
-    let fb1,fb2 = first (Obj.repr f1), first (Obj.repr f2) in
-    let n = Obj.size (last fb1) in
-    (* Checking number of definitions *)
-    if n = Obj.size (last fb2) then
-      (* Checking recursive arguments *)
-      try
-	for i = 0 to n - 1 do
-	  if unsafe_rec_arg fb1 i <> unsafe_rec_arg fb2 i
-	  then raise FALSE
-	done;
-	true
-      with FALSE -> false
-    else false
-  else false
-
 (* Functions over vfix *)
-external atom_rel : unit -> atom array = "get_coq_atom_tbl"
-external realloc_atom_rel : int -> unit = "realloc_coq_atom_tbl"
-
-let relaccu_tbl =
-  let atom_rel = atom_rel() in
-  let len = Array.length atom_rel in
-  for i = 0 to len - 1 do atom_rel.(i) <- Aid (RelKey i) done;
-  ref (Array.init len mkAccuCode)
-
-let relaccu_code i =
-  let len = Array.length !relaccu_tbl in
-  if i < len then !relaccu_tbl.(i)
-  else
-    begin
-      realloc_atom_rel i;
-      let atom_rel = atom_rel () in
-      let nl = Array.length atom_rel in
-      for j = len to nl - 1 do atom_rel.(j) <- Aid(RelKey j) done;
-      relaccu_tbl :=
-	Array.init nl
-	  (fun j -> if j < len then !relaccu_tbl.(j) else mkAccuCode j);
-      !relaccu_tbl.(i)
-    end
 
 let reduce_fix k vf =
-  let fb = first (Obj.repr vf) in
+  let fb = first_fix vf in
   (* computing types *)
-  let fc_typ = ((Obj.obj (last fb)) : tcode array) in
+  let fc_typ = fix_types fb in
   let ndef = Array.length fc_typ in
-  let et = offset_closure fb (2*(ndef - 1)) in
+  let et = offset_closure_fix fb (2*(ndef - 1)) in
   let ftyp =
     Array.map
-      (fun c -> interprete c crazy_val (Obj.magic et) 0) fc_typ in
+      (fun c -> interprete c crazy_val et 0) fc_typ in
   (* Construction of the environment of fix bodies *)
-  let e = Obj.dup fb in
-  for i = 0 to ndef - 1 do
-    Obj.set_field e (2 * i) (Obj.repr (relaccu_code (k + i)))
-  done;
-  let fix_body i =
-    let jump_grabrec c = offset_tcode c 2 in
-    let c = jump_grabrec (unsafe_fb_code fb i)  in
-    let res = Obj.new_block Obj.closure_tag 2 in
-    Obj.set_field res 0 (Obj.repr c);
-    Obj.set_field res 1 (offset_closure e (2*i));
-    ((Obj.obj res) : vfun)  in
-  (Array.init ndef fix_body, ftyp)
-
-(* Functions over vcofix *)
-
-let get_fcofix vcf i =
-  match whd_val (Obj.obj (Obj.field (Obj.repr vcf) (i+1))) with
-  | Vcofix(vcfi, _, _) -> vcfi
-  | _ -> assert false
-
-let current_cofix vcf =
-  let ndef = Obj.size (last (Obj.repr vcf)) in
-  let rec find_cofix pos =
-    if pos < ndef then
-      if get_fcofix vcf pos == vcf then pos
-      else find_cofix (pos+1)
-    else raise Not_found in
-  try find_cofix 0
-  with Not_found -> assert false
-
-let check_cofix vcf1 vcf2 =
-  (current_cofix vcf1 = current_cofix vcf2) &&
-  (Obj.size (last (Obj.repr vcf1)) = Obj.size (last (Obj.repr vcf2)))
+  (mk_fix_body k ndef fb, ftyp)
 
 let reduce_cofix k vcf =
-  let fc_typ = ((Obj.obj (last (Obj.repr vcf))) : tcode array) in
+  let fc_typ = cofix_types vcf in
   let ndef = Array.length fc_typ in
   let ftyp =
     (* Evaluate types *)
-    Array.map (fun c -> interprete c crazy_val (Obj.magic vcf) 0) fc_typ in
+    Array.map (fun c -> interprete c crazy_val (cofix_env vcf) 0) fc_typ in
 
   (* Construction of the environment of cofix bodies *)
-  let e = Obj.dup (Obj.repr vcf) in
-  for i = 0 to ndef - 1 do
-    Obj.set_field e (i+1) (Obj.repr (val_of_rel (k+i)))
-  done;
-
-  let cofix_body i =
-    let vcfi = get_fcofix vcf i in
-    let c = Obj.field (Obj.repr vcfi) 0 in
-    Obj.set_field e 0 c;
-    let atom = Obj.new_block cofix_tag 1 in
-    let self = Obj.new_block accu_tag 2 in
-    Obj.set_field self 0 (Obj.repr accumulate);
-    Obj.set_field self 1 (Obj.repr atom);
-    apply_varray (Obj.obj e) [|Obj.obj self|] in
-  (Array.init ndef cofix_body, ftyp)
-
-
-(* Functions over vblock *)
-
-let btag : vblock -> int = fun b -> Obj.tag (Obj.repr b)
-let bsize : vblock -> int = fun b -> Obj.size (Obj.repr b)
-let bfield b i =
-  if 0 <= i && i < (bsize b) then val_of_obj (Obj.field (Obj.repr b) i)
-  else invalid_arg "Vm.bfield"
-
-
-(* Functions over vswitch *)
-
-let check_switch sw1 sw2 = sw1.sw_annot.rtbl = sw2.sw_annot.rtbl
-
-let case_info sw = sw.sw_annot.ci
+  (mk_cofix_body apply_varray k ndef vcf, ftyp)
 
 let type_of_switch sw =
   (* The fun code of types will make sure we have enough stack, so we put 0
@@ -567,20 +117,6 @@ let type_of_switch sw =
   push_vstack sw.sw_stk 0;
   interprete sw.sw_type_code crazy_val sw.sw_env 0
 
-let branch_arg k (tag,arity) =
-  if Int.equal arity 0 then  ((Obj.magic tag):values)
-  else
-    let b, ofs = 
-      if tag < last_variant_tag then Obj.new_block tag arity, 0
-      else
-        let b = Obj.new_block last_variant_tag (arity+1) in
-        Obj.set_field b 0 (Obj.repr (tag-last_variant_tag));
-        b,1 in
-    for i = ofs to ofs + arity - 1 do
-      Obj.set_field b i (Obj.repr (val_of_rel (k+i)))
-    done;
-    val_of_obj b
-
 let apply_switch sw arg =
   let tc = sw.sw_annot.tailcall in
   if tc then
@@ -602,8 +138,8 @@ let branch_of_switch k sw =
 (* t = a stk --> t v *)
 let rec apply_stack a stk v =
   match stk with
-  | [] -> apply_varray a [|v|]
-  | Zapp args :: stk -> apply_stack (apply_arguments a args) stk v
+  | [] -> apply_varray (fun_of_val a) [|v|]
+  | Zapp args :: stk -> apply_stack (apply_arguments (fun_of_val a) args) stk v
   | Zproj kn :: stk -> apply_stack (val_of_proj kn a) stk v
   | Zfix(f,args) :: stk ->
       let a,stk = 
@@ -614,7 +150,7 @@ let rec apply_stack a stk v =
 	    push_val a;
 	    push_arguments args;
 	    let a =
-	      interprete (fun_code f) (Obj.magic f) (Obj.magic f)
+              interprete (fix_code f) (fix_val f) (fix_env f)
 		(nargs args+ nargs args') in
 	    a, stk
 	| _ -> 
@@ -622,7 +158,7 @@ let rec apply_stack a stk v =
 	    push_val a;
 	    push_arguments args;
 	    let a =
-	      interprete (fun_code f) (Obj.magic f) (Obj.magic f)
+              interprete (fix_code f) (fix_val f) (fix_env f)
 		(nargs args) in
 	    a, stk in
       apply_stack a stk v
@@ -633,50 +169,21 @@ let apply_whd k whd =
   let v = val_of_rel k in
   match whd with
   | Vsort _ | Vprod _ | Vconstr_const _ | Vconstr_block _ -> assert false
-  | Vfun f -> body_of_vfun k f
+  | Vfun f -> reduce_fun k f
   | Vfix(f, None) -> 
       push_ra stop;
       push_val v;
-      interprete (fun_code f) (Obj.magic f) (Obj.magic f) 0
+      interprete (fix_code f) (fix_val f) (fix_env f) 0
   | Vfix(f, Some args) ->
       push_ra stop;
       push_val v;
       push_arguments args;
-      interprete (fun_code f) (Obj.magic f) (Obj.magic f) (nargs args) 
+      interprete (fix_code f) (fix_val f) (fix_env f) (nargs args)
   | Vcofix(_,to_up,_) ->
       push_ra stop;
       push_val v;
-      interprete (fun_code to_up) (Obj.magic to_up) (Obj.magic to_up) 0
+      interprete (cofix_upd_code to_up) (cofix_upd_val to_up) (cofix_upd_env to_up) 0
   | Vatom_stk(a,stk) ->
       apply_stack (val_of_atom a) stk v 
   | Vuniv_level lvl -> assert false
 
-let rec pr_atom a =
-  Pp.(match a with
-  | Aid c -> str "Aid(" ++ (match c with
-                            | ConstKey c -> Names.pr_con c
-			    | RelKey i -> str "#" ++ int i
-			    | _ -> str "...") ++ str ")"
-  | Aind (mi,i) -> str "Aind(" ++ Names.pr_mind mi ++ str "#" ++ int i ++ str ")"
-  | Atype _ -> str "Atype(")
-and pr_whd w =
-  Pp.(match w with
-  | Vsort _ -> str "Vsort"
-  | Vprod _ -> str "Vprod"
-  | Vfun _ -> str "Vfun"
-  | Vfix _ -> str "Vfix"
-  | Vcofix _ -> str "Vcofix"
-  | Vconstr_const i -> str "Vconstr_const(" ++ int i ++ str ")"
-  | Vconstr_block b -> str "Vconstr_block"
-  | Vatom_stk (a,stk) -> str "Vatom_stk(" ++ pr_atom a ++ str ", " ++ pr_stack stk ++ str ")"
-  | Vuniv_level _ -> assert false)
-and pr_stack stk =
-  Pp.(match stk with
-      | [] -> str "[]"
-      | s :: stk -> pr_zipper s ++ str " :: " ++ pr_stack stk)
-and pr_zipper z =
-  Pp.(match z with
-  | Zapp args -> str "Zapp(len = " ++ int (nargs args) ++ str ")"
-  | Zfix (f,args) -> str "Zfix(..., len=" ++ int (nargs args) ++ str ")"
-  | Zswitch s -> str "Zswitch(...)"
-  | Zproj c -> str "Zproj(" ++ Names.pr_con c ++ str ")")
diff --git a/kernel/vm.mli b/kernel/vm.mli
index df638acc1..c6d92ba26 100644
--- a/kernel/vm.mli
+++ b/kernel/vm.mli
@@ -1,115 +1,33 @@
-open Names
-open Term
-open Cbytecodes
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Vmvalues
 
 (** Debug printing *)
 
 val set_drawinstr : unit -> unit
 
-(** Machine code *)
-
-type tcode
-
-(** Values *)
-
-type vprod
-type vfun
-type vfix
-type vcofix
-type vblock
-type vswitch
-type arguments
-
-type atom =
-  | Aid of Vars.id_key
-  | Aind of inductive
-  | Atype of Univ.universe
-
-(** Zippers *)
-
-type zipper =
-  | Zapp of arguments
-  | Zfix of vfix * arguments  (** might be empty *)
-  | Zswitch of vswitch
-  | Zproj of Constant.t (* name of the projection *)
-
-type stack = zipper list
-
-type to_up
-
-type whd =
-  | Vsort of sorts
-  | Vprod of vprod
-  | Vfun of vfun
-  | Vfix of vfix * arguments option
-  | Vcofix of vcofix * to_up * arguments option
-  | Vconstr_const of int
-  | Vconstr_block of vblock
-  | Vatom_stk of atom * stack
-  | Vuniv_level of Univ.universe_level
-
-(** For debugging purposes only *)
-
-val pr_atom : atom -> Pp.t
-val pr_whd : whd -> Pp.t
-val pr_stack : stack -> Pp.t
-
-(** Constructors *)
-
-val val_of_str_const : structured_constant -> values
-val val_of_rel : int -> values
-val val_of_named : Id.t -> values
-val val_of_constant : constant -> values
-
-external val_of_annot_switch : annot_switch -> values = "%identity"
-
-(** Destructors *)
-
-val whd_val : values -> whd
-val uni_lvl_val : values -> Univ.universe_level
-
-(** Arguments *)
-
-val nargs : arguments -> int
-val arg : arguments -> int -> values
-
-(** Product *)
-
-val dom : vprod -> values
-val codom : vprod -> vfun
-
-(** Function *)
-
-val body_of_vfun : int -> vfun -> values
-val decompose_vfun2  : int -> vfun -> vfun -> int * values * values
-
-(** Fix *)
-
-val current_fix : vfix -> int
-val check_fix : vfix -> vfix -> bool
-val rec_args : vfix -> int array
 val reduce_fix : int -> vfix -> vfun array * values array
                               (** bodies ,  types *)
 
-(** CoFix *)
-
-val current_cofix : vcofix -> int
-val check_cofix : vcofix -> vcofix -> bool
 val reduce_cofix : int -> vcofix -> values array * values array
                                       (** bodies , types *)
 
-(** Block *)
+val type_of_switch : vswitch -> values
 
-val btag  : vblock -> int
-val bsize : vblock -> int
-val bfield : vblock -> int -> values
+val branch_of_switch : int -> vswitch -> (int * values) array
 
-(** Switch *)
+val reduce_fun : int -> vfun -> values
 
-val check_switch : vswitch -> vswitch -> bool
-val case_info : vswitch -> case_info
-val type_of_switch : vswitch -> values
-val branch_of_switch : int -> vswitch -> (int * values) array
+(** [decompose_vfun2 k f1 f2] takes two functions [f1] and [f2] at current
+    DeBruijn level [k], with [n] lambdas in common, returns [n] and the reduced
+    bodies under those lambdas. *)
+val decompose_vfun2  : int -> vfun -> vfun -> int * values * values
 
 (** Apply a value *)
 
diff --git a/kernel/vmvalues.ml b/kernel/vmvalues.ml
new file mode 100644
index 000000000..2d8a1d976
--- /dev/null
+++ b/kernel/vmvalues.ml
@@ -0,0 +1,526 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+open Names
+open Sorts
+open Cbytecodes
+open Univ
+
+(*******************************************)
+(* Initalization of the abstract machine ***)
+(* Necessary for [relaccu_tbl]             *)
+(*******************************************)
+
+external init_vm : unit -> unit = "init_coq_vm"
+
+let _ = init_vm ()
+
+(******************************************************)
+(* Abstract data types and utility functions **********)
+(******************************************************)
+
+(* Values of the abstract machine *)
+type values
+let val_of_obj v = ((Obj.obj v):values)
+let crazy_val = (val_of_obj (Obj.repr 0))
+
+(* Abstract data *)
+type vprod
+type vfun
+type vfix
+type vcofix
+type vblock
+type arguments
+
+let fun_val v = (Obj.magic v : values)
+let fix_val v = (Obj.magic v : values)
+let cofix_upd_val v = (Obj.magic v : values)
+
+type vm_env
+let fun_env v = (Obj.magic v : vm_env)
+let fix_env v = (Obj.magic v : vm_env)
+let cofix_env v = (Obj.magic v : vm_env)
+let cofix_upd_env v = (Obj.magic v : vm_env)
+type vstack = values array
+
+let fun_of_val v = (Obj.magic v : vfun)
+
+(*******************************************)
+(* Machine code *** ************************)
+(*******************************************)
+
+type tcode
+
+external mkAccuCode : int -> tcode = "coq_makeaccu"
+external offset_tcode : tcode -> int -> tcode = "coq_offset_tcode"
+
+let tcode_of_obj v = ((Obj.obj v):tcode)
+let fun_code v = tcode_of_obj (Obj.field (Obj.repr v) 0)
+let fix_code v = fun_code v
+let cofix_upd_code v = fun_code v
+
+
+type vswitch = {
+    sw_type_code : tcode;
+    sw_code : tcode;
+    sw_annot : annot_switch;
+    sw_stk : vstack;
+    sw_env : vm_env
+  }
+
+(* Representation of values *)
+(* + Products : *)
+(*   -   vprod = 0_[ dom | codom]                                         *)
+(*             dom : values, codom : vfun                                 *)
+(*                                                                        *)
+(* + Functions have two representations :                                 *)
+(*   - unapplied fun :  vf = Ct_[ C | fv1 | ... | fvn]                    *)
+(*                                       C:tcode, fvi : values            *)
+(*     Remark : a function and its environment is the same value.         *)
+(*   - partially applied fun : Ct_[Restart:C| vf | arg1 | ... argn]       *)
+(*                                                                        *)
+(* + Fixpoints :                                                          *)
+(*   -        Ct_[C1|Infix_t|C2|...|Infix_t|Cn|fv1|...|fvn]               *)
+(*     One single block to represent all of the fixpoints, each fixpoint  *)
+(*     is the pointer to the field holding the pointer to its code, and   *)
+(*     the infix tag is used to know where the block starts.              *)
+(*   - Partial application follows the scheme of partially applied        *)
+(*     functions. Note: only fixpoints not having been applied to its     *)
+(*     recursive argument are coded this way. When the rec. arg. is       *)
+(*     applied, either it's a constructor and the fix reduces, or it's    *)
+(*     and the fix is coded as an accumulator.                            *)
+(*                                                                        *)
+(* + Cofixpoints : see cbytegen.ml                                        *)
+(*                                                                        *)
+(* + vblock's encode (non constant) constructors as in Ocaml, but         *)
+(*   starting from 0 up. tag 0 ( = accu_tag) is reserved for              *)
+(*   accumulators.                                                        *)
+(*                                                                        *)
+(* + vm_env is the type of the machine environments (i.e. a function or   *)
+(*   a fixpoint)                                                          *)
+(*                                                                        *)
+(* + Accumulators : At_[accumulate| accu | arg1 | ... | argn ]            *)
+(*   - representation of [accu] : tag_[....]                              *)
+(*     -- tag <= 3 : encoding atom type (sorts, free vars, etc.)          *)
+(*     -- 10_[accu|proj name] : a projection blocked by an accu           *)
+(*     -- 11_[accu|fix_app] : a fixpoint blocked by an accu               *)
+(*     -- 12_[accu|vswitch] : a match blocked by an accu                  *)
+(*     -- 13_[fcofix]       : a cofix function                            *)
+(*     -- 14_[fcofix|val]   : a cofix function, val represent the value   *)
+(*        of the function applied to arg1 ... argn                        *)
+(* The [arguments] type, which is abstracted as an array, represents :    *)
+(*          tag[ _ | _ |v1|... | vn]                                      *)
+(* Generally the first field is a code pointer.                           *)
+
+(* Do not edit this type without editing C code, especially "coq_values.h" *)
+
+type atom =
+  | Aid of Vars.id_key
+  | Aind of inductive
+  | Atype of Univ.Universe.t
+
+(* Zippers *)
+
+type zipper =
+  | Zapp of arguments
+  | Zfix of vfix*arguments  (* Possibly empty *)
+  | Zswitch of vswitch
+  | Zproj of Constant.t (* name of the projection *)
+
+type stack = zipper list
+
+type to_update = values
+
+type whd =
+  | Vsort of Sorts.t
+  | Vprod of vprod
+  | Vfun of vfun
+  | Vfix of vfix * arguments option
+  | Vcofix of vcofix * to_update * arguments option
+  | Vconstr_const of int
+  | Vconstr_block of vblock
+  | Vatom_stk of atom * stack
+  | Vuniv_level of Univ.Level.t
+
+(* Functions over arguments *)
+let nargs : arguments -> int = fun args -> (Obj.size (Obj.repr args)) - 2
+let arg args i =
+  if  0 <= i && i < (nargs args) then
+    val_of_obj (Obj.field (Obj.repr args) (i+2))
+  else invalid_arg
+                ("Vm.arg size = "^(string_of_int (nargs args))^
+                 " acces "^(string_of_int i))
+
+(*************************************************)
+(* Destructors ***********************************)
+(*************************************************)
+
+let uni_lvl_val (v : values) : Univ.Level.t =
+    let whd = Obj.magic v in
+    match whd with
+    | Vuniv_level lvl -> lvl
+    | _ ->
+      let pr =
+        let open Pp in
+        match whd with
+        | Vsort _ -> str "Vsort"
+        | Vprod _ -> str "Vprod"
+        | Vfun _ -> str "Vfun"
+        | Vfix _ -> str "Vfix"
+        | Vcofix _ -> str "Vcofix"
+        | Vconstr_const i -> str "Vconstr_const"
+        | Vconstr_block b -> str "Vconstr_block"
+        | Vatom_stk (a,stk) -> str "Vatom_stk"
+        | _ -> assert false
+      in
+      CErrors.anomaly
+        Pp.(   strbrk "Parsing virtual machine value expected universe level, got "
+            ++ pr ++ str ".")
+
+let rec whd_accu a stk =
+  let stk =
+    if Int.equal (Obj.size a) 2 then stk
+    else Zapp (Obj.obj a) :: stk in
+  let at = Obj.field a 1 in
+  match Obj.tag at with
+  | i when Int.equal i type_atom_tag ->
+     begin match stk with
+     | [Zapp args] ->
+        let args = Array.init (nargs args) (arg args) in
+        let u = Obj.obj (Obj.field at 0) in
+        let inst = Instance.of_array (Array.map uni_lvl_val args) in
+        let u = Univ.subst_instance_universe inst u in
+        Vsort (Type u)
+     | _ -> assert false
+     end
+  | i when i <= max_atom_tag ->
+      Vatom_stk(Obj.magic at, stk)
+  | i when Int.equal i proj_tag ->
+     let zproj = Zproj (Obj.obj (Obj.field at 0)) in
+     whd_accu (Obj.field at 1) (zproj :: stk)
+  | i when Int.equal i fix_app_tag ->
+      let fa = Obj.field at 1 in
+      let zfix  =
+        Zfix (Obj.obj (Obj.field fa 1), Obj.obj fa) in
+      whd_accu (Obj.field at 0) (zfix :: stk)
+  | i when Int.equal i switch_tag ->
+      let zswitch = Zswitch (Obj.obj (Obj.field at 1)) in
+      whd_accu (Obj.field at 0) (zswitch :: stk)
+  | i when Int.equal i cofix_tag ->
+      let vcfx = Obj.obj (Obj.field at 0) in
+      let to_up = Obj.obj a in
+      begin match stk with
+      | []          -> Vcofix(vcfx, to_up, None)
+      | [Zapp args] -> Vcofix(vcfx, to_up, Some args)
+      | _           -> assert false
+      end
+  | i when Int.equal i cofix_evaluated_tag ->
+      let vcofix = Obj.obj (Obj.field at 0) in
+      let res = Obj.obj a in
+      begin match stk with
+      | []          -> Vcofix(vcofix, res, None)
+      | [Zapp args] -> Vcofix(vcofix, res, Some args)
+      | _           -> assert false
+      end
+  | tg ->
+    CErrors.anomaly
+      Pp.(strbrk "Failed to parse VM value. Tag = " ++ int tg ++ str ".")
+
+external kind_of_closure : Obj.t -> int = "coq_kind_of_closure"
+external is_accumulate : tcode -> bool = "coq_is_accumulate_code"
+external int_tcode : tcode -> int -> int = "coq_int_tcode"
+external accumulate : unit -> tcode = "accumulate_code"
+let accumulate = accumulate ()
+
+let whd_val : values -> whd =
+  fun v ->
+    let o = Obj.repr v in
+    if Obj.is_int o then Vconstr_const (Obj.obj o)
+    else
+      let tag = Obj.tag o in
+      if tag = accu_tag then
+        (
+        if Int.equal (Obj.size o) 1 then Obj.obj o (* sort *)
+        else
+          if is_accumulate (fun_code o) then whd_accu o []
+          else Vprod(Obj.obj o))
+      else
+        if tag = Obj.closure_tag || tag = Obj.infix_tag then
+          (match kind_of_closure o with
+           | 0 -> Vfun(Obj.obj o)
+           | 1 -> Vfix(Obj.obj o, None)
+           | 2 -> Vfix(Obj.obj (Obj.field o 1), Some (Obj.obj o))
+           | 3 -> Vatom_stk(Aid(RelKey(int_tcode (fun_code o) 1)), [])
+           | _ -> CErrors.anomaly ~label:"Vm.whd " (Pp.str "kind_of_closure does not work."))
+        else
+           Vconstr_block(Obj.obj o)
+
+(**********************************************)
+(* Constructors *******************************)
+(**********************************************)
+
+let obj_of_atom : atom -> Obj.t =
+  fun a ->
+    let res = Obj.new_block accu_tag 2 in
+    Obj.set_field res 0 (Obj.repr accumulate);
+    Obj.set_field res 1 (Obj.repr a);
+    res
+
+(* obj_of_str_const : structured_constant -> Obj.t *)
+let rec obj_of_str_const str =
+  match str with
+  | Const_sorts s -> Obj.repr (Vsort s)
+  | Const_ind ind -> obj_of_atom (Aind ind)
+  | Const_proj p -> Obj.repr p
+  | Const_b0 tag -> Obj.repr tag
+  | Const_bn(tag, args) ->
+      let len = Array.length args in
+      let res = Obj.new_block tag len in
+      for i = 0 to len - 1 do
+        Obj.set_field res i (obj_of_str_const args.(i))
+      done;
+      res
+  | Const_univ_level l -> Obj.repr (Vuniv_level l)
+  | Const_type u -> obj_of_atom (Atype u)
+
+let val_of_obj o = ((Obj.obj o) : values)
+
+let val_of_str_const str = val_of_obj (obj_of_str_const str)
+
+let val_of_atom a = val_of_obj (obj_of_atom a)
+
+let atom_of_proj kn v =
+  let r = Obj.new_block proj_tag 2 in
+  Obj.set_field r 0 (Obj.repr kn);
+  Obj.set_field r 1 (Obj.repr v);
+  ((Obj.obj r) : atom)
+
+let val_of_proj kn v =
+  val_of_atom (atom_of_proj kn v)
+
+module IdKeyHash =
+struct
+  type t = Constant.t tableKey
+  let equal = Names.eq_table_key Constant.equal
+  open Hashset.Combine
+  let hash = function
+  | ConstKey c -> combinesmall 1 (Constant.hash c)
+  | VarKey id -> combinesmall 2 (Id.hash id)
+  | RelKey i -> combinesmall 3 (Int.hash i)
+end
+
+module KeyTable = Hashtbl.Make(IdKeyHash)
+
+let idkey_tbl = KeyTable.create 31
+
+let val_of_idkey key =
+  try KeyTable.find idkey_tbl key
+  with Not_found ->
+    let v = val_of_atom (Aid key) in
+    KeyTable.add idkey_tbl key v;
+    v
+
+let val_of_rel k = val_of_idkey (RelKey k)
+
+let val_of_named id = val_of_idkey (VarKey id)
+
+let val_of_constant c = val_of_idkey (ConstKey c)
+
+external val_of_annot_switch : annot_switch -> values = "%identity"
+
+(*************************************************)
+(** Operations manipulating data types ***********)
+(*************************************************)
+
+(* Functions over products *)
+
+let dom : vprod -> values = fun p -> val_of_obj (Obj.field (Obj.repr p) 0)
+let codom : vprod -> vfun = fun p -> (Obj.obj (Obj.field (Obj.repr p) 1))
+
+(* Functions over vfun *)
+
+external closure_arity : vfun -> int = "coq_closure_arity"
+
+(* Functions over fixpoint *)
+
+external offset : Obj.t -> int = "coq_offset"
+external offset_closure : Obj.t -> int -> Obj.t = "coq_offset_closure"
+external offset_closure_fix : vfix -> int -> vm_env = "coq_offset_closure"
+
+let first o = (offset_closure o (offset o))
+let first_fix (v:vfix) = (Obj.magic (first (Obj.repr v)) : vfix)
+
+let last o = (Obj.field o (Obj.size o - 1))
+let fix_types (v:vfix) = (Obj.magic (last (Obj.repr v)) : tcode array)
+let cofix_types (v:vcofix) = (Obj.magic (last (Obj.repr v)) : tcode array)
+
+let current_fix vf = - (offset (Obj.repr vf) / 2)
+
+let unsafe_fb_code fb i = tcode_of_obj (Obj.field (Obj.repr fb) (2 * i))
+
+let unsafe_rec_arg fb i = int_tcode (unsafe_fb_code fb i) 1
+
+let rec_args vf =
+  let fb = first (Obj.repr vf) in
+  let size = Obj.size (last fb) in
+  Array.init size (unsafe_rec_arg fb)
+
+exception FALSE
+
+let check_fix f1 f2 =
+  let i1, i2 = current_fix f1, current_fix f2 in
+  (* Checking starting point *)
+  if i1 = i2 then
+    let fb1,fb2 = first (Obj.repr f1), first (Obj.repr f2) in
+    let n = Obj.size (last fb1) in
+    (* Checking number of definitions *)
+    if n = Obj.size (last fb2) then
+      (* Checking recursive arguments *)
+      try
+        for i = 0 to n - 1 do
+          if unsafe_rec_arg fb1 i <> unsafe_rec_arg fb2 i
+          then raise FALSE
+        done;
+        true
+      with FALSE -> false
+    else false
+  else false
+
+external atom_rel : unit -> atom array = "get_coq_atom_tbl"
+external realloc_atom_rel : int -> unit = "realloc_coq_atom_tbl"
+
+let relaccu_tbl =
+  let atom_rel = atom_rel() in
+  let len = Array.length atom_rel in
+  for i = 0 to len - 1 do atom_rel.(i) <- Aid (RelKey i) done;
+  ref (Array.init len mkAccuCode)
+
+let relaccu_code i =
+  let len = Array.length !relaccu_tbl in
+  if i < len then !relaccu_tbl.(i)
+  else
+    begin
+      realloc_atom_rel i;
+      let atom_rel = atom_rel () in
+      let nl = Array.length atom_rel in
+      for j = len to nl - 1 do atom_rel.(j) <- Aid(RelKey j) done;
+      relaccu_tbl :=
+        Array.init nl
+          (fun j -> if j < len then !relaccu_tbl.(j) else mkAccuCode j);
+      !relaccu_tbl.(i)
+    end
+
+let mk_fix_body k ndef fb =
+  let e = Obj.dup (Obj.repr fb) in
+  for i = 0 to ndef - 1 do
+    Obj.set_field e (2 * i) (Obj.repr (relaccu_code (k + i)))
+  done;
+  let fix_body i =
+    let jump_grabrec c = offset_tcode c 2 in
+    let c = jump_grabrec (unsafe_fb_code fb i)  in
+    let res = Obj.new_block Obj.closure_tag 2 in
+    Obj.set_field res 0 (Obj.repr c);
+    Obj.set_field res 1 (offset_closure e (2*i));
+    ((Obj.obj res) : vfun)  in
+  Array.init ndef fix_body
+
+(* Functions over vcofix *)
+
+let get_fcofix vcf i =
+  match whd_val (Obj.obj (Obj.field (Obj.repr vcf) (i+1))) with
+  | Vcofix(vcfi, _, _) -> vcfi
+  | _ -> assert false
+
+let current_cofix vcf =
+  let ndef = Obj.size (last (Obj.repr vcf)) in
+  let rec find_cofix pos =
+    if pos < ndef then
+      if get_fcofix vcf pos == vcf then pos
+      else find_cofix (pos+1)
+    else raise Not_found in
+  try find_cofix 0
+  with Not_found -> assert false
+
+let check_cofix vcf1 vcf2 =
+  (current_cofix vcf1 = current_cofix vcf2) &&
+  (Obj.size (last (Obj.repr vcf1)) = Obj.size (last (Obj.repr vcf2)))
+
+let mk_cofix_body apply_varray k ndef vcf =
+  let e = Obj.dup (Obj.repr vcf) in
+  for i = 0 to ndef - 1 do
+    Obj.set_field e (i+1) (Obj.repr (val_of_rel (k+i)))
+  done;
+
+  let cofix_body i =
+    let vcfi = get_fcofix vcf i in
+    let c = Obj.field (Obj.repr vcfi) 0 in
+    Obj.set_field e 0 c;
+    let atom = Obj.new_block cofix_tag 1 in
+    let self = Obj.new_block accu_tag 2 in
+    Obj.set_field self 0 (Obj.repr accumulate);
+    Obj.set_field self 1 (Obj.repr atom);
+    apply_varray (Obj.obj e) [|Obj.obj self|] in
+  Array.init ndef cofix_body
+
+(* Functions over vblock *)
+
+let btag : vblock -> int = fun b -> Obj.tag (Obj.repr b)
+let bsize : vblock -> int = fun b -> Obj.size (Obj.repr b)
+let bfield b i =
+  if 0 <= i && i < (bsize b) then val_of_obj (Obj.field (Obj.repr b) i)
+  else invalid_arg "Vm.bfield"
+
+
+(* Functions over vswitch *)
+
+let check_switch sw1 sw2 = sw1.sw_annot.rtbl = sw2.sw_annot.rtbl
+
+let branch_arg k (tag,arity) =
+  if Int.equal arity 0 then  ((Obj.magic tag):values)
+  else
+    let b, ofs =
+      if tag < last_variant_tag then Obj.new_block tag arity, 0
+      else
+        let b = Obj.new_block last_variant_tag (arity+1) in
+        Obj.set_field b 0 (Obj.repr (tag-last_variant_tag));
+        b,1 in
+    for i = ofs to ofs + arity - 1 do
+      Obj.set_field b i (Obj.repr (val_of_rel (k+i)))
+    done;
+    val_of_obj b
+
+(* Printing *)
+
+let rec pr_atom a =
+  Pp.(match a with
+  | Aid c -> str "Aid(" ++ (match c with
+                            | ConstKey c -> Constant.print c
+                            | RelKey i -> str "#" ++ int i
+                            | _ -> str "...") ++ str ")"
+  | Aind (mi,i) -> str "Aind(" ++ MutInd.print mi ++ str "#" ++ int i ++ str ")"
+  | Atype _ -> str "Atype(")
+and pr_whd w =
+  Pp.(match w with
+  | Vsort _ -> str "Vsort"
+  | Vprod _ -> str "Vprod"
+  | Vfun _ -> str "Vfun"
+  | Vfix _ -> str "Vfix"
+  | Vcofix _ -> str "Vcofix"
+  | Vconstr_const i -> str "Vconstr_const(" ++ int i ++ str ")"
+  | Vconstr_block b -> str "Vconstr_block"
+  | Vatom_stk (a,stk) -> str "Vatom_stk(" ++ pr_atom a ++ str ", " ++ pr_stack stk ++ str ")"
+  | Vuniv_level _ -> assert false)
+and pr_stack stk =
+  Pp.(match stk with
+      | [] -> str "[]"
+      | s :: stk -> pr_zipper s ++ str " :: " ++ pr_stack stk)
+and pr_zipper z =
+  Pp.(match z with
+  | Zapp args -> str "Zapp(len = " ++ int (nargs args) ++ str ")"
+  | Zfix (f,args) -> str "Zfix(..., len=" ++ int (nargs args) ++ str ")"
+  | Zswitch s -> str "Zswitch(...)"
+  | Zproj c -> str "Zproj(" ++ Constant.print c ++ str ")")
diff --git a/kernel/vmvalues.mli b/kernel/vmvalues.mli
new file mode 100644
index 000000000..350f71372
--- /dev/null
+++ b/kernel/vmvalues.mli
@@ -0,0 +1,144 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Names
+open Cbytecodes
+
+(** Values *)
+
+type values
+type vm_env
+type vprod
+type vfun
+type vfix
+type vcofix
+type vblock
+type arguments
+type vstack = values array
+type to_update
+
+val fun_val : vfun -> values
+val fix_val : vfix -> values
+val cofix_upd_val : to_update -> values
+
+val fun_env : vfun -> vm_env
+val fix_env : vfix -> vm_env
+val cofix_env : vcofix -> vm_env
+val cofix_upd_env : to_update -> vm_env
+
+(** Cast a value known to be a function, unsafe in general *)
+val fun_of_val : values -> vfun
+
+val crazy_val : values
+
+(** Machine code *)
+
+type tcode
+
+type vswitch = {
+    sw_type_code : tcode;
+    sw_code : tcode;
+    sw_annot : annot_switch;
+    sw_stk : vstack;
+    sw_env : vm_env
+  }
+
+external mkAccuCode : int -> tcode = "coq_makeaccu"
+
+val fun_code : vfun -> tcode
+val fix_code : vfix -> tcode
+val cofix_upd_code : to_update -> tcode
+
+type atom =
+  | Aid of Vars.id_key
+  | Aind of inductive
+  | Atype of Univ.Universe.t
+
+(** Zippers *)
+
+type zipper =
+  | Zapp of arguments
+  | Zfix of vfix * arguments  (** might be empty *)
+  | Zswitch of vswitch
+  | Zproj of Constant.t (* name of the projection *)
+
+type stack = zipper list
+
+type whd =
+  | Vsort of Sorts.t
+  | Vprod of vprod
+  | Vfun of vfun
+  | Vfix of vfix * arguments option
+  | Vcofix of vcofix * to_update * arguments option
+  | Vconstr_const of int
+  | Vconstr_block of vblock
+  | Vatom_stk of atom * stack
+  | Vuniv_level of Univ.Level.t
+
+(** For debugging purposes only *)
+
+val pr_atom : atom -> Pp.t
+val pr_whd : whd -> Pp.t
+val pr_stack : stack -> Pp.t
+
+(** Constructors *)
+
+val val_of_str_const : structured_constant -> values
+val val_of_rel : int -> values
+val val_of_named : Id.t -> values
+val val_of_constant : Constant.t -> values
+val val_of_proj : Constant.t -> values -> values
+val val_of_atom : atom -> values
+
+external val_of_annot_switch : annot_switch -> values = "%identity"
+
+(** Destructors *)
+
+val whd_val : values -> whd
+val uni_lvl_val : values -> Univ.Level.t
+
+(** Arguments *)
+
+val nargs : arguments -> int
+val arg : arguments -> int -> values
+
+(** Product *)
+
+val dom : vprod -> values
+val codom : vprod -> vfun
+
+(** Fun *)
+external closure_arity : vfun -> int = "coq_closure_arity"
+
+(** Fix *)
+
+val current_fix : vfix -> int
+val check_fix : vfix -> vfix -> bool
+val rec_args : vfix -> int array
+val first_fix : vfix -> vfix
+val fix_types : vfix -> tcode array
+val cofix_types : vcofix -> tcode array
+external offset_closure_fix : vfix -> int -> vm_env = "coq_offset_closure"
+val mk_fix_body : int -> int -> vfix -> vfun array
+
+(** CoFix *)
+
+val current_cofix : vcofix -> int
+val check_cofix : vcofix -> vcofix -> bool
+val mk_cofix_body : (vfun -> vstack -> values) -> int -> int -> vcofix -> values array
+
+(** Block *)
+
+val btag  : vblock -> int
+val bsize : vblock -> int
+val bfield : vblock -> int -> values
+
+(** Switch *)
+
+val check_switch : vswitch -> vswitch -> bool
+val branch_arg : int -> Cbytecodes.tag * int -> values
diff --git a/lib/cErrors.ml b/lib/cErrors.ml
index 3f4e8aa12..eaffc28ac 100644
--- a/lib/cErrors.ml
+++ b/lib/cErrors.ml
@@ -91,7 +91,7 @@ let print_backtrace e = match Backtrace.get_backtrace e with
 
 let print_anomaly askreport e =
   if askreport then
-    hov 0 (str "Anomaly" ++ spc () ++ quote (raw_anomaly e) ++ spc ()) ++
+    hov 0 (str "Anomaly" ++ spc () ++ quote (raw_anomaly e)) ++ spc () ++
     hov 0 (str "Please report at " ++ str Coq_config.wwwbugtracker ++ str ".")
   else
     hov 0 (raw_anomaly e)
@@ -137,8 +137,3 @@ let handled e =
   let bottom _ = raise Bottom in
   try let _ = print_gen bottom !handle_stack e in true
   with Bottom -> false
-
-(* Deprecated functions *)
-let error            string = user_err (str string)
-let user_err_loc (loc,hdr,msg) = user_err ~loc ~hdr msg
-let errorlabstrm hdr msg = user_err ~hdr msg
diff --git a/lib/cErrors.mli b/lib/cErrors.mli
index f3253979f..6fcc97a91 100644
--- a/lib/cErrors.mli
+++ b/lib/cErrors.mli
@@ -93,14 +93,3 @@ val noncritical : exn -> bool
 (** Check whether an exception is handled by some toplevel printer. The
     [Anomaly] exception is never handled. *)
 val handled : exn -> bool
-
-(** Deprecated functions  *)
-val error : string -> 'a
- [@@ocaml.deprecated "use [user_err] instead"]
-
-val errorlabstrm : string -> Pp.t -> 'a
- [@@ocaml.deprecated "use [user_err ~hdr] instead"]
-
-val user_err_loc : Loc.t * string * Pp.t -> 'a
- [@@ocaml.deprecated "use [user_err ~loc] instead"]
-
diff --git a/lib/profile.ml b/lib/cProfile.ml
index 0bc226a45..0bc226a45 100644
--- a/lib/profile.ml
+++ b/lib/cProfile.ml
diff --git a/lib/profile.mli b/lib/cProfile.mli
index cae4397a1..cae4397a1 100644
--- a/lib/profile.mli
+++ b/lib/cProfile.mli
diff --git a/lib/cWarnings.ml b/lib/cWarnings.ml
index ff7145267..3699b1c61 100644
--- a/lib/cWarnings.ml
+++ b/lib/cWarnings.ml
@@ -93,8 +93,12 @@ let split_flags s =
     "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
+  | (status,name as w) :: warnings ->
+    let acc =
+      if is_all_keyword name then [w]
+      else if is_none_keyword name then [(Disabled,"all")]
+      else w :: acc in
+    cut_before_all_rev acc warnings
 
 let cut_before_all_rev warnings = cut_before_all_rev [] warnings
 
diff --git a/lib/control.ml b/lib/control.ml
index f5d7df204..c6489938e 100644
--- a/lib/control.ml
+++ b/lib/control.ml
@@ -12,21 +12,18 @@ let interrupt = ref false
 
 let steps = ref 0
 
-let are_we_threading = lazy (
-  match !Flags.async_proofs_mode with
-  | Flags.APon -> true
-  | _ -> false)
+let enable_thread_delay = ref false
 
 let check_for_interrupt () =
   if !interrupt then begin interrupt := false; raise Sys.Break end;
   incr steps;
-  if !steps = 1000 && Lazy.force are_we_threading then begin
+  if !enable_thread_delay && !steps = 1000 then begin
     Thread.delay 0.001;
     steps := 0;
   end
 
 (** This function does not work on windows, sigh... *)
-let unix_timeout n f e =
+let unix_timeout n f x e =
   let timeout_handler _ = raise e in
   let psh = Sys.signal Sys.sigalrm (Sys.Signal_handle timeout_handler) in
   let _ = Unix.alarm n in
@@ -35,7 +32,7 @@ let unix_timeout n f e =
     Sys.set_signal Sys.sigalrm psh
   in
   try
-    let res = f () in
+    let res = f x in
     restore_timeout ();
     res
   with e ->
@@ -43,7 +40,7 @@ let unix_timeout n f e =
     restore_timeout ();
     Exninfo.iraise e
 
-let windows_timeout n f e =
+let windows_timeout n f x e =
   let killed = ref false in
   let exited = ref false in
   let thread init =
@@ -60,7 +57,7 @@ let windows_timeout n f e =
   let init = Unix.gettimeofday () in
   let _id = Thread.create thread init in
   try
-    let res = f () in
+    let res = f x in
     let () = killed := true in
     let cur = Unix.gettimeofday () in
     (** The thread did not interrupt, but the computation took longer than
@@ -80,12 +77,10 @@ let windows_timeout n f e =
     let e = Backtrace.add_backtrace e in
     Exninfo.iraise e
 
-type timeout = { timeout : 'a. int -> (unit -> 'a) -> exn -> 'a }
+type timeout = { timeout : 'a 'b. int -> ('a -> 'b) -> 'a -> exn -> 'b }
 
 let timeout_fun = match Sys.os_type with
-| "Unix" | "Cygwin" -> ref { timeout = unix_timeout }
-| _ -> ref { timeout = windows_timeout }
+| "Unix" | "Cygwin" -> { timeout = unix_timeout }
+| _ -> { timeout = windows_timeout }
 
-let set_timeout f = timeout_fun := f
-
-let timeout n f e = !timeout_fun.timeout n f e
+let timeout n f e = timeout_fun.timeout n f e
diff --git a/lib/control.mli b/lib/control.mli
index 337cdf67b..261b07693 100644
--- a/lib/control.mli
+++ b/lib/control.mli
@@ -8,6 +8,9 @@
 
 (** Global control of Coq. *)
 
+(** Will periodically call [Thread.delay] if set to true *)
+val enable_thread_delay : bool ref
+
 val interrupt : bool ref
 (** Coq interruption: set the following boolean reference to interrupt Coq
     (it eventually raises [Break], simulating a Ctrl-C) *)
@@ -16,11 +19,6 @@ val check_for_interrupt : unit -> unit
 (** Use this function as a potential yield function. If {!interrupt} has been
     set, il will raise [Sys.Break]. *)
 
-val timeout : int -> (unit -> 'a) -> exn -> 'a
-(** [timeout n f e] tries to compute [f], and if it fails to do so before [n]
-    seconds, it raises [e] instead. *)
-
-type timeout = { timeout : 'a. int -> (unit -> 'a) -> exn -> 'a }
-
-val set_timeout : timeout -> unit
-(** Set a particular timeout function. *)
+val timeout : int -> ('a -> 'b) -> 'a -> exn -> 'b
+(** [timeout n f x e] tries to compute [f x], and if it fails to do so
+    before [n] seconds, it raises [e] instead. *)
diff --git a/lib/coqProject_file.ml4 b/lib/coqProject_file.ml4
index 13de731f5..e6f1d7e06 100644
--- a/lib/coqProject_file.ml4
+++ b/lib/coqProject_file.ml4
@@ -11,7 +11,6 @@ type project = {
   makefile : string option;
   install_kind  : install option;
   use_ocamlopt : bool;
-  bypass_API : bool;
 
   v_files : string list;
   mli_files : string list;
@@ -43,12 +42,11 @@ and install =
   | UserInstall
 
 (* TODO generate with PPX *)
-let mk_project project_file makefile install_kind use_ocamlopt bypass_API = {
+let mk_project project_file makefile install_kind use_ocamlopt = {
   project_file;
   makefile;
   install_kind;
   use_ocamlopt;
-  bypass_API;
 
   v_files = [];
   mli_files = [];
@@ -113,9 +111,10 @@ let exists_dir dir =
 
 
 let process_cmd_line orig_dir proj args =
+  let parsing_project_file = ref (proj.project_file <> None) in
   let orig_dir = (* avoids turning foo.v in ./foo.v *)
     if orig_dir = "." then "" else orig_dir in
-  let error s = Feedback.msg_error (Pp.str (s^".")); exit 1 in
+  let error s = Format.eprintf "@[%a]@@\n%!" Pp.pp_with Pp.(str (s^".")); exit 1 in
   let mk_path d =
     let p = CUnix.correct_path d orig_dir in
     { path = CUnix.remove_path_dot (post_canonize p);
@@ -155,16 +154,22 @@ let process_cmd_line orig_dir proj args =
     aux { proj with r_includes = proj.r_includes @ [mk_path d,lp] } r
 
   | "-f" :: file :: r ->
+    if !parsing_project_file then
+      raise (Parsing_error ("Invalid option -f in project file " ^ Option.get proj.project_file));
     let file = CUnix.remove_path_dot (CUnix.correct_path file orig_dir) in
     let () = match proj.project_file with
       | None -> ()
       | Some _ -> Feedback.msg_warning (Pp.str
 	"Multiple project files are deprecated.")
     in
+    parsing_project_file := true;
     let proj = aux { proj with project_file = Some file } (parse file) in
+    parsing_project_file := false;
     aux proj r
 
   | "-o" :: file :: r ->
+    if !parsing_project_file then
+     raise (Parsing_error ("Invalid option -o in project file " ^ Option.get proj.project_file));
     if String.contains file '/' then
       error "Output file must be in the current directory";
     if proj.makefile <> None then
@@ -174,8 +179,6 @@ let process_cmd_line orig_dir proj args =
     aux { proj with defs = proj.defs @ [v,def] } r
   | "-arg" :: a :: r ->
     aux { proj with extra_args = proj.extra_args @ [a] } r
-  | "-bypass-API" :: r ->
-    aux { proj with bypass_API = true } r
   | f :: r ->
       let f = CUnix.correct_path f orig_dir in
       let proj =
@@ -195,18 +198,18 @@ let process_cmd_line orig_dir proj args =
  (******************************* API ************************************)
 
 let cmdline_args_to_project ~curdir args =
-  process_cmd_line curdir (mk_project None None None true false) args
+  process_cmd_line curdir (mk_project None None None true) args
 
 let read_project_file f =
   process_cmd_line (Filename.dirname f)
-    (mk_project (Some f) None (Some NoInstall) true false) (parse f)
+    (mk_project (Some f) None (Some NoInstall) true) (parse f)
 
 let rec find_project_file ~from ~projfile_name =
   let fname = Filename.concat from projfile_name in
   if Sys.file_exists fname then Some fname
   else
     let newdir = Filename.dirname from in
-    if newdir = "" || newdir = "/" then None
+    if newdir = from then None
     else find_project_file ~from:newdir ~projfile_name
 ;;
 
diff --git a/lib/coqProject_file.mli b/lib/coqProject_file.mli
index 23a27a54a..810189450 100644
--- a/lib/coqProject_file.mli
+++ b/lib/coqProject_file.mli
@@ -13,7 +13,6 @@ type project = {
   makefile : string option;
   install_kind  : install option;
   use_ocamlopt : bool;
-  bypass_API : bool;
 
   v_files : string list;
   mli_files : string list;
diff --git a/lib/dAst.ml b/lib/dAst.ml
new file mode 100644
index 000000000..0fe323d01
--- /dev/null
+++ b/lib/dAst.ml
@@ -0,0 +1,41 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open CAst
+
+type ('a, _) thunk =
+| Value : 'a -> ('a, 'b) thunk
+| Thunk : 'a Lazy.t -> ('a, [ `thunk ]) thunk
+
+type ('a, 'b) t = ('a, 'b) thunk CAst.t
+
+let map_thunk (type s) f : (_, s) thunk -> (_, s) thunk = function
+| Value x -> Value (f x)
+| Thunk k -> Thunk (lazy (f (Lazy.force k)))
+
+let get_thunk (type s) : ('a, s) thunk -> 'a = function
+| Value x -> x
+| Thunk k -> Lazy.force k
+
+let get x = get_thunk x.v
+
+let make ?loc v = CAst.make ?loc (Value v)
+
+let delay ?loc v = CAst.make ?loc (Thunk (Lazy.from_fun v))
+
+let map f n = CAst.map (fun x -> map_thunk f x) n
+
+let map_with_loc f n =
+  CAst.map_with_loc (fun ?loc x -> map_thunk (fun x -> f ?loc x) x) n
+
+let map_from_loc f (loc, x) =
+  make ?loc (f ?loc x)
+
+let with_val f n = f (get n)
+
+let with_loc_val f n = f ?loc:n.CAst.loc (get n)
diff --git a/lib/dAst.mli b/lib/dAst.mli
new file mode 100644
index 000000000..5b51677fc
--- /dev/null
+++ b/lib/dAst.mli
@@ -0,0 +1,28 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+(** Lazy AST node wrapper. Only used for [glob_constr] as of today. *)
+
+type ('a, _) thunk =
+| Value : 'a -> ('a, 'b) thunk
+| Thunk : 'a Lazy.t -> ('a, [ `thunk ]) thunk
+
+type ('a, 'b) t = ('a, 'b) thunk CAst.t
+
+val get : ('a, 'b) t -> 'a
+val get_thunk : ('a, 'b) thunk -> 'a
+
+val make : ?loc:Loc.t -> 'a -> ('a, 'b) t
+val delay : ?loc:Loc.t -> (unit -> 'a) -> ('a, [ `thunk ]) t
+
+val map : ('a -> 'b) -> ('a, 'c) t -> ('b, 'c) t
+val map_with_loc : (?loc:Loc.t -> 'a -> 'b) -> ('a, 'c) t -> ('b, 'c) t
+val map_from_loc : (?loc:Loc.t -> 'a -> 'b) -> 'a Loc.located -> ('b, 'c) t
+
+val with_val : ('a -> 'b) -> ('a, 'c) t -> 'b
+val with_loc_val : (?loc:Loc.t -> 'a -> 'b) -> ('a, 'c) t -> 'b
diff --git a/lib/envars.ml b/lib/envars.ml
index 68604ae6c..9b66c1f71 100644
--- a/lib/envars.ml
+++ b/lib/envars.ml
@@ -153,27 +153,23 @@ let coqpath =
 
 let exe s = s ^ Coq_config.exec_extension
 
-let ocamlfind () =
-  if !Flags.ocamlfind_spec then !Flags.ocamlfind else Coq_config.ocamlfind
+let ocamlfind () = Coq_config.ocamlfind
 
-(** {2 Camlp4 paths} *)
+(** {2 Camlp5 paths} *)
 
-let guess_camlp4bin () = which (user_path ()) (exe Coq_config.camlp4)
+let guess_camlp5bin () = which (user_path ()) (exe "camlp5")
 
-let camlp4bin () =
-  if !Flags.camlp4bin_spec then !Flags.camlp4bin else
-    if !Flags.boot then Coq_config.camlp4bin else
-      try guess_camlp4bin ()
-      with Not_found ->
-        Coq_config.camlp4bin
+let camlp5bin () =
+  if !Flags.boot then Coq_config.camlp5bin else
+    try guess_camlp5bin ()
+    with Not_found ->
+      Coq_config.camlp5bin
 
-let camlp4 () = camlp4bin () / exe Coq_config.camlp4
-
-let camlp4lib () =
+let camlp5lib () =
   if !Flags.boot then
-    Coq_config.camlp4lib
+    Coq_config.camlp5lib
   else
-    let ex, res = CUnix.run_command (ocamlfind () ^ " query " ^ Coq_config.camlp4) in
+    let ex, res = CUnix.run_command (ocamlfind () ^ " query camlp5") in
     match ex with
       | Unix.WEXITED 0 -> String.strip res
       | _ -> "/dev/null"
@@ -208,11 +204,11 @@ let print_config ?(prefix_var_name="") f coq_src_subdirs =
   fprintf f "%sCOQLIB=%s/\n" prefix_var_name (coqlib ());
   fprintf f "%sDOCDIR=%s/\n" prefix_var_name (docdir ());
   fprintf f "%sOCAMLFIND=%s\n" prefix_var_name (ocamlfind ());
-  fprintf f "%sCAMLP4=%s\n" prefix_var_name Coq_config.camlp4;
-  fprintf f "%sCAMLP4O=%s\n" prefix_var_name Coq_config.camlp4o;
-  fprintf f "%sCAMLP4BIN=%s/\n" prefix_var_name (camlp4bin ());
-  fprintf f "%sCAMLP4LIB=%s\n" prefix_var_name (camlp4lib ());
-  fprintf f "%sCAMLP4OPTIONS=%s\n" prefix_var_name Coq_config.camlp4compat;
+  fprintf f "%sCAMLP5O=%s\n" prefix_var_name Coq_config.camlp5o;
+  fprintf f "%sCAMLP5BIN=%s/\n" prefix_var_name (camlp5bin ());
+  fprintf f "%sCAMLP5LIB=%s\n" prefix_var_name (camlp5lib ());
+  fprintf f "%sCAMLP5OPTIONS=%s\n" prefix_var_name Coq_config.camlp5compat;
+  fprintf f "%sCAMLFLAGS=%s\n" prefix_var_name Coq_config.caml_flags;
   fprintf f "%sHASNATDYNLINK=%s\n" prefix_var_name
     (if Coq_config.has_natdynlink then "true" else "false");
   fprintf f "%sCOQ_SRC_SUBDIRS=%s\n" prefix_var_name (String.concat " " coq_src_subdirs)
diff --git a/lib/envars.mli b/lib/envars.mli
index 09f2b4ca1..1ccd1feff 100644
--- a/lib/envars.mli
+++ b/lib/envars.mli
@@ -56,14 +56,11 @@ val coqpath : string list
 (** [camlfind ()] is the path to the ocamlfind binary. *)
 val ocamlfind : unit -> string
 
-(** [camlp4bin ()] is the path to the camlp4 binary. *)
-val camlp4bin : unit -> string
+(** [camlp5bin ()] is the path to the camlp5 binary. *)
+val camlp5bin : unit -> string
 
-(** [camlp4lib ()] is the path to the camlp4 library. *)
-val camlp4lib : unit -> string
-
-(** [camlp4 ()] is the camlp4 utility. *)
-val camlp4 : unit -> string
+(** [camlp5lib ()] is the path to the camlp5 library. *)
+val camlp5lib : unit -> string
 
 (** Coq tries to honor the XDG Base Directory Specification to access
     the user's configuration files.
diff --git a/lib/feedback.ml b/lib/feedback.ml
index 54d16a9be..1007582e0 100644
--- a/lib/feedback.ml
+++ b/lib/feedback.ml
@@ -15,6 +15,7 @@ type level =
   | Warning
   | Error
 
+type doc_id = int
 type route_id = int
 
 type feedback_content =
@@ -35,7 +36,8 @@ type feedback_content =
   | Message of level * Loc.t option * Pp.t
 
 type feedback = {
-  id       : Stateid.t;
+  doc_id   : doc_id;            (* The document being concerned *)
+  span_id  : Stateid.t;
   route    : route_id;
   contents : feedback_content;
 }
@@ -52,26 +54,68 @@ let add_feeder =
 let del_feeder fid = Hashtbl.remove feeders fid
 
 let default_route = 0
-let feedback_id    = ref Stateid.dummy
+let span_id    = ref Stateid.dummy
+let doc_id     = ref 0
 let feedback_route = ref default_route
 
-let set_id_for_feedback ?(route=default_route) i =
-  feedback_id := i; feedback_route := route
+let set_id_for_feedback ?(route=default_route) d i =
+  doc_id := d;
+  span_id := i;
+  feedback_route := route
 
-let feedback ?id ?route what =
+let warn_no_listeners = ref true
+let feedback ?did ?id ?route what =
   let m = {
      contents = what;
-     route = Option.default !feedback_route route;
-     id    = Option.default !feedback_id id;
+     route    = Option.default !feedback_route route;
+     doc_id   = Option.default !doc_id did;
+     span_id  = Option.default !span_id id;
   } in
+  if !warn_no_listeners && Hashtbl.length feeders = 0 then
+    Format.eprintf "Warning, feedback message received but no listener to handle it!@\n%!";
   Hashtbl.iter (fun _ f -> f m) feeders
 
 (* Logging messages *)
 let feedback_logger ?loc lvl msg =
-  feedback ~route:!feedback_route ~id:!feedback_id (Message (lvl, loc, msg))
+  feedback ~route:!feedback_route ~id:!span_id (Message (lvl, loc, msg))
 
 let msg_info    ?loc x = feedback_logger ?loc Info x
 let msg_notice  ?loc x = feedback_logger ?loc Notice x
 let msg_warning ?loc x = feedback_logger ?loc Warning x
 let msg_error   ?loc x = feedback_logger ?loc Error x
 let msg_debug   ?loc x = feedback_logger ?loc Debug x
+
+(* Helper for tools willing to understand only the messages *)
+let console_feedback_listener fmt =
+  let open Format in
+  let pp_lvl fmt lvl = match lvl with
+    | Error   -> fprintf fmt "Error: "
+    | Info    -> fprintf fmt "Info: "
+    | Debug   -> fprintf fmt "Debug: "
+    | Warning -> fprintf fmt "Warning: "
+    | Notice  -> fprintf fmt ""
+  in
+  let pp_loc fmt loc = let open Loc in match loc with
+    | None     -> fprintf fmt ""
+    | Some loc ->
+      let where =
+        match loc.fname with InFile f -> f | ToplevelInput -> "Toplevel input" in
+      fprintf fmt "\"%s\", line %d, characters %d-%d:@\n"
+        where loc.line_nb (loc.bp-loc.bol_pos) (loc.ep-loc.bol_pos) in
+  let checker_feed (fb : feedback) =
+  match fb.contents with
+  | Processed   -> ()
+  | Incomplete  -> ()
+  | Complete    -> ()
+  | ProcessingIn _ -> ()
+  | InProgress _ -> ()
+  | WorkerStatus (_,_) -> ()
+  | AddedAxiom  -> ()
+  | GlobRef (_,_,_,_,_) -> ()
+  | GlobDef (_,_,_,_) -> ()
+  | FileDependency (_,_) -> ()
+  | FileLoaded (_,_) -> ()
+  | Custom (_,_,_) -> ()
+  | Message (lvl,loc,msg) ->
+    fprintf fmt "@[%a@]%a@[%a@]\n%!" pp_loc loc pp_lvl lvl Pp.pp_with msg
+  in checker_feed
diff --git a/lib/feedback.mli b/lib/feedback.mli
index 45a02d384..37f38c8ff 100644
--- a/lib/feedback.mli
+++ b/lib/feedback.mli
@@ -17,6 +17,9 @@ type level =
   | Error
 
 
+(** Document unique identifier for serialization *)
+type doc_id = int
+
 (** Coq "semantic" infos obtained during execution *)
 type route_id = int
 
@@ -43,7 +46,8 @@ type feedback_content =
   | Message of level * Loc.t option * Pp.t
 
 type feedback = {
-  id       : Stateid.t;         (* The document part concerned *)
+  doc_id   : doc_id;            (* The document being concerned *)
+  span_id  : Stateid.t;         (* The document part concerned *)
   route    : route_id;          (* Extra routing info *)
   contents : feedback_content;  (* The payload *)
 }
@@ -60,13 +64,13 @@ val add_feeder : (feedback -> unit) -> int
 (** [del_feeder fid] removes the feeder with id [fid] *)
 val del_feeder : int -> unit
 
-(** [feedback ?id ?route fb] produces feedback fb, with [route] and
-    [id] set appropiatedly, if absent, it will use the defaults set by
-    [set_id_for_feedback] *)
-val feedback : ?id:Stateid.t -> ?route:route_id -> feedback_content -> unit
+(** [feedback ?did ?sid ?route fb] produces feedback [fb], with
+    [route] and [did, sid] set appropiatedly, if absent, it will use
+    the defaults set by [set_id_for_feedback] *)
+val feedback : ?did:doc_id -> ?id:Stateid.t -> ?route:route_id -> feedback_content -> unit
 
 (** [set_id_for_feedback route id] Set the defaults for feedback *)
-val set_id_for_feedback : ?route:route_id -> Stateid.t -> unit
+val set_id_for_feedback : ?route:route_id -> doc_id -> Stateid.t -> unit
 
 (** {6 output functions}
 
@@ -90,8 +94,17 @@ val msg_warning : ?loc:Loc.t -> Pp.t -> unit
     consequences. *)
 
 val msg_error : ?loc:Loc.t -> Pp.t -> unit
-(** Message indicating that something went really wrong, though still
-    recoverable; otherwise an exception would have been raised. *)
+[@@ocaml.deprecated "msg_error is an internal function and should not be \
+                     used unless you know what you are doing. Use \
+                     [CErrors.user_err] instead."]
 
 val msg_debug : ?loc:Loc.t -> Pp.t -> unit
 (** For debugging purposes *)
+
+val console_feedback_listener : Format.formatter -> feedback -> unit
+(** Helper for tools willing to print to the feedback system *)
+
+val warn_no_listeners : bool ref
+(** The library will print a warning to the console if no listener is
+    available by default; ML-clients willing to use Coq without a
+    feedback handler should set this to false. *)
diff --git a/lib/flags.ml b/lib/flags.ml
index d4be81c61..5da131020 100644
--- a/lib/flags.ml
+++ b/lib/flags.ml
@@ -6,13 +6,27 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-let with_option o f x =
-  let old = !o in o:=true;
-   try let r = f x in if !o = true then o := old; r
-   with reraise ->
-     let reraise = Backtrace.add_backtrace reraise in
-     let () = o := old in
-     Exninfo.iraise reraise
+(* If [restore] is false, whenever [f] modifies the ref, we will
+   preserve the modification. *)
+let with_modified_ref ?(restore=true) r nf f x =
+  let old_ref = !r in r := nf !r;
+  try
+    let pre = !r in
+    let res = f x in
+    (* If r was modified don't restore its old value *)
+    if restore || pre == !r then r := old_ref;
+    res
+  with reraise ->
+    let reraise = Backtrace.add_backtrace reraise in
+    r := old_ref;
+    Exninfo.iraise reraise
+
+let with_option o f x = with_modified_ref ~restore:false o (fun _ -> true) f x
+let without_option o f x = with_modified_ref ~restore:false o (fun _ -> false) f x
+let with_extra_values o l f x = with_modified_ref o (fun ol -> ol@l) f x
+
+(* hide the [restore] option as internal *)
+let with_modified_ref r nf f x = with_modified_ref r nf f x
 
 let with_options ol f x =
   let vl = List.map (!) ol in
@@ -25,62 +39,16 @@ let with_options ol f x =
     let () = List.iter2 (:=) ol vl in
     Exninfo.iraise reraise
 
-let without_option o f x =
-  let old = !o in o:=false;
-  try let r = f x in if !o = false then o := old; r
-  with reraise ->
-    let reraise = Backtrace.add_backtrace reraise in
-    let () = o := old in
-    Exninfo.iraise reraise
-
-let with_extra_values o l f x =
-  let old = !o in o:=old@l;
-  try let r = f x in o := old; r
-  with reraise ->
-    let reraise = Backtrace.add_backtrace reraise in
-    let () = o := old in
-    Exninfo.iraise reraise
-
 let boot = ref false
-let load_init = ref true
-let batch_mode = ref false
 
-type compilation_mode = BuildVo | BuildVio | Vio2Vo
-let compilation_mode = ref BuildVo
-let compilation_output_name = ref None
+let record_aux_file = ref false
 
 let test_mode = ref false
 
-type async_proofs = APoff | APonLazy | APon
-let async_proofs_mode = ref APoff
-type cache = Force
-let async_proofs_cache = ref None
-let async_proofs_n_workers = ref 1
-let async_proofs_n_tacworkers = ref 2
-let async_proofs_private_flags = ref None
-let async_proofs_full = ref false
-let async_proofs_never_reopen_branch = ref false
-let async_proofs_flags_for_workers = ref []
 let async_proofs_worker_id = ref "master"
-type priority = Low | High
-let async_proofs_worker_priority = ref Low
-let string_of_priority = function Low -> "low" | High -> "high"
-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 async_proofs_is_worker () = !async_proofs_worker_id <> "master"
 
 let debug = ref false
-let stm_debug = ref false
 
 let in_debugger = ref false
 let in_toplevel = ref false
@@ -88,12 +56,8 @@ let in_toplevel = ref false
 let profile = false
 
 let ide_slave = ref false
-let ideslave_coqtop_flags = ref None
-
-let time = ref false
 
 let raw_print = ref false
-
 let univ_print = ref false
 
 let we_are_parsing = ref false
@@ -144,10 +108,6 @@ let verbosely f x = without_option quiet f x
 let if_silent f x = if !quiet then f x
 let if_verbose f x = if not !quiet then f x
 
-let make_silent flag = quiet := flag
-let is_silent () = !quiet
-let is_verbose () = not !quiet
-
 let auto_intros = ref true
 let make_auto_intros flag = auto_intros := flag
 let is_auto_intros () = !auto_intros
@@ -156,14 +116,6 @@ let universe_polymorphism = ref false
 let make_universe_polymorphism b = universe_polymorphism := b
 let is_universe_polymorphism () = !universe_polymorphism
 
-let local_polymorphic_flag = ref None
-let use_polymorphic_flag () = 
-  match !local_polymorphic_flag with 
-  | Some p -> local_polymorphic_flag := None; p
-  | None -> is_universe_polymorphism ()
-let make_polymorphic_flag b =
-  local_polymorphic_flag := Some b
-
 let polymorphic_inductive_cumulativity = ref false
 let make_polymorphic_inductive_cumulativity b = polymorphic_inductive_cumulativity := b
 let is_polymorphic_inductive_cumulativity () = !polymorphic_inductive_cumulativity
@@ -199,14 +151,6 @@ let is_standard_doc_url url =
 let coqlib_spec = ref false
 let coqlib = ref "(not initialized yet)"
 
-(* Options for changing ocamlfind (used by coqmktop) *)
-let ocamlfind_spec = ref false
-let ocamlfind = ref Coq_config.camlbin
-
-(* Options for changing camlp4bin (used by coqmktop) *)
-let camlp4bin_spec = ref false
-let camlp4bin = ref Coq_config.camlp4bin
-
 (* Level of inlining during a functor application *)
 
 let default_inline_level = 100
@@ -215,15 +159,18 @@ let set_inline_level = (:=) inline_level
 let get_inline_level () = !inline_level
 
 (* Native code compilation for conversion and normalization *)
-let native_compiler = ref false
+let output_native_objects = ref false
 
 (* Print the mod uid associated to a vo file by the native compiler *)
 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
 let get_dump_bytecode () = !dump_bytecode
+
+let dump_lambda = ref false
+let set_dump_lambda = (:=) dump_lambda
+let get_dump_lambda () = !dump_lambda
diff --git a/lib/flags.mli b/lib/flags.mli
index 3024c6039..bc07dec80 100644
--- a/lib/flags.mli
+++ b/lib/flags.mli
@@ -11,57 +11,28 @@
 (** Command-line flags  *)
 
 val boot : bool ref
-val load_init : bool ref
 
-(* Will affect STM caching *)
-val batch_mode : bool ref
-
-type compilation_mode = BuildVo | BuildVio | Vio2Vo
-val compilation_mode : compilation_mode ref
-val compilation_output_name : string option ref
+(** Set by coqtop to tell the kernel to output to the aux file; will
+    be eventually removed by cleanups such as PR#1103 *)
+val record_aux_file : bool ref
 
 (* Flag set when the test-suite is called. Its only effect to display
    verbose information for `Fail` *)
 val test_mode : bool ref
 
 (** Async-related flags *)
-type async_proofs = APoff | APonLazy | APon
-val async_proofs_mode : async_proofs ref
-type cache = Force
-val async_proofs_cache : cache option ref
-val async_proofs_n_workers : int ref
-val async_proofs_n_tacworkers : int ref
-val async_proofs_private_flags : string option ref
-val async_proofs_is_worker : unit -> bool
-val async_proofs_is_master : unit -> bool
-val async_proofs_full : bool ref
-val async_proofs_never_reopen_branch : bool ref
-val async_proofs_flags_for_workers : string list ref
 val async_proofs_worker_id : string ref
-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 async_proofs_is_worker : unit -> bool
 
+(** Debug flags *)
 val debug : bool ref
 val in_debugger : bool ref
 val in_toplevel : bool ref
 
-(** Enable STM debugging *)
-val stm_debug : bool ref
-
 val profile : bool
 
 (* -ide_slave: printing will be more verbose, will affect stm caching *)
 val ide_slave : bool ref
-val ideslave_coqtop_flags : string option ref
-
-(* -time option: every command will be wrapped with `Time` *)
-val time : bool ref
 
 (* development flag to detect race conditions, it should go away. *)
 val we_are_parsing : bool ref
@@ -91,14 +62,6 @@ val verbosely : ('a -> 'b) -> 'a -> 'b
 val if_silent : ('a -> unit) -> 'a -> unit
 val if_verbose : ('a -> unit) -> 'a -> unit
 
-(* Deprecated *)
-val make_silent : bool -> unit
-[@@ocaml.deprecated "Please use Flags.quiet"]
-val is_silent : unit -> bool
-[@@ocaml.deprecated "Please use Flags.quiet"]
-val is_verbose : unit -> bool
-[@@ocaml.deprecated "Please use Flags.quiet"]
-
 (* Miscellaneus flags for vernac *)
 val make_auto_intros : bool -> unit
 val is_auto_intros : unit -> bool
@@ -110,10 +73,6 @@ val is_program_mode : unit -> bool
 val make_universe_polymorphism : bool -> unit
 val is_universe_polymorphism : unit -> bool
 
-(** Local universe polymorphism flag. *)
-val make_polymorphic_flag : bool -> unit
-val use_polymorphic_flag : unit -> bool
-
 (** Global polymorphic inductive cumulativity flag. *)
 val make_polymorphic_inductive_cumulativity : bool -> unit
 val is_polymorphic_inductive_cumulativity : unit -> bool
@@ -122,6 +81,15 @@ val warn : bool ref
 val make_warn : bool -> unit
 val if_warn : ('a -> unit) -> 'a -> unit
 
+(** [with_modified_ref r nf f x] Temporarily modify a reference in the
+    call to [f x] . Be very careful with these functions, it is very
+    easy to fall in the typical problem with effects:
+
+    with_modified_ref r nf f x y != with_modified_ref r nf (f x) y
+
+*)
+val with_modified_ref : 'c ref -> ('c -> 'c) -> ('a -> 'b) -> 'a -> 'b
+
 (** Temporarily activate an option (to activate option [o] on [f x y z],
    use [with_option o (f x y) z]) *)
 val with_option : bool ref -> ('a -> 'b) -> 'a -> 'b
@@ -146,27 +114,17 @@ val is_standard_doc_url : string -> bool
 val coqlib_spec : bool ref
 val coqlib : string ref
 
-(** Options for specifying where OCaml binaries reside *)
-val ocamlfind_spec : bool ref
-val ocamlfind : string ref
-val camlp4bin_spec : bool ref
-val camlp4bin : string ref
-
 (** Level of inlining during a functor application *)
 val set_inline_level : int -> unit
 val get_inline_level : unit -> int
 val default_inline_level : int
 
-(** Native code compilation for conversion and normalization *)
-val native_compiler : bool ref
+(** When producing vo objects, also compile the native-code version *)
+val output_native_objects : bool ref
 
 (** Print the mod uid associated to a vo file by the native compiler *)
 val print_mod_uid : bool ref
 
-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
 
@@ -174,3 +132,8 @@ val profile_ltac_cutoff : float ref
 val dump_bytecode : bool ref
 val set_dump_bytecode : bool -> unit
 val get_dump_bytecode : unit -> bool
+
+(** Dump the VM lambda code after compilation (for debugging purposes) *)
+val dump_lambda : bool ref
+val set_dump_lambda : bool -> unit
+val get_dump_lambda : unit -> bool
diff --git a/lib/future.ml b/lib/future.ml
index d9463aa0f..09285ea27 100644
--- a/lib/future.ml
+++ b/lib/future.ml
@@ -6,12 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* To deal with side effects we have to save/restore the system state *)
-type freeze
-let freeze = ref (fun () -> assert false : unit -> freeze)
-let unfreeze = ref (fun _ -> () : freeze -> unit)
-let set_freeze f g = freeze := f; unfreeze := g
-
 let not_ready_msg = ref (fun name ->
       Pp.strbrk("The value you are asking for ("^name^") is not ready yet. "^
                 "Please wait or pass "^
@@ -30,6 +24,7 @@ let customize_not_here_msg f = not_here_msg := f
 
 exception NotReady of string
 exception NotHere of string
+
 let _ = CErrors.register_handler (function
   | NotReady name -> !not_ready_msg name
   | NotHere name -> !not_here_msg name
@@ -59,7 +54,7 @@ type 'a assignement = [ `Val of 'a | `Exn of Exninfo.iexn | `Comp of 'a computat
 and 'a comp =
   | Delegated of (unit -> unit)
   | Closure of (unit -> 'a)
-  | Val of 'a * freeze option
+  | Val of 'a
   | Exn of Exninfo.iexn  (* Invariant: this exception is always "fixed" as in fix_exn *)
 
 and 'a comput =
@@ -74,7 +69,7 @@ let create ?(name=unnamed) ?(uuid=UUID.fresh ()) f x =
   ref (Ongoing (name, CEphemeron.create (uuid, f, Pervasives.ref x)))
 let get x =
   match !x with
-  | Finished v -> unnamed, UUID.invalid, id, ref (Val (v,None))
+  | Finished v -> unnamed, UUID.invalid, id, ref (Val v)
   | Ongoing (name, x) ->
       try let uuid, fix, c = CEphemeron.get x in name, uuid, fix, c
       with CEphemeron.InvalidKey ->
@@ -95,13 +90,13 @@ let is_exn kx = let _, _, _, x = get kx in match !x with
   | Val _ | Closure _ | Delegated _ -> false
 
 let peek_val kx = let _, _, _, x = get kx in match !x with
-  | Val (v, _) -> Some v
+  | Val v -> Some v
   | Exn _ | Closure _ | Delegated _ -> None
 
 let uuid kx = let _, id, _, _ = get kx in id
 
-let from_val ?(fix_exn=id) v = create fix_exn (Val (v, None))
-let from_here ?(fix_exn=id) v = create fix_exn (Val (v, Some (!freeze ())))
+let from_val ?(fix_exn=id) v = create fix_exn (Val v)
+let from_here ?(fix_exn=id) v = create fix_exn (Val v)
 
 let fix_exn_of ck = let _, _, fix_exn, _ = get ck in fix_exn
 
@@ -110,7 +105,7 @@ let create_delegate ?(blocking=true) ~name fix_exn =
     let _, _, fix_exn, c = get ck in
     assert (match !c with Delegated _ -> true | _ -> false);
     begin match v with
-    | `Val v -> c := Val (v, None)
+    | `Val v -> c := Val v
     | `Exn e -> c := Exn (fix_exn e)
     | `Comp f -> let _, _, _, comp = get f in c := !comp end;
     signal () in
@@ -124,17 +119,16 @@ let create_delegate ?(blocking=true) ~name fix_exn =
   ck, assignement signal ck
 
 (* TODO: get rid of try/catch to be stackless *)
-let rec compute ~pure ck : 'a value =
+let rec compute ck : 'a value =
   let _, _, fix_exn, c = get ck in
   match !c with
-  | Val (x, _) -> `Val x
+  | Val x -> `Val x
   | Exn (e, info) -> `Exn (e, info)
-  | Delegated wait -> wait (); compute ~pure ck
+  | Delegated wait -> wait (); compute ck
   | Closure f ->
       try
         let data = f () in
-        let state = if pure then None else Some (!freeze ()) in
-        c := Val (data, state); `Val data
+        c := Val data; `Val data
       with e ->
         let e = CErrors.push e in
         let e = fix_exn e in
@@ -142,60 +136,30 @@ let rec compute ~pure ck : 'a value =
         | (NotReady _, _) -> `Exn e
         | _ -> c := Exn e; `Exn e
 
-let force ~pure x = match compute ~pure x with
+let force x = match compute x with
   | `Val v -> v
   | `Exn e -> Exninfo.iraise e
 
-let chain ~pure ck f =
+let chain ck f =
   let name, uuid, fix_exn, c = get ck in
   create ~uuid ~name fix_exn (match !c with
-  | Closure _ | Delegated _ -> Closure (fun () -> f (force ~pure ck))
+  | Closure _ | Delegated _ -> Closure (fun () -> f (force ck))
   | Exn _ as x -> x
-  | Val (v, None)   when pure -> Val (f v, None)
-  | Val (v, Some _) when pure -> Val (f v, None)
-  | Val (v, Some state) -> Closure (fun () -> !unfreeze state; f v)
-  | Val (v, None) ->
-      match !ck with
-      | Finished _ -> CErrors.anomaly(Pp.str
-          "Future.chain ~pure:false call on an already joined computation.")
-      | 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 "^
-          "function and later forced.")))
+  | Val v -> Val (f v))
 
 let create fix_exn f = create fix_exn (Closure f)
 
 let replace kx y =
   let _, _, _, x = get kx in
   match !x with
-  | Exn _ -> x := Closure (fun () -> force ~pure:false y)
+  | Exn _ -> x := Closure (fun () -> force y)
   | _ -> CErrors.anomaly
            (Pp.str "A computation can be replaced only if is_exn holds.")
 
-let purify f x =
-  let state = !freeze () in
-  try
-    let v = f x in
-    !unfreeze state;
-    v
-  with 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 = 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
-let force ~pure x = purify_future (force ~pure) x
-let chain ~pure x f =
-  let y = chain ~pure x f in
-  if is_over x then ignore(force ~pure y);
+let chain x f =
+  let y = chain x f in
+  if is_over x then ignore(force y);
   y
-let force x = force ~pure:false x
 
 let join kx =
   let v = force kx in
@@ -205,12 +169,11 @@ let join kx =
 let sink kx = if is_val kx then ignore(join kx)
 
 let split2 x =
-  chain ~pure:true x (fun x -> fst x),
-  chain ~pure:true x (fun x -> snd x)
+  chain x (fun x -> fst x), chain x (fun x -> snd x)
 
 let map2 f x l =
   CList.map_i (fun i y ->
-    let xi = chain ~pure:true x (fun x ->
+    let xi = chain x (fun x ->
         try List.nth x i
         with Failure _ | Invalid_argument _ ->
           CErrors.anomaly (Pp.str "Future.map2 length mismatch.")) in
@@ -226,6 +189,5 @@ let print f kx =
   match !x with
   | Delegated _ -> str "Delegated" ++ uid
   | Closure _ -> str "Closure" ++ uid
-  | Val (x, None) -> str "PureVal" ++ uid ++ spc () ++ hov 0 (f x)
-  | Val (x, Some _) -> str "StateVal" ++ uid ++ spc () ++ hov 0 (f x)
+  | Val x -> str "PureVal" ++ uid ++ spc () ++ hov 0 (f x)
   | Exn (e, _) -> str "Exn"  ++ uid ++ spc () ++ hov 0 (str (Printexc.to_string e))
diff --git a/lib/future.mli b/lib/future.mli
index acfce51a0..853f81cea 100644
--- a/lib/future.mli
+++ b/lib/future.mli
@@ -6,42 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* Futures: asynchronous computations with some purity enforcing
+(* Futures: asynchronous computations.
  *
  * A Future.computation is like a lazy_t but with some extra bells and whistles
- * to deal with imperative code and eventual delegation to a slave process.
+ * to deal with eventual delegation to a slave process.
  *
- * Example of a simple scenario taken into account:
- *
- *   let f = Future.from_here (number_of_constants (Global.env())) in
- *   let g = Future.chain ~pure:false f (fun n ->
- *             n = number_of_constants (Global.env())) in
- *   ...
- *   Lemmas.save_named ...;
- *   ...
- *   let b = Future.force g in
- *
- * The Future.computation f holds a (immediate, no lazy here) value.
- * We then chain to obtain g that (will) hold false if (when it will be
- * run) the global environment has a different number of constants, true
- * if nothing changed.
- * Before forcing g, we add to the global environment one more constant.
- * When finally we force g.  Its value is going to be *true*.
- * This because Future.from_here stores in the computation not only the initial
- * value but the entire system state.  When g is forced the state is restored,
- * hence Global.env() returns the environment that was actual when f was
- * created.
- * Last, forcing g is run protecting the system state, hence when g finishes,
- * the actual system state is restored.
- *
- * If you compare this with lazy_t, you see that the value returned is *false*,
- * that is counter intuitive and error prone.
- *
- * Still not all computations are impure and access/alter the system state.
- * This class can be optimized by using ~pure:true, but there is no way to
- * statically check if this flag is misused, hence use it with care.
- *
- * Other differences with lazy_t is that a future computation that produces
+ * One difference with lazy_t is that a future computation that produces
  * and exception can be substituted for another computation of the same type.
  * Moreover a future computation can be delegated to another execution entity
  * that will be allowed to set the result.  Finally future computations can
@@ -113,27 +83,17 @@ val is_exn : 'a computation -> bool
 val peek_val : 'a computation -> 'a option
 val uuid : 'a computation -> UUID.t
 
-(* [chain pure c f] chains computation [c] with [f].
- * [chain] forces immediately the new computation if the old one is_over (Exn or Val).
- * The [pure] parameter is tricky:
- * [pure]:
- *   When pure is true, the returned computation will not keep a copy
- *   of the global state.
- *   [let c' = chain ~pure:true c f in let c'' = chain ~pure:false c' g in]
- *   is invalid.  It works if one forces [c''] since the whole computation
- *   will be executed in one go.  It will not work, and raise an anomaly, if
- *   one forces c' and then c''.
- *   [join c; chain ~pure:false c g] is invalid and fails at runtime.
- *   [force c; chain ~pure:false c g] is correct.
- *)
-val chain : pure:bool ->
-  'a computation -> ('a -> 'b) -> 'b computation
+(* [chain c f] chains computation [c] with [f].
+ * [chain] is eager, that is to say, it won't suspend the new computation
+ * if the old one is_over (Exn or Val).
+*)
+val chain : 'a computation -> ('a -> 'b) -> 'b computation
 
 (* Forcing a computation *)
 val force : 'a computation -> 'a
 val compute : 'a computation -> 'a value
 
-(* Final call, no more *inpure* chain allowed since the state is lost.
+(* Final call.
  * Also the fix_exn function is lost, hence error reporting can be incomplete
  * in a computation obtained by chaining on a joined future. *)
 val join : 'a computation -> 'a
@@ -148,19 +108,8 @@ val map2 :
   ('a computation -> 'b -> 'c) ->
      'a list computation -> 'b list -> 'c list
 
-(* Once set_freeze is called we can purify a computation *)
-val purify : ('a -> 'b) -> 'a -> 'b
-(* And also let a function alter the state but backtrack if it raises exn *)
-val transactify : ('a -> 'b) -> 'a -> 'b
-
 (** Debug: print a computation given an inner printing function. *)
 val print : ('a -> Pp.t) -> 'a computation -> Pp.t
 
-type freeze
-(* These functions are needed to get rid of side effects.
-   Thy are set for the outermos layer of the system, since they have to
-   deal with the whole system state. *)
-val set_freeze : (unit -> freeze) -> (freeze -> unit) -> unit
-
 val customize_not_ready_msg : (string -> Pp.t) -> unit
 val customize_not_here_msg : (string -> Pp.t) -> unit
diff --git a/lib/genarg.ml b/lib/genarg.ml
index b78fe4037..a3bfb405c 100644
--- a/lib/genarg.ml
+++ b/lib/genarg.ml
@@ -11,7 +11,7 @@ open Util
 
 module ArgT =
 struct
-  module DYN = Dyn.Make(struct end)
+  module DYN = Dyn.Make ()
   module Map = DYN.Map
   type ('a, 'b, 'c) tag = ('a * 'b * 'c) DYN.tag
   type any = Any : ('a, 'b, 'c) tag -> any
diff --git a/lib/lib.mllib b/lib/lib.mllib
index 8791f0741..b2260ba09 100644
--- a/lib/lib.mllib
+++ b/lib/lib.mllib
@@ -1,21 +1,30 @@
+Coq_config
+
+Hook
+Flags
+Control
+Util
+
+Pp
+Stateid
+Loc
+Feedback
 CErrors
 CWarnings
-Bigint
-Segmenttree
-Unicodetable
-Unicode
-Minisys
+
+Rtree
 System
-CThread
-Spawn
-Trie
-Profile
 Explore
-Predicate
-Rtree
-Heap
-Unionfind
-Genarg
-CEphemeron
+RTree
+CProfile
 Future
+Spawn
+
+CAst
+DAst
+Genarg
+
 RemoteCounter
+Aux_file
+Envars
+CoqProject_file
diff --git a/lib/loc.ml b/lib/loc.ml
index 9f036d90f..2cf4d3960 100644
--- a/lib/loc.ml
+++ b/lib/loc.ml
@@ -8,8 +8,12 @@
 
 (* Locations management *)
 
+type source =
+  | InFile of string
+  | ToplevelInput
+
 type t = {
-  fname : string; (** filename *)
+  fname : source; (** filename or toplevel input *)
   line_nb : int; (** start line number *)
   bol_pos : int; (** position of the beginning of start line *)
   line_nb_last : int; (** end line number *)
@@ -23,10 +27,15 @@ let create fname line_nb bol_pos bp ep = {
   line_nb_last = line_nb; bol_pos_last = bol_pos; bp = bp; ep = ep; }
 
 let make_loc (bp, ep) = {
-  fname = ""; line_nb = -1; bol_pos = 0; line_nb_last = -1; bol_pos_last = 0;
+  fname = ToplevelInput; line_nb = -1; bol_pos = 0; line_nb_last = -1; bol_pos_last = 0;
   bp = bp; ep = ep; }
 
+let mergeable loc1 loc2 =
+  loc1.fname = loc2.fname
+
 let merge loc1 loc2 =
+  if not (mergeable loc1 loc2) then
+    failwith "Trying to merge unmergeable locations.";
   if loc1.bp < loc2.bp then
     if loc1.ep < loc2.ep then {
       fname = loc1.fname;
@@ -53,6 +62,8 @@ let merge_opt l1 l2 = match l1, l2 with
 
 let unloc loc = (loc.bp, loc.ep)
 
+let shift_loc kb kp loc = { loc with bp = loc.bp + kb ; ep = loc.ep + kp }
+
 (** Located type *)
 type 'a located = t option * 'a
 
@@ -73,9 +84,3 @@ let raise ?loc e =
     let info = Exninfo.add Exninfo.null location loc in
     Exninfo.iraise (e, info)
 
-(** Deprecated *)
-let located_fold_left f x (_,a) = f x a
-let located_iter2 f (_,a) (_,b) = f a b
-let down_located f (_,a) = f a
-
-
diff --git a/lib/loc.mli b/lib/loc.mli
index 1fbaae836..800940f21 100644
--- a/lib/loc.mli
+++ b/lib/loc.mli
@@ -8,8 +8,12 @@
 
 (** {5 Basic types} *)
 
+type source =
+  | InFile of string
+  | ToplevelInput
+
 type t = {
-  fname : string; (** filename *)
+  fname : source; (** filename or toplevel input *)
   line_nb : int; (** start line number *)
   bol_pos : int; (** position of the beginning of start line *)
   line_nb_last : int; (** end line number *)
@@ -22,7 +26,7 @@ type t = {
 
 (** This is inherited from CAMPL4/5. *)
 
-val create : string -> int -> int -> int -> int -> t
+val create : source -> int -> int -> int -> int -> t
 (** Create a location from a filename, a line number, a position of the
     beginning of the line, a start and end position *)
 
@@ -36,6 +40,11 @@ val merge : t -> t -> t
 val merge_opt : t option -> t option -> t option
 (** Merge locations, usually generating the largest possible span *)
 
+val shift_loc : int -> int -> t -> t
+(** [shift_loc loc n p] shifts the beginning of location by [n] and
+    the end by [p]; it is assumed that the shifts do not change the
+    lines at which the location starts and ends *)
+
 (** {5 Located exceptions} *)
 
 val add_loc : Exninfo.info -> t -> Exninfo.info
@@ -56,14 +65,3 @@ val tag : ?loc:t -> 'a -> 'a located
 
 val map : ('a -> 'b) -> 'a located -> 'b located
 (** Modify an object carrying a location *)
-
-(** Deprecated functions  *)
-val located_fold_left : ('a -> 'b -> 'a) -> 'a -> 'b located -> 'a
- [@@ocaml.deprecated "use pattern matching"]
-
-val down_located : ('a -> 'b) -> 'a located -> 'b
- [@@ocaml.deprecated "use pattern matching"]
-
-val located_iter2 : ('a -> 'b -> unit) -> 'a located -> 'b located -> unit
- [@@ocaml.deprecated "use pattern matching"]
-
diff --git a/lib/pp.ml b/lib/pp.ml
index 88ddcb35b..770e650cb 100644
--- a/lib/pp.ml
+++ b/lib/pp.ml
@@ -82,10 +82,21 @@ let utf8_length s =
   done ;
   !cnt
 
-let app s1 s2 = match s1, s2 with
-  | Ppcmd_empty, s
-  | s, Ppcmd_empty -> s
-  | s1, s2         -> Ppcmd_glue [s1; s2]
+let rec app d1 d2 = match d1, d2 with
+  | Ppcmd_empty,        d
+  | d,                  Ppcmd_empty      -> d
+
+  (* Optimizations *)
+  | Ppcmd_glue [l1;l2], Ppcmd_glue l3    -> Ppcmd_glue (l1 :: l2 :: l3)
+  | Ppcmd_glue [l1;l2], d2               -> Ppcmd_glue [l1 ; l2 ; d2]
+  | d1,                 Ppcmd_glue l2    -> Ppcmd_glue (d1 :: l2)
+
+  | Ppcmd_tag(t1,d1),   Ppcmd_tag(t2,d2)
+    when t1 = t2                         -> Ppcmd_tag(t1,app d1 d2)
+  | d1, d2                               -> Ppcmd_glue [d1; d2]
+  (* Optimizations deemed too costly *)
+  (* | Ppcmd_glue l1,    Ppcmd_glue l2    -> Ppcmd_glue   (l1 @ l2) *)
+  (* | Ppcmd_string s1,  Ppcmd_string s2  -> Ppcmd_string (s1 ^ s2) *)
 
 let seq s = Ppcmd_glue s
 
@@ -197,6 +208,7 @@ let string_of_ppcmds c =
 let pr_comma () = str "," ++ spc ()
 let pr_semicolon () = str ";" ++ spc ()
 let pr_bar () = str "|" ++ spc ()
+let pr_spcbar () = str " |" ++ spc ()
 let pr_arg pr x = spc () ++ pr x
 let pr_non_empty_arg pr x = let pp = pr x in if ismt pp then mt () else spc () ++ pr x
 let pr_opt pr = function None -> mt () | Some x -> pr_arg pr x
diff --git a/lib/pp.mli b/lib/pp.mli
index 2d11cad86..d9be1c5ce 100644
--- a/lib/pp.mli
+++ b/lib/pp.mli
@@ -120,6 +120,9 @@ val pr_semicolon : unit -> t
 val pr_bar : unit -> t
 (** Well-spaced pipe bar. *)
 
+val pr_spcbar : unit -> t
+(** Pipe bar with space before and after. *)
+
 val pr_arg : ('a -> t) -> 'a -> t
 (** Adds a space in front of its argument. *)
 
diff --git a/lib/spawn.ml b/lib/spawn.ml
index 0cf163e73..de31d87d0 100644
--- a/lib/spawn.ml
+++ b/lib/spawn.ml
@@ -28,8 +28,6 @@ module type Control = sig
 
 end
 
-module type Empty = sig end
-
 module type MainLoopModel = sig
   type async_chan
   type condition
@@ -216,7 +214,7 @@ let rec wait p =
 
 end
 
-module Sync(T : Empty) = struct
+module Sync () = struct
 
 type process = {
   cin  : in_channel;
diff --git a/lib/spawn.mli b/lib/spawn.mli
index a131715e9..fd2b92ae3 100644
--- a/lib/spawn.mli
+++ b/lib/spawn.mli
@@ -34,8 +34,6 @@ module type Control = sig
 end
 
 (* Abstraction to work with both threads and main loop models *)
-module type Empty = sig end
-
 module type MainLoopModel = sig
   type async_chan
   type condition
@@ -64,7 +62,7 @@ module Async(ML : MainLoopModel) : sig
 end
 
 (* spawn a process and read its output synchronously *)
-module Sync(T : Empty) : sig
+module Sync () : sig
   type process
   
   val spawn :
diff --git a/lib/system.ml b/lib/system.ml
index 12eacf2ea..e56736eb1 100644
--- a/lib/system.ml
+++ b/lib/system.ml
@@ -52,7 +52,9 @@ let dirmap = ref StrMap.empty
 
 let make_dir_table dir =
   let filter_dotfiles s f = if f.[0] = '.' then s else StrSet.add f s in
-  Array.fold_left filter_dotfiles StrSet.empty (readdir dir)
+  Array.fold_left filter_dotfiles StrSet.empty (Sys.readdir dir)
+
+let trust_file_cache = ref true
 
 let exists_in_dir_respecting_case dir bf =
   let cache_dir dir =
@@ -62,10 +64,10 @@ let exists_in_dir_respecting_case dir bf =
   let contents, fresh =
     try
       (* in batch mode, assume the directory content is still fresh *)
-      StrMap.find dir !dirmap, !Flags.batch_mode
+      StrMap.find dir !dirmap, !trust_file_cache
     with Not_found ->
       (* in batch mode, we are not yet sure the directory exists *)
-      if !Flags.batch_mode && not (exists_dir dir) then StrSet.empty, true
+      if !trust_file_cache && not (exists_dir dir) then StrSet.empty, true
       else cache_dir dir, true in
   StrSet.mem bf contents ||
     not fresh &&
@@ -80,7 +82,7 @@ let file_exists_respecting_case path f =
     let df = Filename.dirname f in
     (String.equal df "." || aux df)
     && exists_in_dir_respecting_case (Filename.concat path df) bf
-  in (!Flags.batch_mode || Sys.file_exists (Filename.concat path f)) && aux f
+  in (!trust_file_cache || Sys.file_exists (Filename.concat path f)) && aux f
 
 let rec search paths test =
   match paths with
@@ -292,24 +294,18 @@ let fmt_time_difference (startreal,ustart,sstart) (stopreal,ustop,sstop) =
   real (round (sstop -. sstart)) ++ str "s" ++
   str ")"
 
-let with_time time f x =
+let with_time ~batch f x =
   let tstart = get_time() in
-  let msg = if time then "" else "Finished transaction in " in
+  let msg = if batch then "" else "Finished transaction in " in
   try
     let y = f x in
     let tend = get_time() in
-    let msg2 = if time then "" else " (successful)" in
+    let msg2 = if batch then "" else " (successful)" in
     Feedback.msg_info (str msg ++ fmt_time_difference tstart tend ++ str msg2);
     y
   with e ->
     let tend = get_time() in
-    let msg = if time then "" else "Finished failing transaction in " in
-    let msg2 = if time then "" else " (failure)" in
+    let msg = if batch then "" else "Finished failing transaction in " in
+    let msg2 = if batch then "" else " (failure)" in
     Feedback.msg_info (str msg ++ fmt_time_difference tstart tend ++ str msg2);
     raise e
-
-let process_id () =
-  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 7281de97c..0c0cc9fae 100644
--- a/lib/system.mli
+++ b/lib/system.mli
@@ -54,6 +54,12 @@ val where_in_path_rex :
 val find_file_in_path :
   ?warn:bool -> CUnix.load_path -> string -> CUnix.physical_path * string
 
+val trust_file_cache : bool ref
+(** [trust_file_cache] indicates whether we trust the underlying
+    mapped file-system not to change along the execution of Coq. This
+    assumption greatly speds up file search, but it is often
+    inconvenient in interactive mode *)
+
 val file_exists_respecting_case : string -> string -> bool
 
 (** {6 I/O functions } *)
@@ -98,7 +104,4 @@ val get_time : unit -> time
 val time_difference : time -> time -> float (** in seconds *)
 val fmt_time_difference : time -> time -> Pp.t
 
-val with_time : bool -> ('a -> 'b) -> 'a -> 'b
-
-(** {6 Name of current process.} *)
-val process_id : unit -> string
+val with_time : batch:bool -> ('a -> 'b) -> 'a -> 'b
diff --git a/lib/util.ml b/lib/util.ml
index 36282b2da..6de012da0 100644
--- a/lib/util.ml
+++ b/lib/util.ml
@@ -171,3 +171,12 @@ let open_utf8_file_in fname =
   let s = Bytes.make 3 ' ' in
   if input in_chan s 0 3 < 3 || not (is_bom s) then seek_in in_chan 0;
   in_chan
+
+(** A trick which can typically be used to store on the fly the
+   computation of values in the "when" clause of a "match" then
+   retrieve the evaluated result in the r.h.s of the clause *)
+
+let set_temporary_memory () =
+  let a = ref None in
+  (fun x -> assert (!a = None); a := Some x; x),
+  (fun () -> match !a with Some x -> x | None -> assert false)
diff --git a/lib/util.mli b/lib/util.mli
index d910e7e28..c54f5825c 100644
--- a/lib/util.mli
+++ b/lib/util.mli
@@ -137,3 +137,8 @@ val sym : ('a, 'b) eq -> ('b, 'a) eq
 
 val open_utf8_file_in : string -> in_channel
 (** Open an utf-8 encoded file and skip the byte-order mark if any. *)
+
+val set_temporary_memory : unit -> ('a -> 'a) * (unit -> 'a)
+(** A trick which can typically be used to store on the fly the
+   computation of values in the "when" clause of a "match" then
+   retrieve the evaluated result in the r.h.s of the clause *)
diff --git a/library/coqlib.ml b/library/coqlib.ml
index 8787738af..4a2390985 100644
--- a/library/coqlib.ml
+++ b/library/coqlib.ml
@@ -14,7 +14,7 @@ open Libnames
 open Globnames
 open Nametab
 
-let coq = Nameops.coq_string (* "Coq" *)
+let coq = Libnames.coq_string (* "Coq" *)
 
 (************************************************************************)
 (* Generic functions to find Coq objects *)
@@ -32,7 +32,7 @@ let find_reference locstr dir s =
        of not found errors here *)
     user_err ~hdr:locstr
       Pp.(str "cannot find " ++ Libnames.pr_path sp ++
-          str "; maybe library " ++ Libnames.pr_dirpath dp ++
+          str "; maybe library " ++ DirPath.print dp ++
           str " has to be required first.")
 
 let coq_reference locstr dir s = find_reference locstr (coq::dir) s
@@ -52,14 +52,14 @@ let gen_reference_in_modules locstr dirs s =
     | [] ->
 	anomaly ~label:locstr (str "cannot find " ++ str s ++
 	str " in module" ++ str (if List.length dirs > 1 then "s " else " ") ++
-	prlist_with_sep pr_comma pr_dirpath dirs ++ str ".")
+        prlist_with_sep pr_comma DirPath.print dirs ++ str ".")
     | l ->
       anomaly ~label:locstr
 	(str "ambiguous name " ++ str s ++ str " can represent " ++
 	   prlist_with_sep pr_comma
 	   (fun x -> Libnames.pr_path (Nametab.path_of_global x)) l ++
 	   str " in module" ++ str (if List.length dirs > 1 then "s " else " ") ++
-	   prlist_with_sep pr_comma pr_dirpath dirs ++ str ".")
+           prlist_with_sep pr_comma DirPath.print dirs ++ str ".")
 
 (* For tactics/commands requiring vernacular libraries *)
 
@@ -79,7 +79,7 @@ let check_required_library d =
 *)
 (* or failing ...*)
       user_err ~hdr:"Coqlib.check_required_library"
-        (str "Library " ++ pr_dirpath dir ++ str " has to be required first.")
+        (str "Library " ++ DirPath.print dir ++ str " has to be required first.")
 
 (************************************************************************)
 (* Specific Coq objects *)
@@ -377,7 +377,3 @@ let coq_sumbool_ref = lazy (init_reference ["Specif"] "sumbool")
 let coq_sig_ref = lazy (init_reference ["Specif"] "sig")
 let coq_or_ref     = lazy (init_reference ["Logic"] "or")
 let coq_iff_ref    = lazy (init_reference ["Logic"] "iff")
-
-(* Deprecated *)
-let gen_reference = coq_reference
-
diff --git a/library/coqlib.mli b/library/coqlib.mli
index 1e3c37a9e..cc22f1635 100644
--- a/library/coqlib.mli
+++ b/library/coqlib.mli
@@ -71,8 +71,8 @@ val jmeq_module_name : string list
 val datatypes_module_name : string list
 
 (** Identity  *)
-val id : constant
-val type_of_id : constant
+val id : Constant.t
+val type_of_id : Constant.t
 
 (** Natural numbers *)
 val nat_path : full_path
@@ -205,7 +205,3 @@ val coq_sig_ref : global_reference lazy_t
 
 val coq_or_ref : global_reference lazy_t
 val coq_iff_ref : global_reference lazy_t
-
-(* Deprecated functions *)
-val gen_reference :  message -> string list -> string -> global_reference
-[@@ocaml.deprecated "Please use Coqlib.find_reference"]
diff --git a/library/declaremods.ml b/library/declaremods.ml
index 6d9295bde..291039d19 100644
--- a/library/declaremods.ml
+++ b/library/declaremods.ml
@@ -39,7 +39,7 @@ let inl2intopt = function
 
 type algebraic_objects =
   | Objs of Lib.lib_objects
-  | Ref of module_path * substitution
+  | Ref of ModPath.t * substitution
 
 type substitutive_objects = MBId.t list * algebraic_objects
 
@@ -62,9 +62,9 @@ type substitutive_objects = MBId.t list * algebraic_objects
 
 module ModSubstObjs :
  sig
-   val set : module_path -> substitutive_objects -> unit
-   val get : module_path -> substitutive_objects
-   val set_missing_handler : (module_path -> substitutive_objects) -> unit
+   val set : ModPath.t -> substitutive_objects -> unit
+   val get : ModPath.t -> substitutive_objects
+   val set_missing_handler : (ModPath.t -> substitutive_objects) -> unit
  end =
  struct
    let table =
@@ -126,8 +126,8 @@ type module_objects = object_prefix * Lib.lib_objects * Lib.lib_objects
 
 module ModObjs :
  sig
-   val set : module_path -> module_objects -> unit
-   val get : module_path -> module_objects (* may raise Not_found *)
+   val set : ModPath.t -> module_objects -> unit
+   val get : ModPath.t -> module_objects (* may raise Not_found *)
    val all : unit -> module_objects MPmap.t
  end =
  struct
@@ -143,11 +143,11 @@ module ModObjs :
 (** {6 Name management}
 
     Auxiliary functions to transform full_path and kernel_name given
-    by Lib into module_path and DirPath.t needed for modules
+    by Lib into ModPath.t and DirPath.t needed for modules
 *)
 
 let mp_of_kn kn =
-  let mp,sec,l = repr_kn kn in
+  let mp,sec,l = KerName.repr kn in
   assert (DirPath.is_empty sec);
   MPdot (mp,l)
 
@@ -167,29 +167,29 @@ let consistency_checks exists dir dirinfo =
       try Nametab.locate_dir (qualid_of_dirpath dir)
       with Not_found ->
         user_err ~hdr:"consistency_checks"
-          (pr_dirpath dir ++ str " should already exist!")
+          (DirPath.print dir ++ str " should already exist!")
     in
     assert (eq_global_dir_reference globref dirinfo)
   else
     if Nametab.exists_dir dir then
       user_err ~hdr:"consistency_checks"
-        (pr_dirpath dir ++ str " already exists")
+        (DirPath.print dir ++ str " already exists")
 
 let compute_visibility exists i =
   if exists then Nametab.Exactly i else Nametab.Until i
 
 (** Iterate some function [iter_objects] on all components of a module *)
 
-let do_module exists iter_objects i dir mp sobjs kobjs =
-  let prefix = (dir,(mp,DirPath.empty)) in
+let do_module exists iter_objects i obj_dir obj_mp sobjs kobjs =
+  let prefix = { obj_dir ; obj_mp; obj_sec = DirPath.empty } in
   let dirinfo = DirModule prefix in
-  consistency_checks exists dir dirinfo;
-  Nametab.push_dir (compute_visibility exists i) dir dirinfo;
-  ModSubstObjs.set mp sobjs;
+  consistency_checks exists obj_dir dirinfo;
+  Nametab.push_dir (compute_visibility exists i) obj_dir dirinfo;
+  ModSubstObjs.set obj_mp sobjs;
   (* If we're not a functor, let's iter on the internal components *)
   if sobjs_no_functor sobjs then begin
     let objs = expand_sobjs sobjs in
-    ModObjs.set mp (prefix,objs,kobjs);
+    ModObjs.set obj_mp (prefix,objs,kobjs);
     iter_objects (i+1) prefix objs;
     iter_objects (i+1) prefix kobjs
   end
@@ -222,20 +222,20 @@ let cache_keep _ = anomaly (Pp.str "This module should not be cached!")
 
 let load_keep i ((sp,kn),kobjs) =
   (* Invariant : seg isn't empty *)
-  let dir = dir_of_sp sp and mp = mp_of_kn kn in
-  let prefix = (dir,(mp,DirPath.empty)) in
+  let obj_dir = dir_of_sp sp and obj_mp  = mp_of_kn kn in
+  let prefix = { obj_dir ; obj_mp; obj_sec = DirPath.empty } in
   let prefix',sobjs,kobjs0 =
-    try ModObjs.get mp
+    try ModObjs.get obj_mp
     with Not_found -> assert false (* a substobjs should already be loaded *)
   in
   assert (eq_op prefix' prefix);
   assert (List.is_empty kobjs0);
-  ModObjs.set mp (prefix,sobjs,kobjs);
+  ModObjs.set obj_mp (prefix,sobjs,kobjs);
   Lib.load_objects i prefix kobjs
 
 let open_keep i ((sp,kn),kobjs) =
-  let dir = dir_of_sp sp and mp = mp_of_kn kn in
-  let prefix = (dir,(mp,DirPath.empty)) in
+  let obj_dir = dir_of_sp sp and obj_mp = mp_of_kn kn in
+  let prefix = { obj_dir; obj_mp; obj_sec = DirPath.empty } in
   Lib.open_objects i prefix kobjs
 
 let in_modkeep : Lib.lib_objects -> obj =
@@ -284,9 +284,9 @@ let (in_modtype : substitutive_objects -> obj),
 (** {6 Declaration of substitutive objects for Include} *)
 
 let do_include do_load do_open i ((sp,kn),aobjs) =
-  let dir = Libnames.dirpath sp in
-  let mp = KerName.modpath kn in
-  let prefix = (dir,(mp,DirPath.empty)) in
+  let obj_dir = Libnames.dirpath sp in
+  let obj_mp = KerName.modpath kn in
+  let prefix = { obj_dir; obj_mp; obj_sec = DirPath.empty } in
   let o = expand_aobjs aobjs in
   if do_load then Lib.load_objects i prefix o;
   if do_open then Lib.open_objects i prefix o
@@ -336,8 +336,8 @@ let () = ModSubstObjs.set_missing_handler handle_missing_substobjs
 
 (** {6 From module expression to substitutive objects} *)
 
-(** Turn a chain of [MSEapply] into the head module_path and the
-    list of module_path parameters (deepest param coming first).
+(** Turn a chain of [MSEapply] into the head ModPath.t and the
+    list of ModPath.t parameters (deepest param coming first).
     The left part of a [MSEapply] must be either [MSEident] or
     another [MSEapply]. *)
 
@@ -442,23 +442,26 @@ let process_module_binding mbid me =
     Objects in these parameters are also loaded.
     Output is accumulated on top of [acc] (in reverse order). *)
 
-let intern_arg interp_modast acc (idl,(typ,ann)) =
+let intern_arg interp_modast (acc, cst) (idl,(typ,ann)) =
   let inl = inl2intopt ann in
   let lib_dir = Lib.library_dp() in
   let env = Global.env() in
-  let mty,_ = interp_modast env ModType typ in
+  let (mty, _, cst') = interp_modast env ModType typ in
+  let () = Global.push_context_set true cst' in
+  let env = Global.env () in
   let sobjs = get_module_sobjs false env inl mty in
   let mp0 = get_module_path mty in
-  List.fold_left
-    (fun acc (_,id) ->
-      let dir = DirPath.make [id] in
-      let mbid = MBId.make lib_dir id in
-      let mp = MPbound mbid in
-      let resolver = Global.add_module_parameter mbid mty inl in
-      let sobjs = subst_sobjs (map_mp mp0 mp resolver) sobjs in
-      do_module false Lib.load_objects 1 dir mp sobjs [];
-      (mbid,mty,inl)::acc)
-    acc idl
+  let fold acc {CAst.v=id} =
+    let dir = DirPath.make [id] in
+    let mbid = MBId.make lib_dir id in
+    let mp = MPbound mbid in
+    let resolver = Global.add_module_parameter mbid mty inl in
+    let sobjs = subst_sobjs (map_mp mp0 mp resolver) sobjs in
+    do_module false Lib.load_objects 1 dir mp sobjs [];
+    (mbid,mty,inl)::acc
+  in
+  let acc = List.fold_left fold acc idl in
+  (acc, Univ.ContextSet.union cst cst')
 
 (** Process a list of declarations of functor parameters
     (Id11 .. Id1n : Typ1)..(Idk1 .. Idkm : Typk)
@@ -472,7 +475,7 @@ let intern_arg interp_modast acc (idl,(typ,ann)) =
 *)
 
 let intern_args interp_modast params =
-  List.fold_left (intern_arg interp_modast) [] params
+  List.fold_left (intern_arg interp_modast) ([], Univ.ContextSet.empty) params
 
 
 (** {6 Auxiliary functions concerning subtyping checks} *)
@@ -524,13 +527,17 @@ let mk_funct_type env args seb0 =
 (** Prepare the module type list for check of subtypes *)
 
 let build_subtypes interp_modast env mp args mtys =
-  List.map
-    (fun (m,ann) ->
+  let (cst, ans) = List.fold_left_map
+    (fun cst (m,ann) ->
        let inl = inl2intopt ann in
-       let mte,_ = interp_modast env ModType m in
+       let mte, _, cst' = interp_modast env ModType m in
+       let env = Environ.push_context_set ~strict:true cst' env in
+       let cst = Univ.ContextSet.union cst cst' in
        let mtb = Mod_typing.translate_modtype env mp inl ([],mte) in
-       { mtb with mod_type = mk_funct_type env args mtb.mod_type })
-    mtys
+       cst, { mtb with mod_type = mk_funct_type env args mtb.mod_type })
+    Univ.ContextSet.empty mtys
+  in
+  (ans, cst)
 
 
 (** {6 Current module information}
@@ -563,21 +570,26 @@ module RawModOps = struct
 
 let start_module interp_modast export id args res fs =
   let mp = Global.start_module id in
-  let arg_entries_r = intern_args interp_modast args in
+  let arg_entries_r, cst = intern_args interp_modast args in
+  let () = Global.push_context_set true cst in
   let env = Global.env () in
-  let res_entry_o, subtyps = match res with
+  let res_entry_o, subtyps, cst = match res with
     | Enforce (res,ann) ->
         let inl = inl2intopt ann in
-	let mte,_ = interp_modast env ModType res in
+        let (mte, _, cst) = interp_modast env ModType res in
+        let env = Environ.push_context_set ~strict:true cst env in
         (* We check immediately that mte is well-formed *)
-	let _ = Mod_typing.translate_mse env None inl mte in
-	Some (mte,inl), []
+        let _, _, _, cst' = Mod_typing.translate_mse env None inl mte in
+        let cst = Univ.ContextSet.union cst cst' in
+        Some (mte, inl), [], cst
     | Check resl ->
-	None, build_subtypes interp_modast env mp arg_entries_r resl
+      let typs, cst = build_subtypes interp_modast env mp arg_entries_r resl in
+      None, typs, cst
   in
+  let () = Global.push_context_set true cst in
   openmod_info := { cur_typ = res_entry_o; cur_typs = subtyps };
   let prefix = Lib.start_module export id mp fs in
-  Nametab.push_dir (Nametab.Until 1) (fst prefix) (DirOpenModule prefix);
+  Nametab.push_dir (Nametab.Until 1) (prefix.obj_dir) (DirOpenModule prefix);
   mp
 
 let end_module () =
@@ -622,25 +634,33 @@ let declare_module interp_modast id args res mexpr_o fs =
   (* We simulate the beginning of an interactive module,
      then we adds the module parameters to the global env. *)
   let mp = Global.start_module id in
-  let arg_entries_r = intern_args interp_modast args in
+  let arg_entries_r, cst = intern_args interp_modast args in
   let params = mk_params_entry arg_entries_r in
   let env = Global.env () in
-  let mty_entry_o, subs, inl_res = match res with
+  let env = Environ.push_context_set ~strict:true cst env in
+  let mty_entry_o, subs, inl_res, cst' = match res with
     | Enforce (mty,ann) ->
         let inl = inl2intopt ann in
-        let mte, _ = interp_modast env ModType mty in
+        let (mte, _, cst) = interp_modast env ModType mty in
+        let env = Environ.push_context_set ~strict:true cst env in
         (* We check immediately that mte is well-formed *)
-        let _ = Mod_typing.translate_mse env None inl mte in
-        Some mte, [], inl
+        let _, _, _, cst' = Mod_typing.translate_mse env None inl mte in
+        let cst = Univ.ContextSet.union cst cst' in
+        Some mte, [], inl, cst
     | Check mtys ->
-	None, build_subtypes interp_modast env mp arg_entries_r mtys,
-        default_inline ()
+      let typs, cst = build_subtypes interp_modast env mp arg_entries_r mtys in
+      None, typs, default_inline (), cst
   in
-  let mexpr_entry_o, inl_expr = match mexpr_o with
-    | None -> None, default_inline ()
+  let env = Environ.push_context_set ~strict:true cst' env in
+  let cst = Univ.ContextSet.union cst cst' in
+  let mexpr_entry_o, inl_expr, cst' = match mexpr_o with
+    | None -> None, default_inline (), Univ.ContextSet.empty
     | Some (mexpr,ann) ->
-      Some (fst (interp_modast env Module mexpr)), inl2intopt ann
+      let (mte, _, cst) = interp_modast env Module mexpr in
+      Some mte, inl2intopt ann, cst
   in
+  let env = Environ.push_context_set ~strict:true cst' env in
+  let cst = Univ.ContextSet.union cst cst' in
   let entry = match mexpr_entry_o, mty_entry_o with
     | None, None -> assert false (* No body, no type ... *)
     | None, Some typ -> MType (params, typ)
@@ -659,6 +679,7 @@ let declare_module interp_modast id args res mexpr_o fs =
   | None -> None
   | _ -> inl_res
   in
+  let () = Global.push_context_set true cst in
   let mp_env,resolver = Global.add_module id entry inl in
 
   (* Name consistency check : kernel vs. library *)
@@ -679,12 +700,14 @@ module RawModTypeOps = struct
 
 let start_modtype interp_modast id args mtys fs =
   let mp = Global.start_modtype id in
-  let arg_entries_r = intern_args interp_modast args in
+  let arg_entries_r, cst = intern_args interp_modast args in
+  let () = Global.push_context_set true cst in
   let env = Global.env () in
-  let sub_mty_l = build_subtypes interp_modast env mp arg_entries_r mtys in
+  let sub_mty_l, cst = build_subtypes interp_modast env mp arg_entries_r mtys in
+  let () = Global.push_context_set true cst in
   openmodtype_info := sub_mty_l;
   let prefix = Lib.start_modtype id mp fs in
-  Nametab.push_dir (Nametab.Until 1) (fst prefix) (DirOpenModtype prefix);
+  Nametab.push_dir (Nametab.Until 1) (prefix.obj_dir) (DirOpenModtype prefix);
   mp
 
 let end_modtype () =
@@ -708,14 +731,21 @@ let declare_modtype interp_modast id args mtys (mty,ann) fs =
   (* We simulate the beginning of an interactive module,
      then we adds the module parameters to the global env. *)
   let mp = Global.start_modtype id in
-  let arg_entries_r = intern_args interp_modast args in
+  let arg_entries_r, cst = intern_args interp_modast args in
+  let () = Global.push_context_set true cst in
   let params = mk_params_entry arg_entries_r in
   let env = Global.env () in
-  let mte, _ = interp_modast env ModType mty in
+  let mte, _, cst = interp_modast env ModType mty in
+  let () = Global.push_context_set true cst in
+  let env = Global.env () in
   (* We check immediately that mte is well-formed *)
-  let _ = Mod_typing.translate_mse env None inl mte in
+  let _, _, _, cst = Mod_typing.translate_mse env None inl mte in
+  let () = Global.push_context_set true cst in
+  let env = Global.env () in
   let entry = params, mte in
-  let sub_mty_l = build_subtypes interp_modast env mp arg_entries_r mtys in
+  let sub_mty_l, cst = build_subtypes interp_modast env mp arg_entries_r mtys in
+  let () = Global.push_context_set true cst in
+  let env = Global.env () in
   let sobjs = get_functor_sobjs false env inl entry in
   let subst = map_mp (get_module_path (snd entry)) mp empty_delta_resolver in
   let sobjs = subst_sobjs subst sobjs in
@@ -769,7 +799,9 @@ let type_of_incl env is_mod = function
 
 let declare_one_include interp_modast (me_ast,annot) =
   let env = Global.env() in
-  let me,kind = interp_modast env ModAny me_ast in
+  let me, kind, cst = interp_modast env ModAny me_ast in
+  let () = Global.push_context_set true cst in
+  let env = Global.env () in
   let is_mod = (kind == Module) in
   let cur_mp = Lib.current_mp () in
   let inl = inl2intopt annot in
@@ -911,7 +943,7 @@ let subst_import (subst,(export,mp as obj)) =
   let mp' = subst_mp subst mp in
   if mp'==mp then obj else (export,mp')
 
-let in_import : bool * module_path -> obj =
+let in_import : bool * ModPath.t -> obj =
   declare_object {(default_object "IMPORT MODULE") with
     cache_function = cache_import;
     open_function = open_import;
@@ -947,11 +979,10 @@ let iter_all_segments f =
 
 type 'modast module_interpretor =
   Environ.env -> Misctypes.module_kind -> 'modast ->
-    Entries.module_struct_entry * Misctypes.module_kind
+    Entries.module_struct_entry * Misctypes.module_kind * Univ.ContextSet.t
 
 type 'modast module_params =
-  (Id.t Loc.located list * ('modast * inline)) list
-
+  (lident list * ('modast * inline)) list
 
 (** {6 Debug} *)
 
@@ -961,7 +992,7 @@ let debug_print_modtab _ =
     | l -> str "[." ++ int (List.length l) ++ str ".]"
   in
   let pr_modinfo mp (prefix,substobjs,keepobjs) s =
-    s ++ str (string_of_mp mp) ++ (spc ())
+    s ++ str (ModPath.to_string mp) ++ (spc ())
     ++ (pr_seg (Lib.segment_of_objects prefix (substobjs@keepobjs)))
   in
   let modules = MPmap.fold pr_modinfo (ModObjs.all ()) (mt ()) in
diff --git a/library/declaremods.mli b/library/declaremods.mli
index 9d750b616..db2893376 100644
--- a/library/declaremods.mli
+++ b/library/declaremods.mli
@@ -13,10 +13,10 @@ open Vernacexpr
 
 type 'modast module_interpretor =
   Environ.env -> Misctypes.module_kind -> 'modast ->
-    Entries.module_struct_entry * Misctypes.module_kind
+    Entries.module_struct_entry * Misctypes.module_kind * Univ.ContextSet.t
 
 type 'modast module_params =
-  (Id.t Loc.located list * ('modast * inline)) list
+  (Misctypes.lident list * ('modast * inline)) list
 
 (** [declare_module interp_modast id fargs typ exprs]
    declares module [id], with structure constructed by [interp_modast]
@@ -30,15 +30,15 @@ val declare_module :
   Id.t ->
   'modast module_params ->
   ('modast * inline) module_signature ->
-  ('modast * inline) list -> module_path
+  ('modast * inline) list -> ModPath.t
 
 val start_module :
   'modast module_interpretor ->
   bool option -> Id.t ->
   'modast module_params ->
-  ('modast * inline) module_signature -> module_path
+  ('modast * inline) module_signature -> ModPath.t
 
-val end_module : unit -> module_path
+val end_module : unit -> ModPath.t
 
 
 
@@ -53,15 +53,15 @@ val declare_modtype :
   'modast module_params ->
   ('modast * inline) list ->
   ('modast * inline) list ->
-  module_path
+  ModPath.t
 
 val start_modtype :
   'modast module_interpretor ->
   Id.t ->
   'modast module_params ->
-  ('modast * inline) list -> module_path
+  ('modast * inline) list -> ModPath.t
 
-val end_modtype : unit -> module_path
+val end_modtype : unit -> ModPath.t
 
 (** {6 Libraries i.e. modules on disk } *)
 
@@ -72,7 +72,7 @@ type library_objects
 val register_library :
   library_name ->
   Safe_typing.compiled_library -> library_objects -> Safe_typing.vodigest ->
-  Univ.universe_context_set -> unit
+  Univ.ContextSet.t -> unit
 
 val get_library_native_symbols : library_name -> Nativecode.symbols
 
@@ -90,13 +90,13 @@ val append_end_library_hook : (unit -> unit) -> unit
    every object of the module. Raises [Not_found] when [mp] is unknown
    or when [mp] corresponds to a functor. *)
 
-val really_import_module : module_path -> unit
+val really_import_module : ModPath.t -> unit
 
 (** [import_module export mp] is a synchronous version of
    [really_import_module]. If [export] is [true], the module is also
    opened every time the module containing it is. *)
 
-val import_module : bool -> module_path -> unit
+val import_module : bool -> ModPath.t -> unit
 
 (** Include  *)
 
diff --git a/library/decls.ml b/library/decls.ml
index 973fe144d..a4259f6ca 100644
--- a/library/decls.ml
+++ b/library/decls.ml
@@ -19,7 +19,7 @@ module NamedDecl = Context.Named.Declaration
 (** Datas associated to section variables and local definitions *)
 
 type variable_data =
-  DirPath.t * bool (* opacity *) * Univ.universe_context_set * polymorphic * logical_kind
+  DirPath.t * bool (* opacity *) * Univ.ContextSet.t * polymorphic * logical_kind
 
 let vartab =
   Summary.ref (Id.Map.empty : variable_data Id.Map.t) ~name:"VARIABLE"
diff --git a/library/decls.mli b/library/decls.mli
index 478f0bca0..1b7f137a4 100644
--- a/library/decls.mli
+++ b/library/decls.mli
@@ -17,21 +17,21 @@ open Decl_kinds
 (** Registration and access to the table of variable *)
 
 type variable_data =
-  DirPath.t * bool (** opacity *) * Univ.universe_context_set * polymorphic * logical_kind
+  DirPath.t * bool (** opacity *) * Univ.ContextSet.t * polymorphic * logical_kind
 
 val add_variable_data : variable -> variable_data -> unit
 val variable_path : variable -> DirPath.t
 val variable_secpath : variable -> qualid
 val variable_kind : variable -> logical_kind
 val variable_opacity : variable -> bool
-val variable_context : variable -> Univ.universe_context_set
+val variable_context : variable -> Univ.ContextSet.t
 val variable_polymorphic : variable -> polymorphic
 val variable_exists : variable -> bool
 
 (** Registration and access to the table of constants *)
 
-val add_constant_kind : constant -> logical_kind -> unit
-val constant_kind : constant -> logical_kind
+val add_constant_kind : Constant.t -> logical_kind -> unit
+val constant_kind : Constant.t -> logical_kind
 
 (* Prepare global named context for proof session: remove proofs of
    opaque section definitions and remove vm-compiled code *)
diff --git a/library/global.ml b/library/global.ml
index 963c97741..ed847b7cd 100644
--- a/library/global.ml
+++ b/library/global.ml
@@ -8,7 +8,6 @@
 
 open Names
 open Environ
-open Decl_kinds
 
 (** We introduce here the global environment of the system,
     and we declare it as a synchronized table. *)
@@ -21,6 +20,7 @@ module GlobalSafeEnv : sig
   val set_safe_env : Safe_typing.safe_environment -> unit
   val join_safe_environment : ?except:Future.UUIDSet.t -> unit -> unit
   val is_joined_environment : unit -> bool
+  val global_env_summary_tag : Safe_typing.safe_environment Summary.Dyn.tag
 
 end = struct
 
@@ -31,9 +31,9 @@ let join_safe_environment ?except () =
 
 let is_joined_environment () =
   Safe_typing.is_joined_environment !global_env
-  
-let () =
-  Summary.declare_summary global_env_summary_name
+
+let global_env_summary_tag =
+  Summary.declare_summary_tag global_env_summary_name
     { Summary.freeze_function = (function
         | `Yes -> join_safe_environment (); !global_env
         | `No -> !global_env
@@ -52,6 +52,8 @@ let set_safe_env e = global_env := e
 
 end
 
+let global_env_summary_tag = GlobalSafeEnv.global_env_summary_tag
+
 let safe_env = GlobalSafeEnv.safe_env
 let join_safe_environment ?except () =
   GlobalSafeEnv.join_safe_environment ?except ()
@@ -79,7 +81,7 @@ let globalize_with_summary fs f =
 let i2l = Label.of_id
 
 let push_named_assum a = globalize0 (Safe_typing.push_named_assum a)
-let push_named_def d = globalize (Safe_typing.push_named_def d)
+let push_named_def d = globalize0 (Safe_typing.push_named_def d)
 let add_constraints c = globalize0 (Safe_typing.add_constraints c)
 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)
@@ -231,18 +233,7 @@ 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 is_polymorphic r =
   let env = env() in 
   match r with
   | VarRef id -> false
diff --git a/library/global.mli b/library/global.mli
index c777691d1..03bc945da 100644
--- a/library/global.mli
+++ b/library/global.mli
@@ -32,44 +32,44 @@ val set_typing_flags : Declarations.typing_flags -> unit
 (** Variables, Local definitions, constants, inductive types *)
 
 val push_named_assum : (Id.t * Constr.types * bool) Univ.in_universe_context_set -> unit
-val push_named_def   : (Id.t * Safe_typing.private_constants Entries.definition_entry) -> Univ.universe_context_set
+val push_named_def   : (Id.t * Entries.section_def_entry) -> unit
 
 val export_private_constants : in_section:bool ->
-  Safe_typing.private_constants Entries.constant_entry ->
-  unit Entries.constant_entry * Safe_typing.exported_private_constant list
+  Safe_typing.private_constants Entries.definition_entry ->
+  unit Entries.definition_entry * Safe_typing.exported_private_constant list
 
 val add_constant :
-  DirPath.t -> Id.t -> Safe_typing.global_declaration -> constant
+  DirPath.t -> Id.t -> Safe_typing.global_declaration -> Constant.t
 val add_mind :
-  DirPath.t -> Id.t -> Entries.mutual_inductive_entry -> mutual_inductive
+  DirPath.t -> Id.t -> Entries.mutual_inductive_entry -> MutInd.t
 
 (** Extra universe constraints *)
-val add_constraints : Univ.constraints -> unit
+val add_constraints : Univ.Constraint.t -> unit
 
-val push_context : bool -> Univ.universe_context -> unit
-val push_context_set : bool -> Univ.universe_context_set -> unit
+val push_context : bool -> Univ.UContext.t -> unit
+val push_context_set : bool -> Univ.ContextSet.t -> unit
 
 (** Non-interactive modules and module types *)
 
 val add_module :
   Id.t -> Entries.module_entry -> Declarations.inline ->
-    module_path * Mod_subst.delta_resolver
+    ModPath.t * Mod_subst.delta_resolver
 val add_modtype :
-  Id.t -> Entries.module_type_entry -> Declarations.inline -> module_path
+  Id.t -> Entries.module_type_entry -> Declarations.inline -> ModPath.t
 val add_include :
   Entries.module_struct_entry -> bool -> Declarations.inline ->
     Mod_subst.delta_resolver
 
 (** Interactive modules and module types *)
 
-val start_module : Id.t -> module_path
-val start_modtype : Id.t -> module_path
+val start_module : Id.t -> ModPath.t
+val start_modtype : Id.t -> ModPath.t
 
 val end_module : Summary.frozen -> Id.t ->
   (Entries.module_struct_entry * Declarations.inline) option ->
-    module_path * MBId.t list * Mod_subst.delta_resolver
+    ModPath.t * MBId.t list * Mod_subst.delta_resolver
 
-val end_modtype : Summary.frozen -> Id.t -> module_path * MBId.t list
+val end_modtype : Summary.frozen -> Id.t -> ModPath.t * MBId.t list
 
 val add_module_parameter :
   MBId.t -> Entries.module_struct_entry -> Declarations.inline ->
@@ -78,45 +78,38 @@ val add_module_parameter :
 (** {6 Queries in the global environment } *)
 
 val lookup_named     : variable -> Context.Named.Declaration.t
-val lookup_constant  : constant -> Declarations.constant_body
+val lookup_constant  : Constant.t -> Declarations.constant_body
 val lookup_inductive : inductive ->
   Declarations.mutual_inductive_body * Declarations.one_inductive_body
 val lookup_pinductive : Constr.pinductive -> 
   Declarations.mutual_inductive_body * Declarations.one_inductive_body
-val lookup_mind      : mutual_inductive -> Declarations.mutual_inductive_body
-val lookup_module    : module_path -> Declarations.module_body
-val lookup_modtype   : module_path -> Declarations.module_type_body
+val lookup_mind      : MutInd.t -> Declarations.mutual_inductive_body
+val lookup_module    : ModPath.t -> Declarations.module_body
+val lookup_modtype   : ModPath.t -> Declarations.module_type_body
 val exists_objlabel  : Label.t -> bool
 
-val constant_of_delta_kn : kernel_name -> constant
-val mind_of_delta_kn : kernel_name -> mutual_inductive
+val constant_of_delta_kn : KerName.t -> Constant.t
+val mind_of_delta_kn : KerName.t -> MutInd.t
 
 val opaque_tables : unit -> Opaqueproof.opaquetab
 
-val body_of_constant : constant -> (Term.constr * Univ.AUContext.t) option
+val body_of_constant : Constant.t -> (Constr.constr * Univ.AUContext.t) option
 (** Returns the body of the constant if it has any, and the polymorphic context
     it lives in. For monomorphic constant, the latter is empty, and for
     polymorphic constants, the term contains De Bruijn universe variables that
     need to be instantiated. *)
 
-val body_of_constant_body : Declarations.constant_body -> (Term.constr * Univ.AUContext.t) option
+val body_of_constant_body : Declarations.constant_body -> (Constr.constr * Univ.AUContext.t) option
 (** Same as {!body_of_constant} but on {!Declarations.constant_body}. *)
 
-(** 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
+val start_library : DirPath.t -> ModPath.t
 val export : ?except:Future.UUIDSet.t -> DirPath.t ->
-  module_path * Safe_typing.compiled_library * Safe_typing.native_library
+  ModPath.t * Safe_typing.compiled_library * Safe_typing.native_library
 val import :
-  Safe_typing.compiled_library -> Univ.universe_context_set -> Safe_typing.vodigest ->
-  module_path
+  Safe_typing.compiled_library -> Univ.ContextSet.t -> Safe_typing.vodigest ->
+  ModPath.t
 
 (** {6 Misc } *)
 
@@ -147,23 +140,23 @@ val type_of_global_in_context : Environ.env ->
     constants, it does not matter. *)
 
 (** Returns the universe context of the global reference (whatever its polymorphic status is). *)
-val universes_of_global : Globnames.global_reference -> Univ.abstract_universe_context
+val universes_of_global : Globnames.global_reference -> Univ.AUContext.t
 
 (** {6 Retroknowledge } *)
 
 val register :
-  Retroknowledge.field -> Term.constr -> Term.constr -> unit
+  Retroknowledge.field -> Constr.constr -> Constr.constr -> unit
 
-val register_inline : constant -> unit
+val register_inline : Constant.t -> unit
 
 (** {6 Oracle } *)
 
-val set_strategy : Names.constant Names.tableKey -> Conv_oracle.level -> unit
+val set_strategy : Constant.t Names.tableKey -> Conv_oracle.level -> unit
 
 (* Modifies the global state, registering new universes *)
 
-val current_dirpath : unit -> Names.dir_path
+val current_dirpath : unit -> DirPath.t
 
-val with_global : (Environ.env -> Names.dir_path -> 'a Univ.in_universe_context_set) -> 'a
+val with_global : (Environ.env -> DirPath.t -> 'a Univ.in_universe_context_set) -> 'a
 
-val global_env_summary_name : string
+val global_env_summary_tag : Safe_typing.safe_environment Summary.Dyn.tag
diff --git a/library/globnames.ml b/library/globnames.ml
index dc9541a0d..a6e75fdb6 100644
--- a/library/globnames.ml
+++ b/library/globnames.ml
@@ -8,14 +8,14 @@
 
 open CErrors
 open Names
-open Term
+open Constr
 open Mod_subst
 open Libnames
 
 (*s Global reference is a kernel side type for all references together *)
 type global_reference =
   | VarRef of variable           (** A reference to the section-context. *)
-  | ConstRef of constant         (** A reference to the environment. *)
+  | ConstRef of Constant.t       (** A reference to the environment. *)
   | IndRef of inductive          (** A reference to an inductive type. *)
   | ConstructRef of constructor  (** A reference to a constructor of an inductive type. *)
 
@@ -26,11 +26,11 @@ let isConstructRef = function ConstructRef _ -> true | _ -> false
 
 let eq_gr gr1 gr2 =
   gr1 == gr2 || match gr1,gr2 with
-    | ConstRef con1, ConstRef con2 -> eq_constant con1 con2
+    | ConstRef con1, ConstRef con2 -> Constant.equal con1 con2
     | IndRef kn1, IndRef kn2 -> eq_ind kn1 kn2
     | ConstructRef kn1, ConstructRef kn2 -> eq_constructor kn1 kn2
     | VarRef v1, VarRef v2 -> Id.equal v1 v2
-    | _ -> false
+    | (ConstRef _ | IndRef _ | ConstructRef _ | VarRef _), _ -> false
 
 let destVarRef = function VarRef ind -> ind | _ -> failwith "destVarRef"
 let destConstRef = function ConstRef ind -> ind | _ -> failwith "destConstRef"
@@ -67,12 +67,12 @@ let subst_global subst ref = match ref with
 	if c'==c then ref,t else ConstructRef c', t
 
 let canonical_gr = function
-  | ConstRef con -> ConstRef(constant_of_kn(canonical_con con))
-  | IndRef (kn,i) -> IndRef(mind_of_kn(canonical_mind kn),i)
-  | ConstructRef ((kn,i),j )-> ConstructRef((mind_of_kn(canonical_mind kn),i),j)
+  | ConstRef con -> ConstRef(Constant.make1 (Constant.canonical con))
+  | IndRef (kn,i) -> IndRef(MutInd.make1(MutInd.canonical kn),i)
+  | ConstructRef ((kn,i),j )-> ConstructRef((MutInd.make1(MutInd.canonical kn),i),j)
   | VarRef id -> VarRef id
 
-let global_of_constr c = match kind_of_term c with
+let global_of_constr c = match kind c with
   | Const (sp,u) -> ConstRef sp
   | Ind (ind_sp,u) -> IndRef ind_sp
   | Construct (cstr_cp,u) -> ConstructRef cstr_cp
@@ -80,11 +80,11 @@ let global_of_constr c = match kind_of_term c with
   |  _ -> raise Not_found
 
 let is_global c t =
-  match c, kind_of_term t with
-  | ConstRef c, Const (c', _) -> eq_constant c c'
+  match c, kind t with
+  | ConstRef c, Const (c', _) -> Constant.equal c c'
   | IndRef i, Ind (i', _) -> eq_ind i i'
   | ConstructRef i, Construct (i', _) -> eq_constructor i i'
-  | VarRef id, Var id' -> id_eq id id'
+  | VarRef id, Var id' -> Id.equal id id'
   | _ -> false
 
 let printable_constr_of_global = function
@@ -157,7 +157,7 @@ module Refset_env = Refmap_env.Set
 
 (* Extended global references *)
 
-type syndef_name = kernel_name
+type syndef_name = KerName.t
 
 type extended_global_reference =
   | TrueGlobal of global_reference
@@ -180,7 +180,7 @@ module ExtRefOrdered = struct
     if x == y then 0
     else match x, y with
       | TrueGlobal rx, TrueGlobal ry -> RefOrdered_env.compare rx ry
-      | SynDef knx, SynDef kny -> kn_ord knx kny
+      | SynDef knx, SynDef kny -> KerName.compare knx kny
       | TrueGlobal _, SynDef _ -> -1
       | SynDef _, TrueGlobal _ -> 1
 
@@ -215,12 +215,12 @@ let decode_mind kn =
 	  id::(DirPath.repr dp)
     | MPdot(mp,l) -> (Label.to_id l)::(dir_of_mp mp)
   in
-  let mp,sec_dir,l = repr_mind kn in
+  let mp,sec_dir,l = MutInd.repr3 kn in
   check_empty_section sec_dir;
   (DirPath.make (dir_of_mp mp)),Label.to_id l
 
 let decode_con kn =
-  let mp,sec_dir,l = repr_con kn in
+  let mp,sec_dir,l = Constant.repr3 kn in
   check_empty_section sec_dir;
   match mp with
     | MPfile dir -> (dir,Label.to_id l)
@@ -231,12 +231,12 @@ let decode_con kn =
     user and canonical kernel names must be equal. *)
 
 let pop_con con =
-  let (mp,dir,l) = repr_con con in
-  Names.make_con mp (pop_dirpath dir) l
+  let (mp,dir,l) = Constant.repr3 con in
+  Constant.make3 mp (pop_dirpath dir) l
 
 let pop_kn kn =
-  let (mp,dir,l) = repr_mind kn in
-  Names.make_mind mp (pop_dirpath dir) l
+  let (mp,dir,l) = MutInd.repr3 kn in
+  MutInd.make3 mp (pop_dirpath dir) l
 
 let pop_global_reference = function
   | ConstRef con -> ConstRef (pop_con con)
diff --git a/library/globnames.mli b/library/globnames.mli
index 0b5971b6e..2e0cd62db 100644
--- a/library/globnames.mli
+++ b/library/globnames.mli
@@ -8,13 +8,13 @@
 
 open Util
 open Names
-open Term
+open Constr
 open Mod_subst
 
 (** {6 Global reference is a kernel side type for all references together } *)
 type global_reference =
   | VarRef of variable           (** A reference to the section-context. *)
-  | ConstRef of constant         (** A reference to the environment. *)
+  | ConstRef of Constant.t       (** A reference to the environment. *)
   | IndRef of inductive          (** A reference to an inductive type. *)
   | ConstructRef of constructor  (** A reference to a constructor of an inductive type. *)
 
@@ -27,7 +27,7 @@ val eq_gr : global_reference -> global_reference -> bool
 val canonical_gr : global_reference -> global_reference
 
 val destVarRef : global_reference -> variable
-val destConstRef : global_reference -> constant
+val destConstRef : global_reference -> Constant.t
 val destIndRef : global_reference -> inductive
 val destConstructRef : global_reference -> constructor
 
@@ -47,6 +47,7 @@ val global_of_constr : constr -> global_reference
 
 (** Obsolete synonyms for constr_of_global and global_of_constr *)
 val reference_of_constr : constr -> global_reference
+[@@ocaml.deprecated "Alias of Globnames.global_of_constr"]
 
 module RefOrdered : sig
   type t = global_reference
@@ -72,7 +73,7 @@ module Refmap_env : Map.ExtS
 
 (** {6 Extended global references } *)
 
-type syndef_name = kernel_name
+type syndef_name = KerName.t
 
 type extended_global_reference =
   | TrueGlobal of global_reference
@@ -91,13 +92,13 @@ type global_reference_or_constr =
 
 (** {6 Temporary function to brutally form kernel names from section paths } *)
 
-val encode_mind : DirPath.t -> Id.t -> mutual_inductive
-val decode_mind : mutual_inductive -> DirPath.t * Id.t
-val encode_con : DirPath.t -> Id.t -> constant
-val decode_con : constant -> DirPath.t * Id.t
+val encode_mind : DirPath.t -> Id.t -> MutInd.t
+val decode_mind : MutInd.t -> DirPath.t * Id.t
+val encode_con : DirPath.t -> Id.t -> Constant.t
+val decode_con : Constant.t -> DirPath.t * Id.t
 
 (** {6 Popping one level of section in global names } *)
 
-val pop_con : constant -> constant
-val pop_kn : mutual_inductive-> mutual_inductive
+val pop_con : Constant.t -> Constant.t
+val pop_kn : MutInd.t-> MutInd.t
 val pop_global_reference : global_reference -> global_reference
diff --git a/library/heads.ml b/library/heads.ml
index c12fa9479..ee3bfe1bd 100644
--- a/library/heads.ml
+++ b/library/heads.ml
@@ -8,7 +8,7 @@
 
 open Util
 open Names
-open Term
+open Constr
 open Vars
 open Mod_subst
 open Environ
@@ -25,7 +25,7 @@ open Context.Named.Declaration
    the evaluation of [phi(0)] and the head of [h] is declared unknown). *)
 
 type rigid_head_kind =
-| RigidParameter of constant (* a Const without body *)
+| RigidParameter of Constant.t (* a Const without body *)
 | RigidVar of variable (* a Var without body *)
 | RigidType (* an inductive, a product or a sort *)
 
@@ -57,7 +57,7 @@ let variable_head id  = Evalrefmap.find (EvalVarRef id) !head_map
 let constant_head cst = Evalrefmap.find (EvalConstRef cst) !head_map
 
 let kind_of_head env t =
-  let rec aux k l t b = match kind_of_term (Reduction.whd_betaiotazeta env t) with
+  let rec aux k l t b = match kind (Reduction.whd_betaiotazeta env t) with
   | Rel n when n > k -> NotImmediatelyComputableHead
   | Rel n -> FlexibleHead (k,k+1-n,List.length l,b)
   | Var id ->
@@ -156,7 +156,7 @@ let cache_head o =
 let subst_head_approximation subst = function
   | RigidHead (RigidParameter cst) as k ->
       let cst,c = subst_con_kn subst cst in
-      if isConst c && eq_constant (fst (destConst c)) cst then
+      if isConst c && Constant.equal (fst (destConst c)) cst then
         (* A change of the prefix of the constant *)
         k
       else
diff --git a/library/heads.mli b/library/heads.mli
index 1ce66c841..8ad5c0f14 100644
--- a/library/heads.mli
+++ b/library/heads.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
 
 (** This module is about the computation of an approximation of the
diff --git a/library/kindops.ml b/library/kindops.ml
index 882f62086..83985ce97 100644
--- a/library/kindops.ml
+++ b/library/kindops.ml
@@ -23,45 +23,13 @@ let string_of_theorem_kind = function
   | Proposition -> "Proposition"
   | Corollary -> "Corollary"
 
-let string_of_definition_kind def =
-  let (locality, poly, kind) = def in
-  let error () = CErrors.anomaly (Pp.str "Internal definition kind.") in
-  match kind with
-  | Definition ->
-    begin match locality with
-    | Discharge -> "Let"
-    | Local -> "Local Definition"
-    | Global -> "Definition"
-    end
-  | Example ->
-    begin match locality with
-    | Discharge -> error ()
-    | Local -> "Local Example"
-    | Global -> "Example"
-    end
-  | Coercion ->
-    begin match locality with
-    | Discharge -> error ()
-    | Local -> "Local Coercion"
-    | Global -> "Coercion"
-    end
-  | SubClass ->
-    begin match locality with
-    | Discharge -> error ()
-    | Local -> "Local SubClass"
-    | Global -> "SubClass"
-    end
-  | CanonicalStructure ->
-    begin match locality with
-    | Discharge -> error ()
-    | Local -> error ()
-    | Global -> "Canonical Structure"
-    end
-  | Instance ->
-    begin match locality with
-    | Discharge -> error ()
-    | Local -> "Instance"
-    | Global -> "Global Instance"
-    end
+let string_of_definition_object_kind = function
+  | Definition -> "Definition"
+  | Example -> "Example"
+  | Coercion -> "Coercion"
+  | SubClass -> "SubClass"
+  | CanonicalStructure -> "Canonical Structure"
+  | Instance -> "Instance"
+  | Let -> "Let"
   | (StructureComponent|Scheme|CoFixpoint|Fixpoint|IdentityCoercion|Method) ->
     CErrors.anomaly (Pp.str "Internal definition kind.")
diff --git a/library/kindops.mli b/library/kindops.mli
index 77979c915..06f873e85 100644
--- a/library/kindops.mli
+++ b/library/kindops.mli
@@ -12,4 +12,4 @@ open Decl_kinds
 
 val logical_kind_of_goal_kind : goal_object_kind -> logical_kind
 val string_of_theorem_kind : theorem_kind -> string
-val string_of_definition_kind : definition_kind -> string
+val string_of_definition_object_kind : definition_object_kind -> string
diff --git a/library/lib.ml b/library/lib.ml
index 5418003eb..971089c17 100644
--- a/library/lib.ml
+++ b/library/lib.ml
@@ -9,9 +9,9 @@
 open Pp
 open CErrors
 open Util
+open Names
 open Libnames
 open Globnames
-open Nameops
 open Libobject
 open Context.Named.Declaration
 
@@ -62,7 +62,7 @@ let classify_segment seg =
   let rec clean ((substl,keepl,anticipl) as acc) = function
     | (_,CompilingLibrary _) :: _ | [] -> acc
     | ((sp,kn),Leaf o) :: stk ->
-	let id = Names.Label.to_id (Names.label kn) in
+	let id = Names.Label.to_id (Names.KerName.label kn) in
 	  (match classify_object o with
 	     | Dispose -> clean acc stk
 	     | Keep o' ->
@@ -93,12 +93,16 @@ let segment_of_objects prefix =
    sections, but on the contrary there are many constructions of section
    paths based on the library path. *)
 
-let initial_prefix = default_library,(Names.initial_path,Names.DirPath.empty)
+let initial_prefix = {
+  obj_dir = default_library;
+  obj_mp  = ModPath.initial;
+  obj_sec = DirPath.empty;
+}
 
 type lib_state = {
-  comp_name   : Names.DirPath.t option;
+  comp_name   : DirPath.t option;
   lib_stk     : library_segment;
-  path_prefix : Names.DirPath.t * (Names.module_path * Names.DirPath.t);
+  path_prefix : object_prefix;
 }
 
 let initial_lib_state = {
@@ -115,10 +119,9 @@ let library_dp () =
 (* [path_prefix] is a pair of absolute dirpath and a pair of current
    module path and relative section path *)
 
-let cwd () = fst !lib_state.path_prefix
-let current_prefix () = snd !lib_state.path_prefix
-let current_mp () = fst (snd !lib_state.path_prefix)
-let current_sections () = snd (snd !lib_state.path_prefix)
+let cwd () = !lib_state.path_prefix.obj_dir
+let current_mp () = !lib_state.path_prefix.obj_mp
+let current_sections () = !lib_state.path_prefix.obj_sec
 
 let sections_depth () = List.length (Names.DirPath.repr (current_sections ()))
 let sections_are_opened () = not (Names.DirPath.is_empty (current_sections ()))
@@ -136,8 +139,8 @@ let make_path_except_section id =
   Libnames.make_path (cwd_except_section ()) id
 
 let make_kn id =
-  let mp,dir = current_prefix () in
-  Names.make_kn mp dir (Names.Label.of_id id)
+  let mp, dir = current_mp (), current_sections () in
+  Names.KerName.make mp dir (Names.Label.of_id id)
 
 let make_oname id = Libnames.make_oname !lib_state.path_prefix id
 
@@ -152,8 +155,11 @@ let recalc_path_prefix () =
   lib_state := { !lib_state with path_prefix = recalc !lib_state.lib_stk }
 
 let pop_path_prefix () =
-  let dir,(mp,sec) = !lib_state.path_prefix in
-  lib_state := { !lib_state with path_prefix = pop_dirpath dir, (mp, pop_dirpath sec)}
+  let op = !lib_state.path_prefix in
+  lib_state := { !lib_state
+                 with path_prefix = { op with obj_dir = pop_dirpath op.obj_dir;
+                                              obj_sec = pop_dirpath op.obj_sec;
+                                    } }
 
 let find_entry_p p =
   let rec find = function
@@ -226,7 +232,7 @@ let add_anonymous_entry node =
   add_entry (make_oname (anonymous_id ())) node
 
 let add_leaf id obj =
-  if Names.ModPath.equal (current_mp ()) Names.initial_path then
+  if ModPath.equal (current_mp ()) ModPath.initial then
     user_err Pp.(str "No session module started (use -top dir)");
   let oname = make_oname id in
   cache_object (oname,obj);
@@ -278,14 +284,14 @@ let current_mod_id () =
 
 
 let start_mod is_type export id mp fs =
-  let dir = add_dirpath_suffix (cwd ()) id in
-  let prefix = dir,(mp,Names.DirPath.empty) in
+  let dir = add_dirpath_suffix (!lib_state.path_prefix.obj_dir) id in
+  let prefix = { obj_dir = dir; obj_mp = mp; obj_sec = Names.DirPath.empty } in
   let exists =
     if is_type then Nametab.exists_cci (make_path id)
     else Nametab.exists_module dir
   in
   if exists then
-    user_err ~hdr:"open_module" (pr_id id ++ str " already exists");
+    user_err ~hdr:"open_module" (Id.print id ++ str " already exists");
   add_entry (make_oname id) (OpenedModule (is_type,export,prefix,fs));
   lib_state := { !lib_state with path_prefix = prefix} ;
   prefix
@@ -296,7 +302,7 @@ let start_modtype = start_mod true None
 let error_still_opened string oname =
   let id = basename (fst oname) in
   user_err 
-    (str "The " ++ str string ++ str " " ++ pr_id id ++ str " is still opened.")
+    (str "The " ++ str string ++ str " " ++ Id.print id ++ str " is still opened.")
 
 let end_mod is_type =
   let oname,fs =
@@ -328,17 +334,17 @@ let contents_after sp = let (after,_,_) = split_lib sp in after
 let start_compilation s mp =
   if !lib_state.comp_name != None then
     user_err Pp.(str "compilation unit is already started");
-  if not (Names.DirPath.is_empty (current_sections ())) then
+  if not (Names.DirPath.is_empty (!lib_state.path_prefix.obj_sec)) then
     user_err Pp.(str "some sections are already opened");
-  let prefix = s, (mp, Names.DirPath.empty) in
-  let () = add_anonymous_entry (CompilingLibrary prefix) in
+  let prefix = Libnames.{ obj_dir = s; obj_mp = mp; obj_sec = DirPath.empty } in
+  add_anonymous_entry (CompilingLibrary prefix);
   lib_state := { !lib_state with comp_name = Some s;
                                  path_prefix = prefix }
 
 let open_blocks_message es =
   let open_block_name = function
-      | oname, OpenedSection _ -> str "section " ++ pr_id (basename (fst oname))
-      | oname, OpenedModule (ty,_,_,_) -> str (module_kind ty) ++ spc () ++ pr_id (basename (fst oname))
+      | oname, OpenedSection _ -> str "section " ++ Id.print (basename (fst oname))
+      | oname, OpenedModule (ty,_,_,_) -> str (module_kind ty) ++ spc () ++ Id.print (basename (fst oname))
       | _ -> assert false in
   str "The " ++ pr_enum open_block_name es ++ spc () ++
   str "need" ++ str (if List.length es == 1 then "s" else "") ++ str " to be closed."
@@ -360,8 +366,8 @@ let end_compilation_checks dir =
       | None -> anomaly (Pp.str "There should be a module name...")
       | Some m ->
 	  if not (Names.DirPath.equal m dir) then anomaly
-	    (str "The current open module has name" ++ spc () ++ pr_dirpath m ++
-             spc () ++ str "and not" ++ spc () ++ pr_dirpath m ++ str ".");
+           (str "The current open module has name" ++ spc () ++ DirPath.print m ++
+             spc () ++ str "and not" ++ spc () ++ DirPath.print m ++ str ".");
   in
   oname
 
@@ -395,7 +401,7 @@ let find_opening_node id =
     let id' = basename (fst oname) in
     if not (Names.Id.equal id id') then
       user_err ~hdr:"Lib.find_opening_node"
-        (str "Last block to end has name " ++ pr_id id' ++ str ".");
+        (str "Last block to end has name " ++ Id.print id' ++ str ".");
     entry
   with Not_found -> user_err Pp.(str "There is nothing to end.")
 
@@ -411,14 +417,17 @@ let find_opening_node id =
 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.AUContext.t
-		  
+type abstr_info = {
+  abstr_ctx : variable_context;
+  abstr_subst : Univ.Instance.t;
+  abstr_uctx : Univ.AUContext.t;
+}
 type abstr_list = abstr_info Names.Cmap.t * abstr_info Names.Mindmap.t
 
 type secentry =
   | Variable of (Names.Id.t * Decl_kinds.binding_kind *
-		   Decl_kinds.polymorphic * Univ.universe_context_set)
-  | Context of Univ.universe_context_set
+		   Decl_kinds.polymorphic * Univ.ContextSet.t)
+  | Context of Univ.ContextSet.t
 
 let sectab =
   Summary.ref ([] : (secentry list * Opaqueproof.work_list * abstr_list) list)
@@ -477,8 +486,12 @@ let add_section_replacement f g poly hyps =
     let inst = Univ.UContext.instance ctx in
     let subst, ctx = Univ.abstract_universes ctx in
     let args = instance_from_variable_context (List.rev sechyps) in
-    sectab := (vars,f (inst,args) exps,
-	      g (sechyps,subst,ctx) abs)::sl
+    let info = {
+      abstr_ctx = sechyps;
+      abstr_subst = subst;
+      abstr_uctx = ctx;
+    } in
+    sectab := (vars,f (inst,args) exps, g info abs) :: sl
 
 let add_section_kn poly kn =
   let f x (l1,l2) = (l1,Names.Mindmap.add kn x l2) in
@@ -496,16 +509,25 @@ 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 empty_segment = {
+  abstr_ctx = [];
+  abstr_subst = Univ.Instance.empty;
+  abstr_uctx = Univ.AUContext.empty;
+}
+
+let section_segment_of_reference = function
+| ConstRef c -> section_segment_of_constant c
+| IndRef (kn,_) | ConstructRef ((kn,_),_) ->
+  section_segment_of_mutual_inductive kn
+| VarRef _ -> empty_segment
+
+let variable_section_segment_of_reference gr =
+  (section_segment_of_reference gr).abstr_ctx
+
 let section_instance = function
   | VarRef id ->
      let eq = function
-       | Variable (id',_,_,_) -> Names.id_eq id id'
+       | Variable (id',_,_,_) -> Names.Id.equal id id'
        | Context _ -> false
      in
      if List.exists eq (pi1 (List.hd !sectab))
@@ -522,15 +544,15 @@ let is_in_section ref =
 (*************)
 (* Sections. *)
 let open_section id =
-  let olddir,(mp,oldsec) = !lib_state.path_prefix in
-  let dir = add_dirpath_suffix olddir id in
-  let prefix = dir, (mp, add_dirpath_suffix oldsec id) in
-  if Nametab.exists_section dir then
-    user_err ~hdr:"open_section" (pr_id id ++ str " already exists.");
+  let opp = !lib_state.path_prefix in
+  let obj_dir = add_dirpath_suffix opp.obj_dir id in
+  let prefix = { obj_dir; obj_mp = opp.obj_mp; obj_sec = add_dirpath_suffix opp.obj_sec id } in
+  if Nametab.exists_section obj_dir then
+    user_err ~hdr:"open_section" (Id.print 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*)
-  Nametab.push_dir (Nametab.Until 1) dir (DirOpenSection prefix);
+  Nametab.push_dir (Nametab.Until 1) obj_dir (DirOpenSection prefix);
   lib_state := { !lib_state with path_prefix = prefix };
   add_section ()
 
@@ -556,7 +578,7 @@ let close_section () =
   in
   let (secdecls,mark,before) = split_lib_at_opening oname in
   lib_state := { !lib_state with lib_stk = before };
-  let full_olddir = fst !lib_state.path_prefix in
+  let full_olddir = !lib_state.path_prefix.obj_dir in
   pop_path_prefix ();
   add_entry oname (ClosedSection (List.rev (mark::secdecls)));
   let newdecls = List.map discharge_item secdecls in
@@ -596,10 +618,10 @@ let init () =
 (* Misc *)
 
 let mp_of_global = function
-  |VarRef id -> current_mp ()
-  |ConstRef cst -> Names.con_modpath cst
-  |IndRef ind -> Names.ind_modpath ind
-  |ConstructRef constr -> Names.constr_modpath constr
+  | VarRef id -> !lib_state.path_prefix.obj_mp
+  | ConstRef cst -> Names.Constant.modpath cst
+  | IndRef ind -> Names.ind_modpath ind
+  | ConstructRef constr -> Names.constr_modpath constr
 
 let rec dp_of_mp = function
   |Names.MPfile dp -> dp
@@ -621,12 +643,12 @@ let library_part = function
 (* Discharging names *)
 
 let con_defined_in_sec kn =
-  let _,dir,_ = Names.repr_con kn in
+  let _,dir,_ = Names.Constant.repr3 kn in
   not (Names.DirPath.is_empty dir) &&
   Names.DirPath.equal (pop_dirpath dir) (current_sections ())
 
 let defined_in_sec kn =
-  let _,dir,_ = Names.repr_mind kn in
+  let _,dir,_ = Names.MutInd.repr3 kn in
   not (Names.DirPath.is_empty dir) &&
   Names.DirPath.equal (pop_dirpath dir) (current_sections ())
 
@@ -648,15 +670,10 @@ let discharge_con cst =
 let discharge_inductive (kn,i) =
   (discharge_kn kn,i)
 
-let discharge_abstract_universe_context (_, subst, abs_ctx) auctx =
+let discharge_abstract_universe_context { abstr_subst = subst; abstr_uctx = abs_ctx } auctx =
   let open Univ in
-  let len = LMap.cardinal subst in
-  let rec gen_subst i acc =
-    if i < 0 then acc
-    else
-      let acc = LMap.add (Level.var i) (Level.var (i + len)) acc in
-      gen_subst (pred i) acc
-  in
-  let subst = gen_subst (AUContext.size auctx - 1) subst in
+  let ainst = make_abstract_instance auctx in
+  let subst = Instance.append subst ainst in
+  let subst = make_instance_subst subst in
   let auctx = Univ.subst_univs_level_abstract_universe_context subst auctx in
   subst, AUContext.union abs_ctx auctx
diff --git a/library/lib.mli b/library/lib.mli
index 3dcec1d53..cf75d5f8c 100644
--- a/library/lib.mli
+++ b/library/lib.mli
@@ -81,8 +81,8 @@ val make_path : Names.Id.t -> Libnames.full_path
 val make_path_except_section : Names.Id.t -> Libnames.full_path
 
 (** Kernel-side names *)
-val current_mp : unit -> Names.module_path
-val make_kn : Names.Id.t -> Names.kernel_name
+val current_mp : unit -> Names.ModPath.t
+val make_kn : Names.Id.t -> Names.KerName.t
 
 (** Are we inside an opened section *)
 val sections_are_opened : unit -> bool
@@ -103,11 +103,11 @@ val find_opening_node : Names.Id.t -> node
 (** {6 Modules and module types } *)
 
 val start_module :
-  export -> Names.module_ident -> Names.module_path ->
+  export -> Names.module_ident -> Names.ModPath.t ->
   Summary.frozen -> Libnames.object_prefix
 
 val start_modtype :
-  Names.module_ident -> Names.module_path ->
+  Names.module_ident -> Names.ModPath.t ->
   Summary.frozen -> Libnames.object_prefix
 
 val end_module :
@@ -122,7 +122,7 @@ val end_modtype :
 
 (** {6 Compilation units } *)
 
-val start_compilation : Names.DirPath.t -> Names.module_path -> unit
+val start_compilation : Names.DirPath.t -> Names.ModPath.t -> unit
 val end_compilation_checks : Names.DirPath.t -> Libnames.object_name
 val end_compilation :
   Libnames.object_name-> Libnames.object_prefix * library_segment
@@ -132,8 +132,8 @@ val end_compilation :
 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_modpath : Names.module_path -> Names.DirPath.t * Names.Id.t list
+val dp_of_mp : Names.ModPath.t -> Names.DirPath.t
+val split_modpath : Names.ModPath.t -> Names.DirPath.t * Names.Id.t list
 val library_part :  Globnames.global_reference -> Names.DirPath.t
 
 (** {6 Sections } *)
@@ -153,30 +153,39 @@ val init : unit -> unit
 (** {6 Section management for discharge } *)
 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.AUContext.t
+type abstr_info = private {
+  abstr_ctx : variable_context;
+  (** Section variables of this prefix *)
+  abstr_subst : Univ.Instance.t;
+  (** Actual names of the abstracted variables *)
+  abstr_uctx : Univ.AUContext.t;
+  (** Universe quantification, same length as the substitution *)
+}
 
 val instance_from_variable_context : variable_context -> Names.Id.t array
 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 section_segment_of_constant : Names.Constant.t -> abstr_info
+val section_segment_of_mutual_inductive: Names.MutInd.t -> abstr_info
+val section_segment_of_reference : Globnames.global_reference -> 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 section_instance : Globnames.global_reference -> Univ.Instance.t * Names.Id.t array
 val is_in_section : Globnames.global_reference -> bool
 
-val add_section_variable : Names.Id.t -> Decl_kinds.binding_kind -> Decl_kinds.polymorphic -> Univ.universe_context_set -> unit
-val add_section_context : Univ.universe_context_set -> unit
+val add_section_variable : Names.Id.t -> Decl_kinds.binding_kind -> Decl_kinds.polymorphic -> Univ.ContextSet.t -> unit
+val add_section_context : Univ.ContextSet.t -> unit
 val add_section_constant : Decl_kinds.polymorphic ->
-  Names.constant -> Context.Named.t -> unit
+  Names.Constant.t -> Context.Named.t -> unit
 val add_section_kn : Decl_kinds.polymorphic ->
-  Names.mutual_inductive -> Context.Named.t -> unit
+  Names.MutInd.t -> Context.Named.t -> unit
 val replacement_context : unit -> Opaqueproof.work_list
 
 (** {6 Discharge: decrease the section level if in the current section } *)
 
-val discharge_kn :  Names.mutual_inductive -> Names.mutual_inductive
-val discharge_con : Names.constant -> Names.constant
+val discharge_kn :  Names.MutInd.t -> Names.MutInd.t
+val discharge_con : Names.Constant.t -> Names.Constant.t
 val discharge_global : Globnames.global_reference -> Globnames.global_reference
 val discharge_inductive : Names.inductive -> Names.inductive
 val discharge_abstract_universe_context :
diff --git a/library/libnames.ml b/library/libnames.ml
index 0453f15e8..a471d8396 100644
--- a/library/libnames.ml
+++ b/library/libnames.ml
@@ -13,7 +13,7 @@ open Names
 
 (**********************************************)
 
-let pr_dirpath sl = str (DirPath.to_string sl)
+let pr_dirpath sl = DirPath.print sl
 
 (*s Operations on dirpaths *)
 
@@ -154,12 +154,17 @@ let qualid_of_dirpath dir =
   let (l,a) = split_dirpath dir in
   make_qualid l a
 
-type object_name = full_path * kernel_name
+type object_name = full_path * KerName.t
 
-type object_prefix = DirPath.t * (module_path * DirPath.t)
+type object_prefix = {
+  obj_dir : DirPath.t;
+  obj_mp  : ModPath.t;
+  obj_sec : DirPath.t;
+}
 
-let make_oname (dirpath,(mp,dir)) id =
-  make_path dirpath id, make_kn mp dir (Label.of_id id)
+(* let make_oname (dirpath,(mp,dir)) id = *)
+let make_oname { obj_dir; obj_mp; obj_sec } id =
+  make_path obj_dir id, KerName.make obj_mp obj_sec (Label.of_id id)
 
 (* to this type are mapped DirPath.t's in the nametab *)
 type global_dir_reference =
@@ -170,10 +175,10 @@ type global_dir_reference =
   | DirClosedSection of DirPath.t
       (* this won't last long I hope! *)
 
-let eq_op (d1, (mp1, p1)) (d2, (mp2, p2)) =
-  DirPath.equal d1 d2 &&
-  DirPath.equal p1 p2 &&
-  mp_eq mp1 mp2
+let eq_op op1 op2 =
+  DirPath.equal op1.obj_dir op2.obj_dir &&
+  DirPath.equal op1.obj_sec op2.obj_sec &&
+  ModPath.equal op1.obj_mp  op2.obj_mp
 
 let eq_global_dir_reference r1 r2 = match r1, r2 with
 | DirOpenModule op1, DirOpenModule op2 -> eq_op op1 op2
@@ -232,6 +237,14 @@ let join_reference ns r =
     Qualid (loc, make_qualid
       (dirpath_of_string (Names.Id.to_string id1)) id2)
 
+(* Default paths *)
+let default_library = Names.DirPath.initial (* = ["Top"] *)
+
+(*s Roots of the space of absolute names *)
+let coq_string = "Coq"
+let coq_root = Id.of_string coq_string
+let default_root_prefix = DirPath.empty
+
 (* Deprecated synonyms *)
 
 let make_short_qualid = qualid_of_ident
diff --git a/library/libnames.mli b/library/libnames.mli
index 1b351290a..71f542240 100644
--- a/library/libnames.mli
+++ b/library/libnames.mli
@@ -11,12 +11,13 @@ open Loc
 open Names
 
 (** {6 Dirpaths } *)
-(** FIXME: ought to be in Names.dir_path *)
+val dirpath_of_string : string -> DirPath.t
 
 val pr_dirpath : DirPath.t -> Pp.t
+[@@ocaml.deprecated "Alias for DirPath.print"]
 
-val dirpath_of_string : string -> DirPath.t
 val string_of_dirpath : DirPath.t -> string
+[@@ocaml.deprecated "Alias for DirPath.to_string"]
 
 (** Pop the suffix of a [DirPath.t]. Raises a [Failure] for an empty path *)
 val pop_dirpath : DirPath.t -> DirPath.t
@@ -91,9 +92,27 @@ val qualid_of_ident : Id.t -> qualid
    can be substituted and a "syntactic" [full_path] which can be printed
 *)
 
-type object_name = full_path * kernel_name
+type object_name = full_path * KerName.t
+
+(** Object prefix morally contains the "prefix" naming of an object to
+   be stored by [library], where [obj_dir] is the "absolute" path,
+   [obj_mp] is the current "module" prefix and [obj_sec] is the
+   "section" prefix.
+
+    Thus, for an object living inside [Module A. Section B.] the
+   prefix would be:
+
+    [ { obj_dir = "A.B"; obj_mp = "A"; obj_sec = "B" } ]
+
+    Note that both [obj_dir] and [obj_sec] are "paths" that is to say,
+   as opposed to [obj_mp] which is a single module name.
 
-type object_prefix = DirPath.t * (module_path * DirPath.t)
+ *)
+type object_prefix = {
+  obj_dir : DirPath.t;
+  obj_mp  : ModPath.t;
+  obj_sec : DirPath.t;
+}
 
 val eq_op : object_prefix -> object_prefix -> bool
 
@@ -127,7 +146,20 @@ val pr_reference : reference -> Pp.t
 val loc_of_reference : reference -> Loc.t option
 val join_reference : reference -> reference -> reference
 
-(** Deprecated synonyms *)
+(** some preset paths *)
+val default_library : DirPath.t
+
+(** This is the root of the standard library of Coq *)
+val coq_root : module_ident (** "Coq" *)
+val coq_string : string (** "Coq" *)
+
+(** This is the default root prefix for developments which doesn't
+   mention a root *)
+val default_root_prefix : DirPath.t
 
+(** Deprecated synonyms *)
 val make_short_qualid : Id.t -> qualid (** = qualid_of_ident *)
+[@@ocaml.deprecated "Alias for qualid_of_ident"]
+
 val qualid_of_sp : full_path -> qualid (** = qualid_of_path *)
+[@@ocaml.deprecated "Alias for qualid_of_sp"]
diff --git a/library/libobject.ml b/library/libobject.ml
index 013c6fa0a..0c11be9ab 100644
--- a/library/libobject.ml
+++ b/library/libobject.ml
@@ -9,7 +9,7 @@
 open Libnames
 open Pp
 
-module Dyn = Dyn.Make(struct end)
+module Dyn = Dyn.Make ()
 
 type 'a substitutivity =
     Dispose | Substitute of 'a | Keep of 'a | Anticipate of 'a
diff --git a/library/library.ml b/library/library.ml
index 28afa054e..868e26684 100644
--- a/library/library.ml
+++ b/library/library.ml
@@ -12,9 +12,8 @@ open Util
 
 open Names
 open Libnames
-open Nameops
-open Libobject
 open Lib
+open Libobject
 
 (************************************************************************)
 (*s Low-level interning/externing of libraries to files *)
@@ -97,7 +96,7 @@ type library_t = {
   library_deps : (compilation_unit_name * Safe_typing.vodigest) array;
   library_imports : compilation_unit_name array;
   library_digests : Safe_typing.vodigest;
-  library_extra_univs : Univ.universe_context_set;
+  library_extra_univs : Univ.ContextSet.t;
 }
 
 type library_summary = {
@@ -132,7 +131,7 @@ let try_find_library dir =
   try find_library dir
   with Not_found ->
     user_err ~hdr:"Library.find_library"
-      (str "Unknown library " ++ pr_dirpath dir)
+      (str "Unknown library " ++ DirPath.print dir)
 
 let register_library_filename dir f =
   (* Not synchronized: overwrite the previous binding if one existed *)
@@ -171,7 +170,7 @@ let register_loaded_library m =
     let prefix = Nativecode.mod_uid_of_dirpath libname ^ "." in
     let f = prefix ^ "cmo" in
     let f = Dynlink.adapt_filename f in
-    if not Coq_config.no_native_compiler then
+    if Coq_config.native_compiler then
       Nativelib.link_library ~prefix ~dirname ~basename:f
   in
   let rec aux = function
@@ -331,7 +330,7 @@ let error_unmapped_dir qid =
   let prefix, _ = repr_qualid qid in
   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 ())
+     str "no physical path bound to" ++ spc () ++ DirPath.print prefix ++ fnl ())
 
 let error_lib_not_found qid =
   user_err ~hdr:"load_absolute_library_from"
@@ -360,9 +359,9 @@ type 'a table_status =
   | Fetched of 'a Future.computation array
 
 let opaque_tables =
-  ref (LibraryMap.empty : (Term.constr table_status) LibraryMap.t)
+  ref (LibraryMap.empty : (Constr.constr table_status) LibraryMap.t)
 let univ_tables =
-  ref (LibraryMap.empty : (Univ.universe_context_set table_status) LibraryMap.t)
+  ref (LibraryMap.empty : (Univ.ContextSet.t table_status) LibraryMap.t)
 
 let add_opaque_table dp st =
   opaque_tables := LibraryMap.add dp st !opaque_tables
@@ -408,9 +407,9 @@ let () =
 type seg_sum = summary_disk
 type seg_lib = library_disk
 type seg_univ = (* true = vivo, false = vi *)
-  Univ.universe_context_set Future.computation array * Univ.universe_context_set * bool
+  Univ.ContextSet.t Future.computation array * Univ.ContextSet.t * bool
 type seg_discharge = Opaqueproof.cooking_info list array
-type seg_proofs = Term.constr Future.computation array
+type seg_proofs = Constr.constr Future.computation array
 
 let mk_library sd md digests univs =
   {
@@ -465,8 +464,8 @@ let rec intern_library (needed, contents) (dir, f) from =
   if not (DirPath.equal dir m.library_name) then
     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);
+       DirPath.print m.library_name ++ spc () ++ str "and not library" ++
+       spc() ++ DirPath.print dir);
   Feedback.feedback (Feedback.FileLoaded(DirPath.to_string dir, f));
   m.library_digests, intern_library_deps (needed, contents) dir m f
 
@@ -477,9 +476,9 @@ and intern_library_deps libs dir m from =
 and intern_mandatory_library caller from libs (dir,d) =
   let digest, libs = intern_library libs (dir, None) (Some from) in
   if not (Safe_typing.digest_match ~actual:digest ~required:d) then
-    user_err (str "Compiled library " ++ pr_dirpath caller ++
+    user_err (str "Compiled library " ++ DirPath.print caller ++
     str " (in file " ++ str from ++ str ") makes inconsistent assumptions \
-    over library " ++ pr_dirpath dir);
+    over library " ++ DirPath.print dir);
   libs
 
 let rec_intern_library libs (dir, f) =
@@ -617,38 +616,18 @@ let check_coq_overwriting p id =
   let is_empty = match l with [] -> true | _ -> false in
   if not !Flags.boot && not is_empty && Id.equal (List.last l) coq_root then
     user_err 
-      (str "Cannot build module " ++ pr_dirpath p ++ str "." ++ pr_id id ++ str "." ++ spc () ++
+      (str "Cannot build module " ++ DirPath.print p ++ str "." ++ Id.print id ++ str "." ++ spc () ++
       str "it starts with prefix \"Coq\" which is reserved for the Coq library.")
 
-(* Verifies that a string starts by a letter and do not contain
-   others caracters than letters, digits, or `_` *)
-
-let check_module_name s =
-  let msg c =
-    strbrk "Invalid module name: " ++ str s ++ strbrk " character " ++
-    (if c = '\'' then str "\"'\"" else (str "'" ++ str (String.make 1 c) ++ str "'")) ++
-    strbrk " is not allowed in module names\n"
-  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
-          match String.get s i with
-            | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '_'  -> ()
-            | c -> err c
-        done
-    | c -> err c
-
 let start_library fo =
   let ldir0 =
     try
       let lp = Loadpath.find_load_path (Filename.dirname fo) in
       Loadpath.logical lp
-    with Not_found -> Nameops.default_root_prefix
+    with Not_found -> Libnames.default_root_prefix
   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;
   let ldir = add_dirpath_suffix ldir0 id in
   Declaremods.start_library ldir;
@@ -685,7 +664,7 @@ let current_reexports () = !libraries_exports_list
 
 let error_recursively_dependent_library dir =
   user_err 
-    (strbrk "Unable to use logical name " ++ pr_dirpath dir ++
+    (strbrk "Unable to use logical name " ++ DirPath.print dir ++
      strbrk " to save current library because" ++
      strbrk " it already depends on a library of this name.")
 
@@ -703,7 +682,8 @@ let error_recursively_dependent_library dir =
 let save_library_to ?todo dir f otab =
   let except = match todo with
     | None ->
-        assert(!Flags.compilation_mode = Flags.BuildVo);
+        (* XXX *)
+        (* assert(!Flags.compilation_mode = Flags.BuildVo); *)
         assert(Filename.check_suffix f ".vo");
         Future.UUIDSet.empty
     | Some (l,_) ->
@@ -758,7 +738,7 @@ let save_library_to ?todo dir f otab =
     System.marshal_out_segment f' ch (opaque_table : seg_proofs);
     close_out ch;
     (* Writing native code files *)
-    if !Flags.native_compiler then
+    if !Flags.output_native_objects then
       let fn = Filename.dirname f'^"/"^Nativecode.mod_uid_of_dirpath dir in
       if not (Nativelib.compile_library dir ast fn) then
 	user_err Pp.(str "Could not compile the library to native code.")
diff --git a/library/library.mli b/library/library.mli
index 6c624ce52..63e7b95bb 100644
--- a/library/library.mli
+++ b/library/library.mli
@@ -29,9 +29,9 @@ val require_library_from_dirpath : (DirPath.t * string) list -> bool option -> u
 type seg_sum
 type seg_lib
 type seg_univ = (* cst, all_cst, finished? *)
-  Univ.universe_context_set Future.computation array * Univ.universe_context_set * bool
+  Univ.ContextSet.t Future.computation array * Univ.ContextSet.t * bool
 type seg_discharge = Opaqueproof.cooking_info list array
-type seg_proofs = Term.constr Future.computation array
+type seg_proofs = Constr.constr Future.computation array
 
 (** Open a module (or a library); if the boolean is true then it's also
    an export otherwise just a simple import *)
diff --git a/library/library.mllib b/library/library.mllib
index d94fc2291..e43bfb5a1 100644
--- a/library/library.mllib
+++ b/library/library.mllib
@@ -1,5 +1,3 @@
-Univops
-Nameops
 Libnames
 Globnames
 Libobject
diff --git a/library/loadpath.ml b/library/loadpath.ml
index 757e972b1..eb6dae84a 100644
--- a/library/loadpath.ml
+++ b/library/loadpath.ml
@@ -54,8 +54,8 @@ 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)
+            DirPath.print old_path ++ strbrk "; it is remapped to " ++
+            DirPath.print coq_path)
 
 let add_load_path phys_path coq_path ~implicit =
   let phys_path = CUnix.canonical_path_name phys_path in
@@ -75,7 +75,7 @@ let add_load_path phys_path coq_path ~implicit =
       else
         let () =
           (* Do not warn when overriding the default "-I ." path *)
-          if not (DirPath.equal old_path Nameops.default_root_prefix) then
+          if not (DirPath.equal old_path Libnames.default_root_prefix) then
           warn_overriding_logical_loadpath (phys_path, old_path, coq_path)
         in
         true in
diff --git a/library/nametab.ml b/library/nametab.ml
index 68fdbb4f3..08881d6d7 100644
--- a/library/nametab.ml
+++ b/library/nametab.ml
@@ -19,10 +19,6 @@ exception GlobalizationError of qualid
 let error_global_not_found ?loc q =
   Loc.raise ?loc (GlobalizationError q)
 
-(* Kinds of global names *)
-
-type ltac_constant = kernel_name
-
 (* The visibility can be registered either
    - for all suffixes not shorter then a given int - when the object
      is loaded inside a module
@@ -85,8 +81,9 @@ struct
      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 ^ "\"!"))
+  let warn_masking_absolute =
+    CWarnings.create ~name:"masking-absolute-name" ~category:"deprecated"
+      (fun n -> str ("Trying to mask the absolute name \"" ^ U.to_string n ^ "\"!"))
 
   type user_name = U.t
 
@@ -125,7 +122,7 @@ struct
 	      | Absolute (n,_) ->
 		  (* This is an absolute name, we must keep it
 		     otherwise it may become unaccessible forever *)
-                masking_absolute n; tree.path
+                warn_masking_absolute n; tree.path
 	      | Nothing
 	      | Relative _ -> Relative (uname,o)
           else tree.path
@@ -158,7 +155,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 *)
-            masking_absolute n; tree.path
+            warn_masking_absolute n; tree.path
         | Nothing
         | Relative _ -> Relative (uname,o)
     in
@@ -274,19 +271,14 @@ struct
 end
 
 module ExtRefEqual = ExtRefOrdered
-module KnEqual = Names.KerName
 module MPEqual = Names.ModPath
 
 module ExtRefTab = Make(FullPath)(ExtRefEqual)
-module KnTab = Make(FullPath)(KnEqual)
 module MPTab = Make(FullPath)(MPEqual)
 
 type ccitab = ExtRefTab.t
 let the_ccitab = ref (ExtRefTab.empty : ccitab)
 
-type kntab = KnTab.t
-let the_tactictab = ref (KnTab.empty : kntab)
-
 type mptab = MPTab.t
 let the_modtypetab = ref (MPTab.empty : mptab)
 
@@ -311,6 +303,16 @@ module DirTab = Make(DirPath')(GlobDir)
 type dirtab = DirTab.t
 let the_dirtab = ref (DirTab.empty : dirtab)
 
+type universe_id = DirPath.t * int
+
+module UnivIdEqual =
+struct
+  type t = universe_id
+  let equal (d, i) (d', i') = DirPath.equal d d' && Int.equal i i'
+end
+module UnivTab = Make(FullPath)(UnivIdEqual)
+type univtab = UnivTab.t
+let the_univtab = ref (UnivTab.empty : univtab)
 
 (* Reversed name tables ***************************************************)
 
@@ -327,9 +329,20 @@ let the_modrevtab = ref (MPmap.empty : mprevtab)
 type mptrevtab = full_path MPmap.t
 let the_modtyperevtab = ref (MPmap.empty : mptrevtab)
 
-type knrevtab = full_path KNmap.t
-let the_tacticrevtab = ref (KNmap.empty : knrevtab)
+module UnivIdOrdered =
+struct
+  type t = universe_id
+  let hash (d, i) = i + DirPath.hash d
+  let compare (d, i) (d', i') =
+    let c = Int.compare i i' in
+    if Int.equal c 0 then DirPath.compare d d'
+    else c
+end
+
+module UnivIdMap = HMap.Make(UnivIdOrdered)
 
+type univrevtab = full_path UnivIdMap.t
+let the_univrevtab = ref (UnivIdMap.empty : univrevtab)
 
 (* Push functions *********************************************************)
 
@@ -368,20 +381,18 @@ let push_modtype vis sp kn =
   the_modtypetab := MPTab.push vis sp kn !the_modtypetab;
   the_modtyperevtab := MPmap.add kn sp !the_modtyperevtab
 
-(* This is for tactic definition names *)
-
-let push_tactic vis sp kn =
-  the_tactictab := KnTab.push vis sp kn !the_tactictab;
-  the_tacticrevtab := KNmap.add kn sp !the_tacticrevtab
-
-
 (* This is to remember absolute Section/Module names and to avoid redundancy *)
 let push_dir vis dir dir_ref =
   the_dirtab := DirTab.push vis dir dir_ref !the_dirtab;
   match dir_ref with
-      DirModule (_,(mp,_)) -> the_modrevtab := MPmap.add mp dir !the_modrevtab
-    | _ -> ()
+  | DirModule { obj_mp; _ } -> the_modrevtab := MPmap.add obj_mp dir !the_modrevtab
+  | _ -> ()
 
+(* This is for global universe names *)
+
+let push_universe vis sp univ =
+  the_univtab := UnivTab.push vis sp univ !the_univtab;
+  the_univrevtab := UnivIdMap.add univ sp !the_univrevtab
 
 (* Locate functions *******************************************************)
 
@@ -402,23 +413,23 @@ let locate_syndef qid = match locate_extended qid with
 let locate_modtype qid = MPTab.locate qid !the_modtypetab
 let full_name_modtype qid = MPTab.user_name qid !the_modtypetab
 
-let locate_tactic qid = KnTab.locate qid !the_tactictab
+let locate_universe qid = UnivTab.locate qid !the_univtab
 
 let locate_dir qid = DirTab.locate qid !the_dirtab
 
 let locate_module qid =
   match locate_dir qid with
-    | DirModule (_,(mp,_)) -> mp
+    | DirModule { obj_mp ; _} -> obj_mp
     | _ -> raise Not_found
 
 let full_name_module qid =
   match locate_dir qid with
-    | DirModule (dir,_) -> dir
+    | DirModule { obj_dir ; _} -> obj_dir
     | _ -> raise Not_found
 
 let locate_section qid =
   match locate_dir qid with
-    | DirOpenSection (dir, _)
+    | DirOpenSection { obj_dir; _ } -> obj_dir
     | DirClosedSection dir -> dir
     | _ -> raise Not_found
 
@@ -428,8 +439,6 @@ let locate_all qid =
 
 let locate_extended_all qid = ExtRefTab.find_prefixes qid !the_ccitab
 
-let locate_extended_all_tactic qid = KnTab.find_prefixes qid !the_tactictab
-
 let locate_extended_all_dir qid = DirTab.find_prefixes qid !the_dirtab
 
 let locate_extended_all_modtype qid = MPTab.find_prefixes qid !the_modtypetab
@@ -471,7 +480,7 @@ let exists_module = exists_dir
 
 let exists_modtype sp = MPTab.exists sp !the_modtypetab
 
-let exists_tactic kn = KnTab.exists kn !the_tactictab
+let exists_universe kn = UnivTab.exists kn !the_univtab
 
 (* Reverse locate functions ***********************************************)
 
@@ -492,12 +501,12 @@ let path_of_syndef kn =
 let dirpath_of_module mp =
   MPmap.find mp !the_modrevtab
 
-let path_of_tactic kn =
-  KNmap.find kn !the_tacticrevtab
-
 let path_of_modtype mp =
   MPmap.find mp !the_modtyperevtab
 
+let path_of_universe mp =
+  UnivIdMap.find mp !the_univrevtab
+
 (* Shortest qualid functions **********************************************)
 
 let shortest_qualid_of_global ctx ref =
@@ -519,9 +528,9 @@ let shortest_qualid_of_modtype kn =
   let sp = MPmap.find kn !the_modtyperevtab in
     MPTab.shortest_qualid Id.Set.empty sp !the_modtypetab
 
-let shortest_qualid_of_tactic kn =
-  let sp = KNmap.find kn !the_tacticrevtab in
-    KnTab.shortest_qualid Id.Set.empty sp !the_tactictab
+let shortest_qualid_of_universe kn =
+  let sp = UnivIdMap.find kn !the_univrevtab in
+    UnivTab.shortest_qualid Id.Set.empty sp !the_univtab
 
 let pr_global_env env ref =
   try pr_qualid (shortest_qualid_of_global env ref)
@@ -541,28 +550,28 @@ let global_inductive r =
 (********************************************************************)
 (* Registration of tables as a global table and rollback            *)
 
-type frozen = ccitab * dirtab * mptab * kntab
-    * globrevtab * mprevtab * mptrevtab * knrevtab
+type frozen = ccitab * dirtab * mptab * univtab
+    * globrevtab * mprevtab * mptrevtab * univrevtab
 
 let freeze _ : frozen =
   !the_ccitab,
   !the_dirtab,
   !the_modtypetab,
-  !the_tactictab,
+  !the_univtab,
   !the_globrevtab,
   !the_modrevtab,
   !the_modtyperevtab,
-  !the_tacticrevtab
+  !the_univrevtab
 
-let unfreeze (ccit,dirt,mtyt,tact,globr,modr,mtyr,tacr) =
+let unfreeze (ccit,dirt,mtyt,univt,globr,modr,mtyr,univr) =
   the_ccitab := ccit;
   the_dirtab := dirt;
   the_modtypetab := mtyt;
-  the_tactictab := tact;
+  the_univtab := univt;
   the_globrevtab := globr;
   the_modrevtab := modr;
   the_modtyperevtab := mtyr;
-  the_tacticrevtab := tacr
+  the_univrevtab := univr
 
 let _ =
   Summary.declare_summary "names"
diff --git a/library/nametab.mli b/library/nametab.mli
index 025a63b1c..77fafa100 100644
--- a/library/nametab.mli
+++ b/library/nametab.mli
@@ -74,13 +74,15 @@ val error_global_not_found : ?loc:Loc.t -> qualid -> 'a
 type visibility = Until of int | Exactly of int
 
 val push : visibility -> full_path -> global_reference -> unit
-val push_modtype : visibility -> full_path -> module_path -> unit
+val push_modtype : visibility -> full_path -> ModPath.t -> unit
 val push_dir : visibility -> DirPath.t -> global_dir_reference -> unit
 val push_syndef : visibility -> full_path -> syndef_name -> unit
 
-type ltac_constant = kernel_name
-val push_tactic : visibility -> full_path -> ltac_constant -> unit
+type universe_id = DirPath.t * int
 
+module UnivIdMap : CMap.ExtS with type key = universe_id
+
+val push_universe : visibility -> full_path -> universe_id -> unit
 
 (** {6 The following functions perform globalization of qualified names } *)
 
@@ -89,13 +91,13 @@ val push_tactic : visibility -> full_path -> ltac_constant -> unit
 
 val locate : qualid -> global_reference
 val locate_extended : qualid -> extended_global_reference
-val locate_constant : qualid -> constant
+val locate_constant : qualid -> Constant.t
 val locate_syndef : qualid -> syndef_name
-val locate_modtype : qualid -> module_path
+val locate_modtype : qualid -> ModPath.t
 val locate_dir : qualid -> global_dir_reference
-val locate_module : qualid -> module_path
+val locate_module : qualid -> ModPath.t
 val locate_section : qualid -> DirPath.t
-val locate_tactic : qualid -> ltac_constant
+val locate_universe : qualid -> universe_id
 
 (** These functions globalize user-level references into global
    references, like [locate] and co, but raise a nice error message
@@ -109,9 +111,8 @@ val global_inductive : reference -> inductive
 
 val locate_all : qualid -> global_reference list
 val locate_extended_all : qualid -> extended_global_reference list
-val locate_extended_all_tactic : qualid -> ltac_constant list
 val locate_extended_all_dir : qualid -> global_dir_reference list
-val locate_extended_all_modtype : qualid -> module_path list
+val locate_extended_all_modtype : qualid -> ModPath.t list
 
 (** Mapping a full path to a global reference *)
 
@@ -125,7 +126,7 @@ val exists_modtype : full_path -> bool
 val exists_dir : DirPath.t -> bool
 val exists_section : DirPath.t -> bool (** deprecated synonym of [exists_dir] *)
 val exists_module : DirPath.t -> bool (** deprecated synonym of [exists_dir] *)
-val exists_tactic : full_path -> bool (** deprecated synonym of [exists_dir] *)
+val exists_universe : full_path -> bool
 
 (** {6 These functions locate qualids into full user names } *)
 
@@ -142,9 +143,12 @@ val full_name_module : qualid -> DirPath.t
 
 val path_of_syndef : syndef_name -> full_path
 val path_of_global : global_reference -> full_path
-val dirpath_of_module : module_path -> DirPath.t
-val path_of_modtype : module_path -> full_path
-val path_of_tactic : ltac_constant -> full_path
+val dirpath_of_module : ModPath.t -> DirPath.t
+val path_of_modtype : ModPath.t -> full_path
+
+(** A universe_id might not be registered with a corresponding user name.
+    @raise Not_found if the universe was not introduced by the user. *)
+val path_of_universe : universe_id -> full_path
 
 (** Returns in particular the dirpath or the basename of the full path
    associated to global reference *)
@@ -164,9 +168,9 @@ val pr_global_env : Id.Set.t -> global_reference -> Pp.t
 
 val shortest_qualid_of_global : Id.Set.t -> global_reference -> qualid
 val shortest_qualid_of_syndef : Id.Set.t -> syndef_name -> qualid
-val shortest_qualid_of_modtype : module_path -> qualid
-val shortest_qualid_of_module : module_path -> qualid
-val shortest_qualid_of_tactic : ltac_constant -> qualid
+val shortest_qualid_of_modtype : ModPath.t -> qualid
+val shortest_qualid_of_module : ModPath.t -> qualid
+val shortest_qualid_of_universe : universe_id -> qualid
 
 (** Deprecated synonyms *)
 
diff --git a/library/states.ml b/library/states.ml
index 03e4610a6..27e0a94f9 100644
--- a/library/states.ml
+++ b/library/states.ml
@@ -37,5 +37,3 @@ let with_state_protection f x =
   with reraise ->
     let reraise = CErrors.push reraise in
     (unfreeze st; iraise reraise)
-
-let with_state_protection_on_exception = Future.transactify
diff --git a/library/states.mli b/library/states.mli
index 780a4e8dc..accd0e7ea 100644
--- a/library/states.mli
+++ b/library/states.mli
@@ -30,10 +30,3 @@ val replace_summary : state -> Summary.frozen -> state
 
 val with_state_protection : ('a -> 'b) -> 'a -> 'b
 
-(** [with_state_protection_on_exception f x] applies [f] to [x] and restores the
-  state of the whole system as it was before applying [f] only if an
-  exception is raised.  Unlike [with_state_protection] it also takes into
-  account the proof state *)
-
-val with_state_protection_on_exception : ('a -> 'b) -> 'a -> 'b
-
diff --git a/library/summary.ml b/library/summary.ml
index 69eff830d..6df17476b 100644
--- a/library/summary.ml
+++ b/library/summary.ml
@@ -10,20 +10,25 @@ open Pp
 open CErrors
 open Util
 
-module Dyn = Dyn.Make(struct end)
+module Dyn = Dyn.Make ()
 
 type marshallable = [ `Yes | `No | `Shallow ]
+
 type 'a summary_declaration = {
   freeze_function : marshallable -> 'a;
   unfreeze_function : 'a -> unit;
   init_function : unit -> unit }
 
-let summaries = ref Int.Map.empty
+let sum_mod = ref None
+let sum_map = ref String.Map.empty
 
 let mangle id = id ^ "-SUMMARY"
+let unmangle id = String.(sub id 0 (length id - 8))
+
+let ml_modules = "ML-MODULES"
 
-let internal_declare_summary hash sumname sdecl =
-  let (infun, outfun) = Dyn.Easy.make_dyn (mangle sumname) in
+let internal_declare_summary fadd sumname sdecl =
+  let infun, outfun, tag = Dyn.Easy.make_dyn_tag (mangle sumname) in
   let dyn_freeze b = infun (sdecl.freeze_function b)
   and dyn_unfreeze sum = sdecl.unfreeze_function (outfun sum)
   and dyn_init = sdecl.init_function in
@@ -32,140 +37,116 @@ let internal_declare_summary hash sumname sdecl =
     unfreeze_function = dyn_unfreeze;
     init_function = dyn_init }
   in
-  summaries := Int.Map.add hash (sumname, ddecl) !summaries
+  fadd sumname ddecl;
+  tag
 
-let all_declared_summaries = ref Int.Set.empty
+let declare_ml_modules_summary decl =
+  let ml_add _ ddecl = sum_mod := Some ddecl in
+  internal_declare_summary ml_add ml_modules decl
 
-let summary_names = ref []
-let name_of_summary name =
-  try List.assoc name !summary_names
-  with Not_found -> "summary name not found"
+let declare_ml_modules_summary decl =
+  ignore(declare_ml_modules_summary decl)
 
-let declare_summary sumname decl =
-  let hash = String.hash sumname in
-  let () = if Int.Map.mem hash !summaries then
-    let (name, _) = Int.Map.find hash !summaries in
-    anomaly ~label:"Summary.declare_summary"
-      (str "Colliding summary names: " ++ str sumname ++ str " vs. " ++ str name ++ str ".")
+let declare_summary_tag sumname decl =
+  let fadd name ddecl = sum_map := String.Map.add name ddecl !sum_map in
+  let () = if String.Map.mem sumname !sum_map then
+      anomaly ~label:"Summary.declare_summary"
+        (str "Colliding summary names: " ++ str sumname ++ str " vs. " ++ str sumname ++ str ".")
   in
-  all_declared_summaries := Int.Set.add hash !all_declared_summaries;
-  summary_names := (hash, sumname) :: !summary_names;
-  internal_declare_summary hash sumname decl
+  internal_declare_summary fadd sumname decl
+
+let declare_summary sumname decl =
+  ignore(declare_summary_tag sumname decl)
 
 type frozen = {
-  summaries : (int * Dyn.t) list;
+  summaries : Dyn.t String.Map.t;
   (** Ordered list w.r.t. the first component. *)
   ml_module : Dyn.t option;
   (** Special handling of the ml_module summary. *)
 }
 
-let empty_frozen = { summaries = []; ml_module = None; }
-
-let ml_modules = "ML-MODULES"
-let ml_modules_summary = String.hash ml_modules
+let empty_frozen = { summaries = String.Map.empty; ml_module = None }
 
 let freeze_summaries ~marshallable : frozen =
-  let fold id (_, decl) accu =
-    (* to debug missing Lazy.force
-    if marshallable <> `No then begin
-      let id, _ = Int.Map.find id !summaries in
-      prerr_endline ("begin marshalling " ^ id);
-      ignore(Marshal.to_string (decl.freeze_function marshallable) []);
-      prerr_endline ("end marshalling " ^ id);
-    end;
-    /debug *)
-    let state = decl.freeze_function marshallable in
-    if Int.equal id ml_modules_summary then { accu with ml_module = Some state }
-    else { accu with summaries = (id, state) :: accu.summaries }
+  let smap decl = decl.freeze_function marshallable in
+  { summaries = String.Map.map smap !sum_map;
+    ml_module = Option.map (fun decl -> decl.freeze_function marshallable) !sum_mod;
+  }
+
+let unfreeze_single name state =
+  let decl =
+    try String.Map.find name !sum_map
+    with
+    | Not_found ->
+      CErrors.anomaly Pp.(str "trying to unfreeze unregistered summary " ++ str name)
   in
-  Int.Map.fold_right fold !summaries empty_frozen
-
-let unfreeze_summaries fs =
+  try decl.unfreeze_function state
+  with e when CErrors.noncritical e ->
+    let e = CErrors.push e in
+    Feedback.msg_warning
+      Pp.(seq [str "Error unfreezing summary "; str name; fnl (); CErrors.iprint e]);
+    iraise e
+
+let unfreeze_summaries ?(partial=false) { summaries; ml_module } =
   (* The unfreezing of [ml_modules_summary] has to be anticipated since it
-   * may modify the content of [summaries] ny loading new ML modules *)
-  let (_, decl) =
-    try Int.Map.find ml_modules_summary !summaries
-    with Not_found -> anomaly (str "Undeclared summary " ++ str ml_modules ++ str ".")
-  in
-  let () = match fs.ml_module with
+   * may modify the content of [summaries] by loading new ML modules *)
+  begin match !sum_mod with
   | None -> anomaly (str "Undeclared summary " ++ str ml_modules ++ str ".")
-  | Some state -> decl.unfreeze_function state
-  in
-  let fold id (_, decl) states =
-    if Int.equal id ml_modules_summary then states
-    else match states with
-    | [] ->
-      let () = decl.init_function () in
-      []
-    | (nid, state) :: rstates ->
-      if Int.equal id nid then
-        let () = decl.unfreeze_function state in rstates
-      else
-        let () = decl.init_function () in states
+  | Some decl -> Option.iter (fun state -> decl.unfreeze_function state) ml_module
+  end;
+  (** We must be independent on the order of the map! *)
+  let ufz name decl =
+    try decl.unfreeze_function String.Map.(find name summaries)
+    with Not_found ->
+      if not partial then begin
+        Feedback.msg_warning Pp.(str "Summary was captured out of module scope for entry " ++ str name);
+        decl.init_function ()
+      end;
   in
-  let fold id decl state =
-    try fold id decl state
-    with e when CErrors.noncritical e ->
-      let e = CErrors.push e in
-      Feedback.msg_error
-        Pp.(seq [str "Error unfreezing summary %s\n%s\n%!";
-                 str (name_of_summary id);
-                 CErrors.iprint e]);
-      iraise e
-  in
-  (** We rely on the order of the frozen list, and the order of folding *)
-  ignore (Int.Map.fold_left fold !summaries fs.summaries)
+  (* String.Map.iter unfreeze_single !sum_map *)
+  String.Map.iter ufz !sum_map
 
 let init_summaries () =
-  Int.Map.iter (fun _ (_, decl) -> decl.init_function ()) !summaries
+  String.Map.iter (fun _ decl -> decl.init_function ()) !sum_map
 
 (** For global tables registered statically before the end of coqtop
     launch, the following empty [init_function] could be used. *)
 
 let nop () = ()
 
-(** Selective freeze *)
+(** Summary projection *)
+let project_from_summary { summaries } tag =
+  let id = unmangle (Dyn.repr tag) in
+  let state = String.Map.find id summaries in
+  Option.get (Dyn.Easy.prj state tag)
+
+let modify_summary st tag v =
+  let id = unmangle (Dyn.repr tag) in
+  let summaries = String.Map.set id (Dyn.Easy.inj v tag) st.summaries in
+  {st with summaries}
 
-type frozen_bits = (int * Dyn.t) list
+let remove_from_summary st tag =
+  let id = unmangle (Dyn.repr tag) in
+  let summaries = String.Map.remove id st.summaries in
+  {st with summaries}
+
+(** Selective freeze *)
 
-let ids_of_string_list complement ids =
-  if not complement then List.map String.hash ids
-  else
-    let fold accu id =
-      let id = String.hash id in
-      Int.Set.remove id accu
-    in
-    let ids = List.fold_left fold !all_declared_summaries ids in
-    Int.Set.elements ids
+type frozen_bits = Dyn.t String.Map.t
 
 let freeze_summary ~marshallable ?(complement=false) ids =
-  let ids = ids_of_string_list complement ids in
-  List.map (fun id ->
-    let (_, summary) = Int.Map.find id !summaries in
-    id, summary.freeze_function marshallable)
-  ids
-
-let unfreeze_summary datas =
-  List.iter
-    (fun (id, data) ->
-      let (name, summary) = Int.Map.find id !summaries in
-      try summary.unfreeze_function data
-      with e ->
-        let e = CErrors.push e in
-        prerr_endline ("Exception unfreezing " ^ name);
-        iraise e)
-  datas
+  let sub_map = String.Map.filter (fun id _ -> complement <> List.(mem id ids)) !sum_map in
+  String.Map.map (fun decl -> decl.freeze_function marshallable) sub_map
+
+let unfreeze_summary = String.Map.iter unfreeze_single
 
 let surgery_summary { summaries; ml_module } bits =
-  let summaries = List.map (fun (id, _ as orig) ->
-      try id, List.assoc id bits
-      with Not_found -> orig)
-    summaries in
+  let summaries =
+    String.Map.fold (fun hash state sum -> String.Map.set hash state sum ) summaries bits in
   { summaries; ml_module }
 
 let project_summary { summaries; ml_module } ?(complement=false) ids =
-  let ids = ids_of_string_list complement ids in
-  List.filter (fun (id, _) -> List.mem id ids) summaries
+  String.Map.filter (fun name _ -> complement <> List.(mem name ids)) summaries
 
 let pointer_equal l1 l2 =
   let ptr_equal d1 d2 =
@@ -174,19 +155,22 @@ let pointer_equal l1 l2 =
     match Dyn.eq t1 t2 with
     | None -> false
     | Some Refl -> x1 == x2
-    in
+  in
+  let l1, l2 = String.Map.bindings l1, String.Map.bindings l2 in
   CList.for_all2eq
     (fun (id1,v1) (id2,v2) -> id1 = id2 && ptr_equal v1 v2) l1 l2
 
 (** All-in-one reference declaration + registration *)
 
-let ref ?(freeze=fun _ r -> r) ~name x =
+let ref_tag ?(freeze=fun _ r -> r) ~name x =
   let r = ref x in
-  declare_summary name
+  let tag = declare_summary_tag name
     { freeze_function = (fun b -> freeze b !r);
       unfreeze_function = ((:=) r);
-      init_function = (fun () -> r := x) };
-  r
+      init_function = (fun () -> r := x) } in
+  r, tag
+
+let ref ?freeze ~name x = fst @@ ref_tag ?freeze ~name x
 
 module Local = struct
 
@@ -198,8 +182,7 @@ 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
+    let { init_function } = String.Map.find name !sum_map in
     init_function ();
     CEphemeron.get (fst !r)
 
diff --git a/library/summary.mli b/library/summary.mli
index d093d95f2..09447199e 100644
--- a/library/summary.mli
+++ b/library/summary.mli
@@ -36,6 +36,12 @@ type 'a summary_declaration = {
 
 val declare_summary : string -> 'a summary_declaration -> unit
 
+(** We provide safe projection from the summary to the types stored in
+   it.*)
+module Dyn : Dyn.S
+
+val declare_summary_tag : string -> 'a summary_declaration -> 'a Dyn.tag
+
 (** All-in-one reference declaration + summary registration.
     It behaves just as OCaml's standard [ref] function, except
     that a [declare_summary] is done, with [name] as string.
@@ -43,6 +49,7 @@ val declare_summary : string -> 'a summary_declaration -> unit
     The [freeze_function] can be overridden *)
 
 val ref : ?freeze:(marshallable -> 'a -> 'a) -> name:string -> 'a -> 'a ref
+val ref_tag : ?freeze:(marshallable -> 'a -> 'a) -> name:string -> 'a -> 'a ref * 'a Dyn.tag
 
 (* 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. *)
@@ -55,10 +62,11 @@ module Local : sig
 
 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 *)
-val ml_modules : string
+(** Special summary for 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 properly.
+   *)
+val declare_ml_modules_summary : 'a summary_declaration -> unit
 
 (** For global tables registered statically before the end of coqtop
     launch, the following empty [init_function] could be used. *)
@@ -72,19 +80,34 @@ type frozen
 
 val empty_frozen : frozen
 val freeze_summaries : marshallable:marshallable -> frozen
-val unfreeze_summaries : frozen -> unit
+val unfreeze_summaries : ?partial:bool -> frozen -> unit
 val init_summaries : unit -> unit
 
-(** The type [frozen_bits] is a snapshot of some of the registered tables *)
+(** Typed projection of the summary. Experimental API, use with CARE *)
+
+val modify_summary : frozen -> 'a Dyn.tag -> 'a -> frozen
+val project_from_summary : frozen -> 'a Dyn.tag -> 'a
+val remove_from_summary : frozen -> 'a Dyn.tag -> frozen
+
+(** The type [frozen_bits] is a snapshot of some of the registered
+    tables. It is DEPRECATED in favor of the typed projection
+    version. *)
+
 type frozen_bits
+[@@ocaml.deprecated "Please use the typed version of summary projection"]
 
-val freeze_summary :
-  marshallable:marshallable -> ?complement:bool -> string list -> frozen_bits
+[@@@ocaml.warning "-3"]
+val freeze_summary : marshallable:marshallable -> ?complement:bool -> string list -> frozen_bits
+[@@ocaml.deprecated "Please use the typed version of summary projection"]
 val unfreeze_summary : frozen_bits -> unit
+[@@ocaml.deprecated "Please use the typed version of summary projection"]
 val surgery_summary : frozen -> frozen_bits -> frozen
+[@@ocaml.deprecated "Please use the typed version of summary projection"]
 val project_summary : frozen -> ?complement:bool -> string list -> frozen_bits
+[@@ocaml.deprecated "Please use the typed version of summary projection"]
 val pointer_equal : frozen_bits -> frozen_bits -> bool
+[@@ocaml.deprecated "Please use the typed version of summary projection"]
+[@@@ocaml.warning "+3"]
 
 (** {6 Debug} *)
-
 val dump : unit -> (int * string) list
diff --git a/library/univops.ml b/library/univops.ml
deleted file mode 100644
index 3bafb824d..000000000
--- a/library/univops.ml
+++ /dev/null
@@ -1,40 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Term
-open Univ
-
-let universes_of_constr c =
-  let rec aux s c = 
-    match kind_of_term c with
-    | Const (_, u) | Ind (_, u) | Construct (_, u) ->
-      LSet.fold LSet.add (Instance.levels u) s
-    | Sort u when not (Sorts.is_small u) -> 
-      let u = univ_of_sort u in
-      LSet.fold LSet.add (Universe.levels u) s
-    | _ -> fold_constr aux s c
-  in aux LSet.empty c
-
-let restrict_universe_context (univs,csts) s =
-  (* Universes that are not necessary to typecheck the term.
-     E.g. univs introduced by tactics and not used in the proof term. *)
-  let diff = LSet.diff univs s in
-  let rec aux diff candid univs ness = 
-    let (diff', candid', univs', ness') = 
-      Constraint.fold
-	(fun (l, d, r as c) (diff, candid, univs, csts) ->
-	  if not (LSet.mem l diff) then
-	    (LSet.remove r diff, candid, univs, Constraint.add c csts)
-	  else if not (LSet.mem r diff) then
-	    (LSet.remove l diff, candid, univs, Constraint.add c csts)
-	  else (diff, Constraint.add c candid, univs, csts))
-	candid (diff, Constraint.empty, univs, ness)
-    in
-      if ness' == ness then (LSet.diff univs diff', ness)
-      else aux diff' candid' univs' ness'
-  in aux diff csts univs Constraint.empty
diff --git a/man/coqchk.1 b/man/coqchk.1
index 76a7cfc5d..f9241c0d4 100644
--- a/man/coqchk.1
+++ b/man/coqchk.1
@@ -23,7 +23,7 @@ library was not found, corrupted content, type-checking failure, etc.
 
 .IR modules \&
 is a list of modules to be checked. Modules can be referred to by a
-short or qualified name.
+short or qualified logical name, or by their filename.
 
 .SH OPTIONS
 
@@ -34,13 +34,17 @@ add directory
 in the include path
 
 .TP
-.BI \-R \ dir\ coqdir          
-recursively map physical
+.BI \-Q \ dir\ coqdir
+map physical
 .I dir
 to logical
 .I coqdir
 
 .TP
+.BI \-R \ dir\ coqdir
+synonymous for -Q
+
+.TP
 .BI \-silent
 makes coqchk less verbose.
 
diff --git a/man/coqdep.1 b/man/coqdep.1
index 81f7e1e0d..ed727db7c 100644
--- a/man/coqdep.1
+++ b/man/coqdep.1
@@ -82,7 +82,7 @@ Prints the dependencies of Caml modules.
 \" the standard output. No dependency is computed with this option.
 .TP 
 .BI \-I/\-Q/\-R \ options
-Have the same effects on load path and modules names than for other
+Have the same effects on load path and modules names as for other
 coq commands (coqtop, coqc).
 .TP 
 .BI \-coqlib \ directory
diff --git a/man/coqmktop.1 b/man/coqmktop.1
deleted file mode 100644
index 810df782c..000000000
--- a/man/coqmktop.1
+++ /dev/null
@@ -1,71 +0,0 @@
-.TH COQ 1 "April 25, 2001"
-
-.SH NAME
-coqmktop \- The Coq Proof Assistant user-tactics linker
-
-
-.SH SYNOPSIS
-.B coqmktop
-[
-.I options
-]
-.I files
-
-
-.SH DESCRIPTION
-
-.B coqmktop
-builds a new Coq toplevel extended with user-tactics.
-.IR files \&
-are the Objective Caml object or library files
-(i.e. with suffix .cmo, .cmx, .cma or .cmxa) to link with the Coq system.
-The linker produces an executable Coq toplevel which can be called
-directly or through coqc(1), using the \-image option.
-
-.SH OPTIONS
-
-.TP
-.BI \-h
-Help. List the available options.
-
-.TP
-.BI \-srcdir \ dir
-Specify where the Coq source files are
-
-.TP
-.BI \-o \ exec\-file
-Specify the name of the resulting toplevel
-
-.TP
-.B \-opt
-Compile in native code
-
-.TP
-.B \-full
-Link high level tactics
-
-.TP
-.B \-top
-Build Coq on a ocaml toplevel (incompatible with
-.BR \-opt )
-
-.TP
-.BI \-R \ dir
-Specify recursively directories for Ocaml
-
-.TP
-.B \-v8
-Link with V8 grammar
-
-
-.SH SEE ALSO
-
-.BR coqtop (1),
-.BR ocamlmktop (1).
-.BR ocamlc (1).
-.BR ocamlopt (1).
-.br
-.I
-The Coq Reference Manual.
-.I
-The Coq web site: http://coq.inria.fr
diff --git a/man/coqtop.1 b/man/coqtop.1
index 62d17aa67..b1fbb3262 100644
--- a/man/coqtop.1
+++ b/man/coqtop.1
@@ -140,12 +140,6 @@ dump globalizations in file f (to be used by
 )
 
 .TP
-.BI \-with\-geoproof \ (yes|no)
-to (de)activate special functions for Geoproof within Coqide (default is
-.I yes
-)
-
-.TP
 .B \-impredicative\-set
 set sort Set impredicative
 
diff --git a/parsing/cLexer.ml4 b/parsing/cLexer.ml4
index 636027f9b..52a6fe16c 100644
--- a/parsing/cLexer.ml4
+++ b/parsing/cLexer.ml4
@@ -10,8 +10,19 @@ open Pp
 open Util
 open Tok
 
+(** Location utilities  *)
+let ploc_file_of_coq_file = function
+| Loc.ToplevelInput -> ""
+| Loc.InFile f -> f
+
+let coq_file_of_ploc_file s =
+  if s = "" then Loc.ToplevelInput else Loc.InFile s
+
+let from_coqloc fname line_nb bol_pos bp ep =
+  Ploc.make_loc (ploc_file_of_coq_file fname) line_nb bol_pos (bp, ep) ""
+
 let to_coqloc loc =
-  { Loc.fname = Ploc.file_name loc;
+  { Loc.fname = coq_file_of_ploc_file (Ploc.file_name loc);
     Loc.line_nb = Ploc.line_nb loc;
     Loc.bol_pos = Ploc.bol_pos loc;
     Loc.bp = Ploc.first_pos loc;
@@ -118,14 +129,6 @@ let err loc str = Loc.raise ~loc:(to_coqloc loc) (Error.E str)
 
 let bad_token str = raise (Error.E (Bad_token str))
 
-(** Location utilities  *)
-let file_loc_of_file = function
-| None -> ""
-| Some f -> f
-
-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)
@@ -242,8 +245,8 @@ let check_ident str =
         loop_id true s
     | [< s >] ->
         match unlocated lookup_utf8 Ploc.dummy s with
-        | Utf8Token (Unicode.Letter, n) -> njunk n s; loop_id true s
-        | Utf8Token (Unicode.IdentPart, n) when intail ->
+        | Utf8Token (st, n) when not intail && Unicode.is_valid_ident_initial st -> njunk n s; loop_id true s
+        | Utf8Token (st, n) when intail && Unicode.is_valid_ident_trailing st ->
           njunk n s;
           loop_id true s
         | EmptyStream -> ()
@@ -308,9 +311,9 @@ let rec ident_tail loc len = parser
       ident_tail loc (store len c) s
   | [< s >] ->
       match lookup_utf8 loc s with
-      | Utf8Token ((Unicode.IdentPart | Unicode.Letter), n) ->
+      | Utf8Token (st, n) when Unicode.is_valid_ident_trailing st ->
           ident_tail loc (nstore n len s) s
-      | Utf8Token (Unicode.Unknown, n) ->
+      | Utf8Token (st, n) when Unicode.is_unknown st ->
           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
@@ -369,7 +372,7 @@ let rec string loc ~comm_level bp len = parser
      err loc Unterminated_string
 
 (* To associate locations to a file name *)
-let current_file = ref None
+let current_file = ref Loc.ToplevelInput
 
 (* Utilities for comments in beautify *)
 let comment_begin = ref None
@@ -392,7 +395,7 @@ let rec split_comments comacc acc pos = function
 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
+type lexer_state = int option * string * bool * ((int * int) * string) list * Loc.source
 
 let init_lexer_state f = (None,"",true,[],f)
 let set_lexer_state (o,s,b,c,f) =
@@ -401,10 +404,11 @@ let set_lexer_state (o,s,b,c,f) =
   between_commands := b;
   comments := c;
   current_file := f
-let release_lexer_state () =
+let get_lexer_state () =
   (!comment_begin, Buffer.contents current_comment, !between_commands, !comments, !current_file)
+let release_lexer_state = get_lexer_state
 let drop_lexer_state () =
-    set_lexer_state (init_lexer_state None)
+    set_lexer_state (init_lexer_state Loc.ToplevelInput)
 
 let real_push_char c = Buffer.add_char current_comment c
 
@@ -536,7 +540,7 @@ let parse_after_dot loc c bp =
       (try find_keyword loc ("."^field) s with Not_found -> FIELD field)
   | [< s >] ->
       match lookup_utf8 loc s with
-      | Utf8Token (Unicode.Letter, n) ->
+      | Utf8Token (st, n) when Unicode.is_valid_ident_initial st ->
           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)
@@ -550,7 +554,7 @@ let parse_after_qmark loc bp s =
     | None -> KEYWORD "?"
     | _ ->
         match lookup_utf8 loc s with
-          | Utf8Token (Unicode.Letter, _) -> LEFTQMARK
+          | Utf8Token (st, _) when Unicode.is_valid_ident_initial st -> LEFTQMARK
           | AsciiChar | Utf8Token _ | EmptyStream ->
             fst (process_chars loc bp '?' s)
 
@@ -615,13 +619,13 @@ let rec next_token loc = parser bp
       comment_stop bp; between_commands := new_between_commands; t
   | [< s >] ->
       match lookup_utf8 loc s with
-        | Utf8Token (Unicode.Letter, n) ->
+        | Utf8Token (st, n) when Unicode.is_valid_ident_initial st ->
             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 loc id s with Not_found -> IDENT id), set_loc_pos loc bp ep
-        | AsciiChar | Utf8Token ((Unicode.Symbol | Unicode.IdentPart | Unicode.Unknown), _) ->
+        | AsciiChar | Utf8Token _ ->
             let t = process_chars loc bp (Stream.next s) s in
             comment_stop bp; t
         | EmptyStream ->
@@ -672,7 +676,7 @@ let token_text = function
 
 let func cs =
   let loct = loct_create () in
-  let cur_loc = ref (make_loc !current_file 1 0 0 0) in
+  let cur_loc = ref (from_coqloc !current_file 1 0 0 0) in
   let ts =
     Stream.from
       (fun i ->
diff --git a/parsing/cLexer.mli b/parsing/cLexer.mli
index 77d652b18..5f4e10f14 100644
--- a/parsing/cLexer.mli
+++ b/parsing/cLexer.mli
@@ -49,9 +49,11 @@ end
 (* Mainly for comments state, etc... *)
 type lexer_state
 
-val init_lexer_state : string option -> lexer_state
+val init_lexer_state : Loc.source -> lexer_state
 val set_lexer_state : lexer_state -> unit
+val get_lexer_state : unit -> lexer_state
 val release_lexer_state : unit -> lexer_state
+[@@ocaml.deprecated "Use get_lexer_state"]
 val drop_lexer_state : unit -> unit
 
 (* Retrieve the comments lexed at a given location of the stream
diff --git a/parsing/egramcoq.ml b/parsing/egramcoq.ml
index 870137ca1..cad837d08 100644
--- a/parsing/egramcoq.ml
+++ b/parsing/egramcoq.ml
@@ -21,11 +21,11 @@ open Names
    a reference to the current level (to be translated into "SELF" on the
    left border and into "constr LEVEL n" elsewhere), to the level below
    (to be translated into "NEXT") or to an below wrt associativity (to be
-   translated in camlp4 into "constr" without level) or to another level
+   translated in camlp5 into "constr" without level) or to another level
    (to be translated into "constr LEVEL n")
 
    The boolean is true if the entry was existing _and_ empty; this to
-   circumvent a weakness of camlp4/camlp5 whose undo mechanism is not the
+   circumvent a weakness of camlp5 whose undo mechanism is not the
    converse of the extension mechanism *)
 
 let constr_level = string_of_int
@@ -34,7 +34,8 @@ let default_levels =
   [200,Extend.RightA,false;
    100,Extend.RightA,false;
    99,Extend.RightA,true;
-   10,Extend.RightA,false;
+   90,Extend.RightA,true;
+   10,Extend.LeftA,false;
    9,Extend.RightA,false;
    8,Extend.RightA,true;
    1,Extend.LeftA,false;
@@ -44,8 +45,8 @@ let default_pattern_levels =
   [200,Extend.RightA,true;
    100,Extend.RightA,false;
    99,Extend.RightA,true;
-   11,Extend.LeftA,false;
-   10,Extend.RightA,false;
+   90,Extend.RightA,true;
+   10,Extend.LeftA,false;
    1,Extend.LeftA,false;
    0,Extend.RightA,false]
 
@@ -143,11 +144,11 @@ let find_position accu forpat assoc level =
 
 (**************************************************************************)
 (*
- * --- Note on the mapping of grammar productions to camlp4 actions ---
+ * --- Note on the mapping of grammar productions to camlp5 actions ---
  *
  * Translation of environments: a production
  *   [ nt1(x1) ... nti(xi) ] -> act(x1..xi)
- * is written (with camlp4 conventions):
+ * is written (with camlp5 conventions):
  *   (fun vi -> .... (fun v1 -> act(v1 .. vi) )..)
  * where v1..vi are the values generated by non-terminals nt1..nti.
  * Since the actions are executed by substituting an environment,
@@ -171,8 +172,8 @@ let find_position accu forpat assoc level =
 (**********************************************************************)
 (* Binding constr entry keys to entries                               *)
 
-(* Camlp4 levels do not treat NonA: use RightA with a NEXT on the left *)
-let camlp4_assoc = function
+(* Camlp5 levels do not treat NonA: use RightA with a NEXT on the left *)
+let camlp5_assoc = function
   | Some NonA | Some RightA -> RightA
   | None | Some LeftA -> LeftA
 
@@ -204,7 +205,7 @@ let adjust_level assoc from = function
   (* If NonA on the left-hand side, adopt the current assoc ?? *)
   | (NumLevel n,BorderProd (Left,Some NonA)) -> None
   (* If the expected assoc is the current one, set to SELF *)
-  | (NumLevel n,BorderProd (Left,Some a)) when assoc_eq a (camlp4_assoc assoc) ->
+  | (NumLevel n,BorderProd (Left,Some a)) when assoc_eq a (camlp5_assoc assoc) ->
       None
   (* Otherwise, force the level, n or n-1, according to expected assoc *)
   | (NumLevel n,BorderProd (Left,Some a)) ->
@@ -225,14 +226,14 @@ type _ target =
 type prod_info = production_level * production_position
 
 type (_, _) entry =
-| TTName : ('self, Name.t Loc.located) entry
+| TTName : ('self, Misctypes.lname) entry
 | TTReference : ('self, reference) entry
 | TTBigint : ('self, Constrexpr.raw_natural_number) entry
-| TTBinder : ('self, local_binder_expr list) entry
 | TTConstr : prod_info * 'r target -> ('r, 'r) entry
 | TTConstrList : prod_info * Tok.t list * 'r target -> ('r, 'r list) entry
-| TTBinderListT : ('self, local_binder_expr list) entry
-| TTBinderListF : Tok.t list -> ('self, local_binder_expr list list) entry
+| TTPattern : int -> ('self, cases_pattern_expr) entry
+| TTOpenBinderList : ('self, local_binder_expr list) entry
+| TTClosedBinderList : Tok.t list -> ('self, local_binder_expr list list) entry
 
 type _ any_entry = TTAny : ('s, 'r) entry -> 's any_entry
 
@@ -257,9 +258,11 @@ let is_binder_level from e = match e with
 | (NumLevel 200, (BorderProd (Right, _) | InternalProd)) -> from = 200
 | _ -> false
 
-let make_sep_rules tkl =
-  let rec mkrule : Tok.t list -> unit rules = function
-  | [] -> Rules ({ norec_rule = Stop }, ignore)
+let make_sep_rules = function
+  | [tk] -> Atoken tk
+  | tkl ->
+  let rec mkrule : Tok.t list -> string rules = function
+  | [] -> Rules ({ norec_rule = Stop }, fun _ -> (* dropped anyway: *) "")
   | tkn :: rem ->
     let Rules ({ norec_rule = r }, f) = mkrule rem in
     let r = { norec_rule = Next (r, Atoken tkn) } in
@@ -286,40 +289,34 @@ let symbol_of_entry : type s r. _ -> _ -> (s, r) entry -> (s, r) symbol = fun as
   Alist1 (symbol_of_target typ' assoc from forpat)
 | TTConstrList (typ', tkl, forpat) ->
   Alist1sep (symbol_of_target typ' assoc from forpat, make_sep_rules tkl)
-| TTBinderListF [] -> Alist1 (Aentry Constr.binder)
-| TTBinderListF tkl -> Alist1sep (Aentry Constr.binder, make_sep_rules tkl)
+| TTPattern p -> Aentryl (Constr.pattern, p)
+| TTClosedBinderList [] -> Alist1 (Aentry Constr.binder)
+| TTClosedBinderList tkl -> Alist1sep (Aentry Constr.binder, make_sep_rules tkl)
 | TTName -> Aentry Prim.name
-| TTBinder -> Aentry Constr.binder
-| TTBinderListT -> Aentry Constr.open_binders
+| TTOpenBinderList -> Aentry Constr.open_binders
 | TTBigint -> Aentry Prim.bigint
 | TTReference -> Aentry Constr.global
 
 let interp_entry forpat e = match e with
-| ETName -> TTAny TTName
-| ETReference -> TTAny TTReference
-| ETBigint -> TTAny TTBigint
-| ETBinder true -> anomaly (Pp.str "Should occur only as part of BinderList.")
-| ETBinder false  -> TTAny TTBinder
-| ETConstr p -> TTAny (TTConstr (p, forpat))
-| ETPattern -> assert false (** not used *)
-| ETOther _ -> assert false (** not used *)
-| ETConstrList (p, tkl) -> TTAny (TTConstrList (p, tkl, forpat))
-| ETBinderList (true, []) -> TTAny TTBinderListT
-| ETBinderList (true, _) -> assert false
-| ETBinderList (false, tkl) -> TTAny (TTBinderListF tkl)
-
-let constr_expr_of_name (loc,na) = CAst.make ?loc @@ match na with
-  | Anonymous -> CHole (None,Misctypes.IntroAnonymous,None)
-  | Name id   -> CRef (Ident (Loc.tag ?loc id), None)
-
-let cases_pattern_expr_of_name (loc,na) = CAst.make ?loc @@ match na with
+| ETProdName -> TTAny TTName
+| ETProdReference -> TTAny TTReference
+| ETProdBigint -> TTAny TTBigint
+| ETProdConstr p -> TTAny (TTConstr (p, forpat))
+| ETProdPattern p -> TTAny (TTPattern p)
+| ETProdOther _ -> assert false (** not used *)
+| ETProdConstrList (p, tkl) -> TTAny (TTConstrList (p, tkl, forpat))
+| ETProdBinderList ETBinderOpen -> TTAny TTOpenBinderList
+| ETProdBinderList (ETBinderClosed tkl) -> TTAny (TTClosedBinderList tkl)
+
+let cases_pattern_expr_of_name { CAst.loc; v = na } = CAst.make ?loc @@ match na with
   | Anonymous -> CPatAtom None
   | Name id   -> CPatAtom (Some (Ident (Loc.tag ?loc id)))
 
 type 'r env = {
   constrs : 'r list;
   constrlists : 'r list list;
-  binders : (local_binder_expr list * bool) list;
+  binders : cases_pattern_expr list;
+  binderlists : local_binder_expr list list;
 }
 
 let push_constr subst v = { subst with constrs = v :: subst.constrs }
@@ -329,12 +326,16 @@ match e with
 | TTConstr _ -> push_constr subst v
 | TTName ->
   begin match forpat with
-  | ForConstr -> push_constr subst (constr_expr_of_name v)
+  | ForConstr -> { subst with binders = cases_pattern_expr_of_name v :: subst.binders }
   | ForPattern -> push_constr subst (cases_pattern_expr_of_name v)
   end
-| TTBinder -> { subst with binders = (v, true) :: subst.binders }
-| TTBinderListT -> { subst with binders = (v, true) :: subst.binders }
-| TTBinderListF _ -> { subst with binders = (List.flatten v, false) :: subst.binders }
+| TTPattern _ ->
+  begin match forpat with
+  | ForConstr -> { subst with binders = v :: subst.binders }
+  | ForPattern -> push_constr subst v
+  end
+| TTOpenBinderList -> { subst with binderlists = v :: subst.binderlists }
+| TTClosedBinderList _ -> { subst with binderlists = List.flatten v :: subst.binderlists }
 | TTBigint ->
   begin match forpat with
   | ForConstr ->  push_constr subst (CAst.make @@ CPrim (Numeral (v,true)))
@@ -434,11 +435,9 @@ let rec pure_sublevels : type a b c. int option -> (a, b, c) rule -> int list =
 
 let make_act : type r. r target -> _ -> r gen_eval = function
 | ForConstr -> fun notation loc env ->
-  let env = (env.constrs, env.constrlists, List.map fst env.binders) in
-  CAst.make ~loc @@ CNotation (notation , env)
+  let env = (env.constrs, env.constrlists, env.binders, env.binderlists) in
+  CAst.make ~loc @@ CNotation (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 env = (env.constrs, env.constrlists) in
   CAst.make ~loc @@ CPatNotation (notation, env, [])
 
@@ -454,7 +453,7 @@ let extend_constr state forpat ng =
     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 empty_rules = List.map (prepare_empty_levels isforpat) needed_levels in
-    let empty = { constrs = []; constrlists = []; binders = [] } in
+    let empty = { constrs = []; constrlists = []; binders = []; binderlists = [] } in
     let act = ty_eval r (make_act forpat ng.notgram_notation) empty in
     let rule = (name, p4assoc, [Rule (symbs, act)]) in
     let r = ExtendRule (entry, reinit, (pos, [rule])) in
diff --git a/parsing/egramcoq.mli b/parsing/egramcoq.mli
index 8e0469275..1e3869818 100644
--- a/parsing/egramcoq.mli
+++ b/parsing/egramcoq.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(** Mapping of grammar productions to camlp4 actions *)
+(** Mapping of grammar productions to camlp5 actions *)
 
 (** This is the part specific to Coq-level Notation and Tactic Notation.
     For the ML-level tactic and vernac extensions, see Egramml. *)
diff --git a/parsing/egramml.mli b/parsing/egramml.mli
index 7414773d3..74dd95a20 100644
--- a/parsing/egramml.mli
+++ b/parsing/egramml.mli
@@ -8,7 +8,7 @@
 
 open Vernacexpr
 
-(** Mapping of grammar productions to camlp4 actions. *)
+(** Mapping of grammar productions to camlp5 actions. *)
 
 (** This is the part specific to vernac extensions.
     For the Coq-level Notation and Tactic Notation, see Egramcoq. *)
diff --git a/parsing/g_constr.ml4 b/parsing/g_constr.ml4
index f637e9746..8a1e6d121 100644
--- a/parsing/g_constr.ml4
+++ b/parsing/g_constr.ml4
@@ -36,21 +36,21 @@ let mk_cast = function
     let loc = Loc.merge_opt (constr_loc c) (constr_loc ty)
     in CAst.make ?loc @@ CCast(c, CastConv ty)
 
-let binder_of_name expl (loc,na) =
-  CLocalAssum ([loc, na], Default expl,
+let binder_of_name expl { CAst.loc = loc; v = na } =
+  CLocalAssum ([CAst.make ?loc na], Default expl,
     CAst.make ?loc @@ CHole (Some (Evar_kinds.BinderType na), IntroAnonymous, None))
 
 let binders_of_names l =
   List.map (binder_of_name Explicit) l
 
-let mk_fixb (id,bl,ann,body,(loc,tyc)) =
+let mk_fixb (id,bl,ann,body,(loc,tyc)) : fix_expr =
   let ty = match tyc with
       Some ty -> ty
     | None    -> CAst.make @@ CHole (None, IntroAnonymous, None) in
   (id,ann,bl,ty,body)
 
-let mk_cofixb (id,bl,ann,body,(loc,tyc)) =
-  let _ = Option.map (fun (aloc,_) ->
+let mk_cofixb (id,bl,ann,body,(loc,tyc)) : cofix_expr =
+  let _ = Option.map (fun { CAst.loc = aloc } ->
     CErrors.user_err ?loc:aloc
       ~hdr:"Constr:mk_cofixb"
       (Pp.str"Annotation forbidden in cofix expression.")) (fst ann) in
@@ -61,10 +61,10 @@ let mk_cofixb (id,bl,ann,body,(loc,tyc)) =
 
 let mk_fix(loc,kw,id,dcls) =
   if kw then
-    let fb = List.map mk_fixb dcls in
+    let fb : fix_expr list = List.map mk_fixb dcls in
     CAst.make ~loc @@ CFix(id,fb)
   else
-    let fb = List.map mk_cofixb dcls in
+    let fb : cofix_expr list = List.map mk_cofixb dcls in
     CAst.make ~loc @@ CCoFix(id,fb)
 
 let mk_single_fix (loc,kw,dcl) =
@@ -120,18 +120,18 @@ let name_colon =
               | _ -> err ())
         | _ -> err ())
 
-let aliasvar = function { CAst.loc = loc; CAst.v = CPatAlias (_, id) } -> Some (loc,Name id) | _ -> None
+let aliasvar = function { CAst.v = CPatAlias (_, na) } -> Some na | _ -> None
 
 GEXTEND Gram
-  GLOBAL: binder_constr lconstr constr operconstr universe_level sort global
-  constr_pattern lconstr_pattern Constr.ident
+  GLOBAL: binder_constr lconstr constr operconstr universe_level sort sort_family
+  global constr_pattern lconstr_pattern Constr.ident
   closed_binder open_binders binder binders binders_fixannot
   record_declaration typeclass_constraint pattern appl_arg;
   Constr.ident:
     [ [ id = Prim.ident -> id ] ]
   ;
   Prim.name:
-    [ [ "_" -> Loc.tag ~loc:!@loc Anonymous ] ]
+    [ [ "_" -> CAst.make ~loc:!@loc Anonymous ] ]
   ;
   global:
     [ [ r = Prim.reference -> r ] ]
@@ -149,9 +149,21 @@ GEXTEND Gram
       | "Type"; "@{"; u = universe; "}" -> GType u
       ] ]
   ;
+  sort_family:
+    [ [ "Set"  -> Sorts.InSet
+      | "Prop" -> Sorts.InProp
+      | "Type" -> Sorts.InType
+      ] ]
+  ;
+  universe_expr:
+    [ [ id = global; "+"; n = natural -> Some (id,n)
+      | id = global -> Some (id,0)
+      | "_" -> None
+    ] ]
+  ;
   universe:
-    [ [ IDENT "max"; "("; ids = LIST1 name SEP ","; ")" -> ids
-      | id = name -> [id]
+    [ [ IDENT "max"; "("; ids = LIST1 universe_expr SEP ","; ")" -> ids
+      | u = universe_expr -> [u]
       ] ]
   ;
   lconstr:
@@ -184,8 +196,9 @@ GEXTEND Gram
     | "10" LEFTA
       [ f=operconstr; args=LIST1 appl_arg -> CAst.make ~loc:(!@loc) @@ CApp((None,f),args)
       | "@"; f=global; i = instance; args=LIST0 NEXT -> CAst.make ~loc:!@loc @@ CAppExpl((None,f,i),args)
-      | "@"; (locid,id) = pattern_identref; args=LIST1 identref ->
-          let args = List.map (fun x -> CAst.make @@ CRef (Ident x,None), None) args in
+      | "@"; lid = pattern_identref; args=LIST1 identref ->
+          let { CAst.loc = locid; v = id } = lid in
+          let args = List.map (fun x -> CAst.make @@ CRef (Ident Loc.(tag ?loc:x.CAst.loc x.CAst.v), None), None) args in
           CAst.make ~loc:(!@loc) @@ CApp((None, CAst.make ?loc:locid @@ CPatVar id),args) ]
     | "9"
         [ ".."; c = operconstr LEVEL "0"; ".." ->
@@ -204,9 +217,11 @@ GEXTEND Gram
       | "("; c = operconstr LEVEL "200"; ")" ->
           (match c.CAst.v with
             | CPrim (Numeral (n,true)) ->
-                CAst.make ~loc:(!@loc) @@ CNotation("( _ )",([c],[],[]))
+                CAst.make ~loc:(!@loc) @@ CNotation("( _ )",([c],[],[],[]))
             | _ -> c)
       | "{|"; c = record_declaration; "|}" -> c
+      | "{"; c = binder_constr ; "}" ->
+          CAst.make ~loc:(!@loc) @@ CNotation(("{ _ }"),([c],[],[],[]))
       | "`{"; c = operconstr LEVEL "200"; "}" ->
 	  CAst.make ~loc:(!@loc) @@ CGeneralization (Implicit, None, c)
       | "`("; c = operconstr LEVEL "200"; ")" ->
@@ -242,11 +257,11 @@ GEXTEND Gram
                  Option.map (mkCProdN ?loc:(fst ty) bl) (snd ty), c2)
       | "let"; fx = single_fix; "in"; c = operconstr LEVEL "200" ->
           let fixp = mk_single_fix fx in
-          let (li,id) = match fixp.CAst.v with
+          let { CAst.loc = li; v = id } = match fixp.CAst.v with
               CFix(id,_) -> id
             | CCoFix(id,_) -> id
             | _ -> assert false in
-          CAst.make ~loc:!@loc @@ CLetIn((li,Name id),fixp,None,c)
+          CAst.make ~loc:!@loc @@ CLetIn( CAst.make ?loc:li @@ Name id,fixp,None,c)
       | "let"; lb = ["("; l=LIST0 name SEP ","; ")" -> l | "()" -> []];
 	  po = return_type;
 	  ":="; c1 = operconstr LEVEL "200"; "in";
@@ -255,17 +270,17 @@ GEXTEND Gram
       | "let"; "'"; p=pattern; ":="; c1 = operconstr LEVEL "200";
           "in"; c2 = operconstr LEVEL "200" ->
 	    CAst.make ~loc:!@loc @@
-            CCases (LetPatternStyle, None,    [c1, None, None],       [Loc.tag ~loc:!@loc ([(Loc.tag ~loc:!@loc [p])], c2)])
+            CCases (LetPatternStyle, None,    [c1, None, None],       [CAst.make ~loc:!@loc ([[p]], c2)])
       | "let"; "'"; p=pattern; ":="; c1 = operconstr LEVEL "200";
 	  rt = case_type; "in"; c2 = operconstr LEVEL "200" ->
 	    CAst.make ~loc:!@loc @@
-            CCases (LetPatternStyle, Some rt, [c1, aliasvar p, None], [Loc.tag ~loc:!@loc ([(Loc.tag ~loc:!@loc [p])], c2)])
+            CCases (LetPatternStyle, Some rt, [c1, aliasvar p, None], [CAst.make ~loc:!@loc ([[p]], c2)])
 
       | "let"; "'"; p=pattern; "in"; t = pattern LEVEL "200";
 	  ":="; c1 = operconstr LEVEL "200"; rt = case_type;
           "in"; c2 = operconstr LEVEL "200" ->
 	    CAst.make ~loc:!@loc @@
-            CCases (LetPatternStyle, Some rt, [c1, aliasvar p, Some t], [Loc.tag ~loc:!@loc ([(Loc.tag ~loc:!@loc [p])], c2)])
+            CCases (LetPatternStyle, Some rt, [c1, aliasvar p, Some t], [CAst.make ~loc:!@loc ([[p]], c2)])
       | "if"; c=operconstr LEVEL "200"; po = return_type;
 	"then"; b1=operconstr LEVEL "200";
         "else"; b2=operconstr LEVEL "200" ->
@@ -274,7 +289,7 @@ GEXTEND Gram
   ;
   appl_arg:
     [ [ id = lpar_id_coloneq; c=lconstr; ")" ->
-	  (c,Some (Loc.tag ~loc:!@loc @@ ExplByName id))
+          (c,Some (CAst.make ~loc:!@loc @@ ExplByName id))
       | c=operconstr LEVEL "9" -> (c,None) ] ]
   ;
   atomic_constr:
@@ -295,14 +310,15 @@ GEXTEND Gram
       | -> [] ] ]
   ;
   instance:
-    [ [ "@{"; l = LIST1 universe_level; "}" -> Some l
+    [ [ "@{"; l = LIST0 universe_level; "}" -> Some l
       | -> None ] ]
   ;
   universe_level:
     [ [ "Set" -> GSet
       | "Prop" -> GProp
-      | "Type" -> GType None
-      | id = name -> GType (Some id)
+      | "Type" -> GType UUnknown
+      | "_" -> GType UAnonymous
+      | id = global -> GType (UNamed id)
       ] ]
   ;
   fix_constr:
@@ -349,11 +365,11 @@ GEXTEND Gram
     [ [ OPT"|"; br=LIST0 eqn SEP "|" -> br ] ]
   ;
   mult_pattern:
-    [ [ pl = LIST1 pattern LEVEL "99" SEP "," -> (Loc.tag ~loc:!@loc pl) ] ]
+    [ [ pl = LIST1 pattern LEVEL "99" SEP "," -> pl ] ]
   ;
   eqn:
     [ [ pll = LIST1 mult_pattern SEP "|";
-        "=>"; rhs = lconstr -> (Loc.tag ~loc:!@loc (pll,rhs)) ] ]
+        "=>"; rhs = lconstr -> (CAst.make ~loc:!@loc (pll,rhs)) ] ]
   ;
   record_pattern:
     [ [ id = global; ":="; pat = pattern -> (id, pat) ] ]
@@ -370,22 +386,12 @@ GEXTEND Gram
     | "100" RIGHTA
       [ p = pattern; "|"; pl = LIST1 pattern SEP "|" -> CAst.make ~loc:!@loc @@ CPatOr (p::pl) ]
     | "99" RIGHTA [ ]
-    | "11" LEFTA
-      [ p = pattern; "as"; id = ident ->
-        CAst.make ~loc:!@loc @@ CPatAlias (p, id) ]
-    | "10" RIGHTA
-      [ p = pattern; lp = LIST1 NEXT ->
-        (let open CAst in match p with
-	  | { v = CPatAtom (Some r) } -> CAst.make ~loc:!@loc @@ CPatCstr (r, None, lp)
-	  | { v = CPatCstr (r, None, l2); loc } ->
-                 CErrors.user_err ?loc ~hdr:"compound_pattern"
-                 (Pp.str "Nested applications not supported.")
-	  | { v = CPatCstr (r, l1, l2) }  -> CAst.make ~loc:!@loc @@ CPatCstr (r, l1 , l2@lp)
-	  | { v = CPatNotation (n, s, l) } -> CAst.make ~loc:!@loc @@ CPatNotation (n , s, l@lp)
-          | _ -> 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 ->
+    | "90" RIGHTA [ ]
+    | "10" LEFTA
+      [ p = pattern; "as"; na = name ->
+        CAst.make ~loc:!@loc @@ CPatAlias (p, na)
+      | p = pattern; lp = LIST1 NEXT -> mkAppPattern ~loc:!@loc p lp
+      | "@"; r = Prim.reference; lp = LIST0 NEXT ->
         CAst.make ~loc:!@loc @@ CPatCstr (r, Some lp, []) ]
     | "1" LEFTA
       [ c = pattern; "%"; key=IDENT -> CAst.make ~loc:!@loc @@ CPatDelimiters (key,c) ]
@@ -415,7 +421,8 @@ GEXTEND Gram
         (fun na -> CLocalAssum (na::nal,Default Implicit,c))
     | nal=LIST1 name; "}" ->
         (fun na -> CLocalAssum (na::nal,Default Implicit,
-                                CAst.make ?loc:(Loc.merge_opt (fst na) (Some !@loc)) @@ CHole (Some (Evar_kinds.BinderType (snd na)), IntroAnonymous, None)))
+                                CAst.make ?loc:(Loc.merge_opt na.CAst.loc (Some !@loc)) @@
+                                CHole (Some (Evar_kinds.BinderType na.CAst.v), IntroAnonymous, None)))
     | ":"; c=lconstr; "}" ->
 	(fun na -> CLocalAssum ([na],Default Implicit,c))
     ] ]
@@ -428,7 +435,7 @@ GEXTEND Gram
     ] ]
   ;
   impl_name_head:
-    [ [ id = impl_ident_head -> (Loc.tag ~loc:!@loc @@ Name id) ] ]
+    [ [ id = impl_ident_head -> (CAst.make ~loc:!@loc @@ Name id) ] ]
   ;
   binders_fixannot:
     [ [ na = impl_name_head; assum = impl_ident_tail; bl = binders_fixannot ->
@@ -448,7 +455,7 @@ GEXTEND Gram
       | id = name; idl = LIST0 name; bl = binders ->
           binders_of_names (id::idl) @ bl
       | id1 = name; ".."; id2 = name ->
-          [CLocalAssum ([id1;(Loc.tag ~loc:!@loc (Name ldots_var));id2],
+          [CLocalAssum ([id1;(CAst.make ~loc:!@loc (Name ldots_var));id2],
 	                  Default Explicit, CAst.make ~loc:!@loc @@ CHole (None, IntroAnonymous, None))]
       | bl = closed_binder; bl' = binders ->
 	  bl@bl'
@@ -490,17 +497,17 @@ GEXTEND Gram
             | CPatCast (p, ty) -> (p, Some ty)
             | _ -> (p, None)
           in
-          [CLocalPattern (Loc.tag ~loc:!@loc (p, ty))]
+          [CLocalPattern (CAst.make ~loc:!@loc (p, ty))]
     ] ]
   ;
   typeclass_constraint:
-    [ [ "!" ; c = operconstr LEVEL "200" -> (Loc.tag ~loc:!@loc Anonymous), true, c
+    [ [ "!" ; c = operconstr LEVEL "200" -> (CAst.make ~loc:!@loc Anonymous), true, c
       | "{"; id = name; "}"; ":" ; expl = [ "!" -> true | -> false ] ; c = operconstr LEVEL "200" ->
 	  id, expl, c
       | iid=name_colon ; expl = [ "!" -> true | -> false ] ; c = operconstr LEVEL "200" ->
-	  (Loc.tag ~loc:!@loc iid), expl, c
+          (CAst.make ~loc:!@loc iid), expl, c
       | c = operconstr LEVEL "200" ->
-	  (Loc.tag ~loc:!@loc Anonymous), false, c
+          (CAst.make ~loc:!@loc Anonymous), false, c
     ] ]
   ;
 
diff --git a/parsing/g_prim.ml4 b/parsing/g_prim.ml4
index 891c232ee..0b7efe739 100644
--- a/parsing/g_prim.ml4
+++ b/parsing/g_prim.ml4
@@ -43,13 +43,13 @@ GEXTEND Gram
     [ [ LEFTQMARK; id = ident -> id ] ]
   ;
   pattern_identref:
-    [ [ id = pattern_ident -> Loc.tag ~loc:!@loc id ] ]
+    [ [ id = pattern_ident -> CAst.make ~loc:!@loc id ] ]
   ;
   var: (* as identref, but interpret as a term identifier in ltac *)
-    [ [ id = ident -> Loc.tag ~loc:!@loc id ] ]
+    [ [ id = ident -> CAst.make ~loc:!@loc id ] ]
   ;
   identref:
-    [ [ id = ident -> Loc.tag ~loc:!@loc id ] ]
+    [ [ id = ident -> CAst.make ~loc:!@loc id ] ]
   ;
   field:
     [ [ s = FIELD -> Id.of_string s ] ]
@@ -70,8 +70,8 @@ GEXTEND Gram
       ] ]
   ;
   name:
-    [ [ IDENT "_"  -> Loc.tag ~loc:!@loc Anonymous
-      | id = ident -> Loc.tag ~loc:!@loc @@ Name id ] ]
+    [ [ IDENT "_"  -> CAst.make ~loc:!@loc Anonymous
+      | id = ident -> CAst.make ~loc:!@loc @@ Name id ] ]
   ;
   reference:
     [ [ id = ident; (l,id') = fields ->
@@ -95,7 +95,7 @@ GEXTEND Gram
     ] ]
   ;
   ne_lstring:
-    [ [ s = ne_string -> Loc.tag ~loc:!@loc s ] ]
+    [ [ s = ne_string -> CAst.make ~loc:!@loc s ] ]
   ;
   dirpath:
     [ [ id = ident; l = LIST0 field ->
@@ -105,7 +105,7 @@ GEXTEND Gram
     [ [ s = STRING -> s ] ]
   ;
   lstring:
-    [ [ s = string -> (Loc.tag ~loc:!@loc s) ] ]
+    [ [ s = string -> (CAst.make ~loc:!@loc s) ] ]
   ;
   integer:
     [ [ i = INT      -> my_int_of_string (!@loc) i
diff --git a/parsing/g_proofs.ml4 b/parsing/g_proofs.ml4
index 42b5bfa93..482373150 100644
--- a/parsing/g_proofs.ml4
+++ b/parsing/g_proofs.ml4
@@ -17,12 +17,6 @@ open Pcoq.Vernac_
 
 let thm_token = G_vernac.thm_token
 
-let hint_proof_using e = function
-  | Some _ as x -> x
-  | None -> match Proof_using.get_default_proof_using () with
-     | None -> None
-     | Some s -> Some (Gram.entry_parse e (Gram.parsable (Stream.of_string s)))
-
 let hint = Gram.entry_create "hint"
 
 (* Proof commands *)
@@ -34,9 +28,9 @@ GEXTEND Gram
     | ":"; l = LIST1 [id = IDENT -> id ] -> l ] ]
   ;
   command:
-    [ [ IDENT "Goal"; c = lconstr -> VernacGoal c
-      | IDENT "Proof" ->
-          VernacProof (None,hint_proof_using G_vernac.section_subset_expr None)
+    [ [ IDENT "Goal"; c = lconstr ->
+        VernacDefinition (Decl_kinds.(NoDischarge, Definition), ((CAst.make ~loc:!@loc Names.Anonymous), None), ProveBody ([], c))
+      | IDENT "Proof" -> VernacProof (None,None)
       | IDENT "Proof" ; IDENT "Mode" ; mn = string -> VernacProofMode mn
       | IDENT "Proof"; c = lconstr -> VernacExactProof c
       | IDENT "Abort" -> VernacAbort None
@@ -45,11 +39,9 @@ GEXTEND Gram
       | IDENT "Existential"; n = natural; c = constr_body ->
 	  VernacSolveExistential (n,c)
       | IDENT "Admitted" -> VernacEndProof Admitted
-      | IDENT "Qed" -> VernacEndProof (Proved (Opaque None,None))
-      | IDENT "Qed"; IDENT "exporting"; l = LIST0 identref SEP "," ->
-          VernacEndProof (Proved (Opaque (Some l),None))
+      | IDENT "Qed" -> VernacEndProof (Proved (Opaque,None))
       | IDENT "Save"; id = identref ->
-	  VernacEndProof (Proved (Opaque None, Some id))
+	  VernacEndProof (Proved (Opaque, Some id))
       | IDENT "Defined" -> VernacEndProof (Proved (Transparent,None))
       |	IDENT "Defined"; id=identref ->
 	  VernacEndProof (Proved (Transparent,Some id))
@@ -79,19 +71,16 @@ GEXTEND Gram
 	    VernacCreateHintDb (id, b)
       | IDENT "Remove"; IDENT "Hints"; ids = LIST1 global; dbnames = opt_hintbases ->
 	  VernacRemoveHints (dbnames, ids)
-      | IDENT "Hint"; local = obsolete_locality; h = hint;
+      | IDENT "Hint"; h = hint;
 	  dbnames = opt_hintbases ->
-	  VernacHints (local,dbnames, h)
+          VernacHints (dbnames, h)
       (* Declare "Resolve" explicitly so as to be able to later extend with
          "Resolve ->" and "Resolve <-" *)
       | IDENT "Hint"; IDENT "Resolve"; lc = LIST1 reference_or_constr; 
 	info = hint_info; dbnames = opt_hintbases ->
-	  VernacHints (false,dbnames,
+          VernacHints (dbnames,
 	    HintsResolve (List.map (fun x -> (info, true, x)) lc))
       ] ];
-  obsolete_locality:
-    [ [ IDENT "Local" -> true | -> false ] ]
-  ;
   reference_or_constr:
    [ [ r = global -> HintsReference r
      | c = constr -> HintsConstr c ] ]
diff --git a/parsing/g_vernac.ml4 b/parsing/g_vernac.ml4
index 560a9a757..93e534e0b 100644
--- a/parsing/g_vernac.ml4
+++ b/parsing/g_vernac.ml4
@@ -15,8 +15,9 @@ open Constrexpr_ops
 open Extend
 open Vernacexpr
 open Decl_kinds
+open Declarations
 open Misctypes
-open Tok (* necessary for camlp4 *)
+open Tok (* necessary for camlp5 *)
 
 open Pcoq
 open Pcoq.Prim
@@ -64,58 +65,43 @@ let parse_compat_version ?(allow_old = true) = let open Flags in function
     CErrors.user_err ~hdr:"get_compat_version"
       Pp.(str "Unknown compatibility version \"" ++ str s ++ str "\".")
 
-let extraction_err ~loc =
-  if not (Mltop.module_is_known "extraction_plugin") then
-    CErrors.user_err ~loc (str "Please do first a Require Extraction.")
-  else
-    (* The right grammar entries should have been loaded.
-       We could only end here in case of syntax error. *)
-    raise (Stream.Error "unexpected end of command")
-
-let funind_err ~loc =
-  if not (Mltop.module_is_known "recdef_plugin") then
-    CErrors.user_err ~loc (str "Please do first a Require Import FunInd.")
-  else
-    raise (Stream.Error "unexpected end of command") (* Same as above... *)
-
 GEXTEND Gram
-  GLOBAL: vernac gallina_ext noedit_mode subprf;
-  vernac: FIRST
-    [ [ IDENT "Time"; c = located_vernac -> VernacTime c
+  GLOBAL: vernac_control gallina_ext noedit_mode subprf;
+  vernac_control: FIRST
+    [ [ IDENT "Time"; c = located_vernac -> VernacTime (false,c)
       | IDENT "Redirect"; s = ne_string; c = located_vernac -> VernacRedirect (s, c)
-      | IDENT "Timeout"; n = natural; v = vernac -> VernacTimeout(n,v)
-      | IDENT "Fail"; v = vernac -> VernacFail v
-
-      | IDENT "Local"; v = vernac_poly -> VernacLocal (true, v)
-      | IDENT "Global"; v = vernac_poly -> VernacLocal (false, v)
-
-      (* Stm backdoor *)
-      | IDENT "Stm"; IDENT "JoinDocument"; "." -> VernacStm JoinDocument
-      | IDENT "Stm"; IDENT "Wait"; "." -> VernacStm Wait
+      | IDENT "Timeout"; n = natural; v = vernac_control -> VernacTimeout(n,v)
+      | IDENT "Fail"; v = vernac_control -> VernacFail v
+      | (f, v) = vernac -> VernacExpr(f, v) ]
+    ]
+  ;
+  vernac:
+    [ [ IDENT "Local"; (f, v) = vernac_poly -> (VernacLocal true :: f, v)
+      | IDENT "Global"; (f, v) = vernac_poly -> (VernacLocal false :: f, v)
 
       | v = vernac_poly -> v ]
     ]
   ;
   vernac_poly:
-    [ [ IDENT "Polymorphic"; v = vernac_aux -> VernacPolymorphic (true, v)
-      | IDENT "Monomorphic"; v = vernac_aux -> VernacPolymorphic (false, v)
+    [ [ IDENT "Polymorphic"; (f, v) = vernac_aux -> (VernacPolymorphic true :: f, v)
+      | IDENT "Monomorphic"; (f, v) = vernac_aux -> (VernacPolymorphic false :: f, v)
       | v = vernac_aux -> v ]
     ]
   ;
   vernac_aux:
     (* Better to parse "." here: in case of failure (e.g. in coerce_to_var), *)
     (* "." is still in the stream and discard_to_dot works correctly         *)
-    [ [ IDENT "Program"; g = gallina; "." -> VernacProgram g
-      | IDENT "Program"; g = gallina_ext; "." -> VernacProgram g
-      | g = gallina; "." -> g
-      | g = gallina_ext; "." -> g
-      | c = command; "." -> c
-      | c = syntax; "." -> c
-      | c = subprf -> c
+    [ [ IDENT "Program"; g = gallina; "." -> ([VernacProgram], g)
+      | IDENT "Program"; g = gallina_ext; "." -> ([VernacProgram], g)
+      | g = gallina; "." -> ([], g)
+      | g = gallina_ext; "." -> ([], g)
+      | c = command; "." -> ([], c)
+      | c = syntax; "." -> ([], c)
+      | c = subprf -> ([], c)
     ] ]
   ;
   vernac_aux: LAST
-    [ [ prfcom = command_entry -> prfcom ] ]
+    [ [ prfcom = command_entry -> ([], prfcom) ] ]
   ;
   noedit_mode:
     [ [ c = query_command -> c None] ]
@@ -129,7 +115,7 @@ GEXTEND Gram
   ;
 
   located_vernac:
-    [ [ v = vernac -> Loc.tag ~loc:!@loc v ] ]
+    [ [ v = vernac_control -> CAst.make ~loc:!@loc v ] ]
   ;
 END
 
@@ -147,33 +133,33 @@ let test_plural_form_types loc kwd = function
      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 lname_of_lident : lident -> lname =
+  CAst.map (fun s -> Name s)
 
-let _ = Hook.set Constrexpr_ops.fresh_var_hook fresh_var
+let name_of_ident_decl : ident_decl -> name_decl =
+  on_fst lname_of_lident
 
 (* Gallina declarations *)
 GEXTEND Gram
   GLOBAL: gallina gallina_ext thm_token def_body of_type_with_opt_coercion
-    record_field decl_notation rec_definition pidentref;
+    record_field decl_notation rec_definition ident_decl;
 
   gallina:
       (* Definition, Theorem, Variable, Axiom, ... *)
-    [ [ thm = thm_token; id = pidentref; bl = binders; ":"; c = lconstr;
+    [ [ thm = thm_token; id = ident_decl; bl = binders; ":"; c = lconstr;
         l = LIST0
-          [ "with"; id = pidentref; bl = binders; ":"; c = lconstr ->
-          (Some id,(bl,c)) ] ->
-          VernacStartTheoremProof (thm, (Some id,(bl,c))::l)
+          [ "with"; id = ident_decl; bl = binders; ":"; c = lconstr ->
+          (id,(bl,c)) ] ->
+          VernacStartTheoremProof (thm, (id,(bl,c))::l)
       | stre = assumption_token; nl = inline; bl = assum_list ->
 	  VernacAssumption (stre, nl, 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)
+      | d = def_token; id = ident_decl; b = def_body ->
+          VernacDefinition (d, name_of_ident_decl id, b)
       | IDENT "Let"; id = identref; b = def_body ->
-          VernacDefinition ((Some Discharge, Definition), (id, None), b)
+          VernacDefinition ((DoDischarge, Let), (lname_of_lident id, None), b)
       (* Gallina inductive declarations *)
       | cum = cumulativity_token; priv = private_token; f = finite_token;
         indl = LIST1 inductive_definition SEP "with" ->
@@ -191,13 +177,13 @@ GEXTEND Gram
 	  in
           VernacInductive (cum, priv,f,indl)
       | "Fixpoint"; recs = LIST1 rec_definition SEP "with" ->
-          VernacFixpoint (None, recs)
+          VernacFixpoint (NoDischarge, recs)
       | IDENT "Let"; "Fixpoint"; recs = LIST1 rec_definition SEP "with" ->
-          VernacFixpoint (Some Discharge, recs)
+          VernacFixpoint (DoDischarge, recs)
       | "CoFixpoint"; corecs = LIST1 corec_definition SEP "with" ->
-          VernacCoFixpoint (None, corecs)
+          VernacCoFixpoint (NoDischarge, corecs)
       | IDENT "Let"; "CoFixpoint"; corecs = LIST1 corec_definition SEP "with" ->
-          VernacCoFixpoint (Some Discharge, corecs)
+          VernacCoFixpoint (DoDischarge, corecs)
       | IDENT "Scheme"; l = LIST1 scheme SEP "with" -> VernacScheme l
       | IDENT "Combined"; IDENT "Scheme"; id = identref; IDENT "from";
 	      l = LIST1 identref SEP "," -> VernacCombinedScheme (id, l)
@@ -219,36 +205,49 @@ GEXTEND Gram
       | IDENT "Property" -> Property ] ]
   ;
   def_token:
-    [ [ "Definition" -> (None, Definition)
-      | IDENT "Example" -> (None, Example)
-      | IDENT "SubClass" -> (None, SubClass) ] ]
+    [ [ "Definition" -> (NoDischarge,Definition)
+      | IDENT "Example" -> (NoDischarge,Example)
+      | IDENT "SubClass" -> (NoDischarge,SubClass) ] ]
   ;
   assumption_token:
-    [ [ "Hypothesis" -> (Some Discharge, Logical)
-      | "Variable" -> (Some Discharge, Definitional)
-      | "Axiom" -> (None, Logical)
-      | "Parameter" -> (None, Definitional)
-      | IDENT "Conjecture" -> (None, Conjectural) ] ]
+    [ [ "Hypothesis" -> (DoDischarge, Logical)
+      | "Variable" -> (DoDischarge, Definitional)
+      | "Axiom" -> (NoDischarge, Logical)
+      | "Parameter" -> (NoDischarge, Definitional)
+      | IDENT "Conjecture" -> (NoDischarge, Conjectural) ] ]
   ;
   assumptions_token:
-    [ [ 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)) ] ]
+    [ [ IDENT "Hypotheses" -> ("Hypotheses", (DoDischarge, Logical))
+      | IDENT "Variables" -> ("Variables", (DoDischarge, Definitional))
+      | IDENT "Axioms" -> ("Axioms", (NoDischarge, Logical))
+      | IDENT "Parameters" -> ("Parameters", (NoDischarge, Definitional))
+      | IDENT "Conjectures" -> ("Conjectures", (NoDischarge, Conjectural)) ] ]
   ;
   inline:
     [ [ IDENT "Inline"; "("; i = INT; ")" -> InlineAt (int_of_string i)
       | IDENT "Inline" -> DefaultInline
       | -> NoInline] ]
   ;
-  pidentref:
-    [ [ i = identref; l = OPT [ "@{" ; l = LIST0 identref; "}" -> l ] -> (i,l) ] ]
-  ;
   univ_constraint:
     [ [ l = universe_level; ord = [ "<" -> Univ.Lt | "=" -> Univ.Eq | "<=" -> Univ.Le ];
 	r = universe_level -> (l, ord, r) ] ]
   ;
+  univ_decl :
+    [ [  "@{" ; l = LIST0 identref; ext = [ "+" -> true | -> false ];
+         cs = [ "|"; l' = LIST0 univ_constraint SEP ",";
+                ext = [ "+" -> true | -> false ]; "}" -> (l',ext)
+              | ext = [ "}" -> true | "|}" -> false ] -> ([], ext) ]
+         ->
+         { univdecl_instance = l;
+           univdecl_extensible_instance = ext;
+           univdecl_constraints = fst cs;
+           univdecl_extensible_constraints = snd cs }
+    ] ]
+  ;
+  ident_decl:
+    [ [ i = identref; l = OPT univ_decl -> (i, l)
+  ] ]
+  ;
   finite_token:
     [ [ IDENT "Inductive" -> (Inductive_kw,Finite)
       | IDENT "CoInductive" -> (CoInductive,CoFinite)
@@ -306,7 +305,7 @@ GEXTEND Gram
       | -> RecordDecl (None, []) ] ]
   ;
   inductive_definition:
-    [ [ oc = opt_coercion; id = pidentref; indpar = binders;
+    [ [ oc = opt_coercion; id = ident_decl; indpar = binders;
         c = OPT [ ":"; c = lconstr -> c ];
         lc=opt_constructors_or_fields; ntn = decl_notation ->
 	   (((oc,id),indpar,c,lc),ntn) ] ]
@@ -332,14 +331,14 @@ GEXTEND Gram
   ;
   (* (co)-fixpoints *)
   rec_definition:
-    [ [ id = pidentref;
+    [ [ id = ident_decl;
 	bl = binders_fixannot;
         ty = type_cstr;
 	def = OPT [":="; def = lconstr -> def]; ntn = decl_notation ->
 	  let bl, annot = bl in ((id,annot,bl,ty,def),ntn) ] ]
   ;
   corec_definition:
-    [ [ id = pidentref; bl = binders; ty = type_cstr;
+    [ [ id = ident_decl; bl = binders; ty = type_cstr;
         def = OPT [":="; def = lconstr -> def]; ntn = decl_notation ->
           ((id,bl,ty,def),ntn) ] ]
   ;
@@ -354,13 +353,13 @@ GEXTEND Gram
   ;
   scheme_kind:
     [ [ IDENT "Induction"; "for"; ind = smart_global;
-          IDENT "Sort"; s = sort-> InductionScheme(true,ind,s)
+          IDENT "Sort"; s = sort_family-> InductionScheme(true,ind,s)
       | IDENT "Minimality"; "for"; ind = smart_global;
-          IDENT "Sort"; s = sort-> InductionScheme(false,ind,s)
+          IDENT "Sort"; s = sort_family-> InductionScheme(false,ind,s)
       | IDENT "Elimination"; "for"; ind = smart_global;
-          IDENT "Sort"; s = sort-> CaseScheme(true,ind,s)
+          IDENT "Sort"; s = sort_family-> CaseScheme(true,ind,s)
       | IDENT "Case"; "for"; ind = smart_global;
-          IDENT "Sort"; s = sort-> CaseScheme(false,ind,s)
+          IDENT "Sort"; s = sort_family-> CaseScheme(false,ind,s)
       | IDENT "Equality"; "for" ; ind = smart_global -> EqualityScheme(ind) ] ]
   ;
   (* Various Binders *)
@@ -411,7 +410,7 @@ GEXTEND Gram
     [ [ "("; a = simple_assum_coe; ")" -> a ] ]
   ;
   simple_assum_coe:
-    [ [ idl = LIST1 pidentref; oc = of_type_with_opt_coercion; c = lconstr ->
+    [ [ idl = LIST1 ident_decl; oc = of_type_with_opt_coercion; c = lconstr ->
         (not (Option.is_empty oc),(idl,c)) ] ]
   ;
 
@@ -582,8 +581,8 @@ GEXTEND Gram
   starredidentref:
     [ [ i = identref -> SsSingl i
       | i = identref; "*" -> SsFwdClose(SsSingl i)
-      | "Type" -> SsSingl (Loc.tag ~loc:!@loc @@ Id.of_string "Type")
-      | "Type"; "*" -> SsFwdClose (SsSingl (Loc.tag ~loc:!@loc @@ Id.of_string "Type")) ]]
+      | "Type" -> SsType
+      | "Type"; "*" -> SsFwdClose SsType ]]
   ;
   ssexpr:
     [ "35" 
@@ -628,37 +627,23 @@ GEXTEND Gram
 	  VernacCanonical (AN qid)
       | IDENT "Canonical"; IDENT "Structure"; ntn = by_notation ->
 	  VernacCanonical (ByNotation ntn)
-      | IDENT "Canonical"; IDENT "Structure"; qid = global;
-          d = def_body ->
+      | IDENT "Canonical"; IDENT "Structure"; qid = global; d = def_body ->
           let s = coerce_reference_to_id qid in
-	  VernacDefinition
-	    ((Some Global,CanonicalStructure),((Loc.tag s),None),d)
+          VernacDefinition ((NoDischarge,CanonicalStructure),((CAst.make (Name s)),None),d)
 
       (* Coercions *)
       | IDENT "Coercion"; qid = global; d = def_body ->
           let s = coerce_reference_to_id qid in
-	  VernacDefinition ((None,Coercion),((Loc.tag s),None),d)
-      | IDENT "Coercion"; IDENT "Local"; qid = global; d = def_body ->
-           let s = coerce_reference_to_id qid in
-	  VernacDefinition ((Some Decl_kinds.Local,Coercion),((Loc.tag s),None),d)
-      | IDENT "Identity"; IDENT "Coercion"; IDENT "Local"; f = identref;
-         ":"; s = class_rawexpr; ">->"; t = class_rawexpr ->
-	   VernacIdentityCoercion (true, f, s, t)
+          VernacDefinition ((NoDischarge,Coercion),((CAst.make (Name s)),None),d)
       | IDENT "Identity"; IDENT "Coercion"; f = identref; ":";
          s = class_rawexpr; ">->"; t = class_rawexpr ->
-	   VernacIdentityCoercion (false, f, s, t)
-      | IDENT "Coercion"; IDENT "Local"; qid = global; ":";
-	 s = class_rawexpr; ">->"; t = class_rawexpr ->
-	  VernacCoercion (true, AN qid, s, t)
-      | IDENT "Coercion"; IDENT "Local"; ntn = by_notation; ":";
-	 s = class_rawexpr; ">->"; t = class_rawexpr ->
-	  VernacCoercion (true, ByNotation ntn, s, t)
+           VernacIdentityCoercion (f, s, t)
       | IDENT "Coercion"; qid = global; ":"; s = class_rawexpr; ">->";
          t = class_rawexpr ->
-	  VernacCoercion (false, AN qid, s, t)
+          VernacCoercion (AN qid, s, t)
       | IDENT "Coercion"; ntn = by_notation; ":"; s = class_rawexpr; ">->";
          t = class_rawexpr ->
-	  VernacCoercion (false, ByNotation ntn, s, t)
+          VernacCoercion (ByNotation ntn, s, t)
 
       | IDENT "Context"; c = binders ->
 	  VernacContext c
@@ -760,7 +745,7 @@ GEXTEND Gram
   ;
   argument_spec: [
        [ b = OPT "!"; id = name ; s = OPT scope ->
-       snd id, not (Option.is_empty b), Option.map (fun x -> Loc.tag ~loc:!@loc x) s
+       id.CAst.v, not (Option.is_empty b), Option.map (fun x -> CAst.make ~loc:!@loc x) s
     ]
   ];
   (* List of arguments implicit status, scope, modifiers *)
@@ -773,7 +758,7 @@ GEXTEND Gram
     | "/" -> [`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.tag ~loc:!@loc y) x
+         | None, x -> x | x, None -> Option.map (fun y -> CAst.make ~loc:!@loc y) x
          | Some _, Some _ -> user_err Pp.(str "scope declared twice") in
        List.map (fun (name,recarg_like,notation_scope) ->
            `Id { name=name; recarg_like=recarg_like;
@@ -781,7 +766,7 @@ GEXTEND Gram
                  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.tag ~loc:!@loc y) x
+         | None, x -> x | x, None -> Option.map (fun y -> CAst.make ~loc:!@loc y) x
          | Some _, Some _ -> user_err Pp.(str "scope declared twice") in
        List.map (fun (name,recarg_like,notation_scope) ->
            `Id { name=name; recarg_like=recarg_like;
@@ -789,7 +774,7 @@ GEXTEND Gram
                  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.tag ~loc:!@loc y) x
+         | None, x -> x | x, None -> Option.map (fun y -> CAst.make ~loc:!@loc y) x
          | Some _, Some _ -> user_err Pp.(str "scope declared twice") in
        List.map (fun (name,recarg_like,notation_scope) ->
            `Id { name=name; recarg_like=recarg_like;
@@ -799,11 +784,11 @@ GEXTEND Gram
   ];
   (* Same as [argument_spec_block], but with only implicit status and names *)
   more_implicits_block: [
-    [ name = name -> [(snd name, Vernacexpr.NotImplicit)]
+    [ name = name -> [(name.CAst.v, Vernacexpr.NotImplicit)]
     | "["; items = LIST1 name; "]" ->
-       List.map (fun name -> (snd name, Vernacexpr.Implicit)) items
+       List.map (fun name -> (name.CAst.v, Vernacexpr.Implicit)) items
     | "{"; items = LIST1 name; "}" ->
-       List.map (fun name -> (snd name, Vernacexpr.MaximallyImplicit)) items
+       List.map (fun name -> (name.CAst.v, Vernacexpr.MaximallyImplicit)) items
     ]
   ];
   strategy_level:
@@ -814,10 +799,10 @@ GEXTEND Gram
       | IDENT "transparent" -> Conv_oracle.transparent ] ]
   ;
   instance_name:
-    [ [ name = pidentref; sup = OPT binders ->
-	  (let ((loc,id),l) = name in ((loc, Name id),l)),
+    [ [ name = ident_decl; sup = OPT binders ->
+          (CAst.map (fun id -> Name id) (fst name), snd name),
           (Option.default [] sup)
-      | -> ((Loc.tag ~loc:!@loc Anonymous), None), []  ] ]
+      | -> ((CAst.make ~loc:!@loc Anonymous), None), []  ] ]
   ;
   hint_info:
     [ [ "|"; i = OPT natural; pat = OPT constr_pattern ->
@@ -842,7 +827,7 @@ GEXTEND Gram
   command:
     [ [ IDENT "Comments"; l = LIST0 comment -> VernacComments l
 
-      (* Hack! Should be in grammar_ext, but camlp4 factorize badly *)
+      (* Hack! Should be in grammar_ext, but camlp5 factorizes badly *)
       | IDENT "Declare"; IDENT "Instance"; namesup = instance_name; ":";
 	 expl = [ "!" -> Decl_kinds.Implicit | -> Decl_kinds.Explicit ] ; t = operconstr LEVEL "200";
 	 info = hint_info ->
@@ -881,28 +866,12 @@ GEXTEND Gram
       | IDENT "DelPath"; dir = ne_string ->
 	  VernacRemoveLoadPath dir
 
-      (* Some plugins are not loaded initially anymore : extraction,
-         and funind. To ease this transition toward a mandatory Require,
-         we hack here the vernac grammar in order to get customized
-         error messages telling what to Require instead of the dreadful
-         "Illegal begin of vernac". Normally, these fake grammar entries
-         are overloaded later by the grammar extensions in these plugins.
-         This code is meant to be removed in a few releases, when this
-         transition is considered finished. *)
-
-      | IDENT "Extraction" -> extraction_err ~loc:!@loc
-      | IDENT "Extract" -> extraction_err ~loc:!@loc
-      | IDENT "Recursive"; IDENT "Extraction" -> extraction_err ~loc:!@loc
-      | IDENT "Separate"; IDENT "Extraction" -> extraction_err ~loc:!@loc
-      | IDENT "Function" -> funind_err ~loc:!@loc
-      | IDENT "Functional" -> funind_err ~loc:!@loc
-
       (* Type-Checking (pas dans le refman) *)
       | "Type"; c = lconstr -> VernacGlobalCheck c
 
       (* Printing (careful factorization of entries) *)
       | IDENT "Print"; p = printable -> VernacPrint p
-      | IDENT "Print"; qid = smart_global -> VernacPrint (PrintName qid)
+      | IDENT "Print"; qid = smart_global; l = OPT univ_name_list -> VernacPrint (PrintName (qid,l))
       | IDENT "Print"; IDENT "Module"; "Type"; qid = global ->
 	  VernacPrint (PrintModuleType qid)
       | IDENT "Print"; IDENT "Module"; qid = global ->
@@ -967,8 +936,8 @@ GEXTEND Gram
       | IDENT "Check"; c = lconstr; "." ->
 	 fun g -> VernacCheckMayEval (None, g, c)
       (* Searching the environment *)
-      | IDENT "About"; qid = smart_global; "." ->
-	 fun g -> VernacPrint (PrintAbout (qid,g))
+      | IDENT "About"; qid = smart_global; l = OPT univ_name_list; "." ->
+         fun g -> VernacPrint (PrintAbout (qid,l,g))
       | IDENT "SearchHead"; c = constr_pattern; l = in_or_out_modules; "." ->
 	  fun g -> VernacSearch (SearchHead c,g, l)
       | IDENT "SearchPattern"; c = constr_pattern; l = in_or_out_modules; "." ->
@@ -987,7 +956,7 @@ GEXTEND Gram
       ] ]
   ;
   printable:
-    [ [ IDENT "Term"; qid = smart_global -> PrintName qid
+    [ [ IDENT "Term"; qid = smart_global; l = OPT univ_name_list -> PrintName (qid,l)
       | IDENT "All" -> PrintFullContext
       | IDENT "Section"; s = global -> PrintSectionContext s
       | IDENT "Grammar"; ent = IDENT ->
@@ -1038,8 +1007,7 @@ GEXTEND Gram
       | IDENT "Term"; qid = smart_global -> LocateTerm qid
       | IDENT "File"; f = ne_string -> LocateFile f
       | IDENT "Library"; qid = global -> LocateLibrary qid
-      | IDENT "Module"; qid = global -> LocateModule qid
-      | IDENT "Ltac"; qid = global -> LocateTactic qid ] ]
+      | IDENT "Module"; qid = global -> LocateModule qid ] ]
   ;
   option_value:
     [ [ n  = integer   -> IntValue (Some n)
@@ -1088,6 +1056,9 @@ GEXTEND Gram
       | -> ([],SearchOutside [])
       ] ]
   ;
+  univ_name_list:
+    [ [  "@{" ; l = LIST0 name; "}" -> l ] ]
+  ;
 END;
 
 GEXTEND Gram
@@ -1131,11 +1102,11 @@ GEXTEND Gram
   GLOBAL: syntax;
 
   syntax:
-   [ [ IDENT "Open"; local = obsolete_locality; IDENT "Scope"; sc = IDENT ->
-         VernacOpenCloseScope (local,(true,sc))
+   [ [ IDENT "Open"; IDENT "Scope"; sc = IDENT ->
+         VernacOpenCloseScope (true,sc)
 
-     | IDENT "Close"; local = obsolete_locality; IDENT "Scope"; sc = IDENT ->
-         VernacOpenCloseScope (local,(false,sc))
+     | IDENT "Close"; IDENT "Scope"; sc = IDENT ->
+         VernacOpenCloseScope (false,sc)
 
      | IDENT "Delimit"; IDENT "Scope"; sc = IDENT; "with"; key = IDENT ->
 	 VernacDelimiters (sc, Some key)
@@ -1145,33 +1116,31 @@ GEXTEND Gram
      | IDENT "Bind"; IDENT "Scope"; sc = IDENT; "with";
        refl = LIST1 class_rawexpr -> VernacBindScope (sc,refl)
 
-     | IDENT "Infix"; local = obsolete_locality;
-	 op = ne_lstring; ":="; p = constr;
+     | IDENT "Infix"; op = ne_lstring; ":="; p = constr;
          modl = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ];
 	 sc = OPT [ ":"; sc = IDENT -> sc ] ->
-         VernacInfix (local,(op,modl),p,sc)
-     | IDENT "Notation"; local = obsolete_locality; id = identref;
+         VernacInfix ((op,modl),p,sc)
+     | IDENT "Notation"; id = identref;
 	 idl = LIST0 ident; ":="; c = constr; b = only_parsing ->
            VernacSyntacticDefinition
-	     (id,(idl,c),local,b)
-     | IDENT "Notation"; local = obsolete_locality; s = lstring; ":=";
+             (id,(idl,c),b)
+     | IDENT "Notation"; s = lstring; ":=";
 	 c = constr;
          modl = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ];
 	 sc = OPT [ ":"; sc = IDENT -> sc ] ->
-           VernacNotation (local,c,(s,modl),sc)
+           VernacNotation (c,(s,modl),sc)
      | IDENT "Format"; IDENT "Notation"; n = STRING; s = STRING; fmt = STRING ->
            VernacNotationAddFormat (n,s,fmt)
 
      | IDENT "Reserved"; IDENT "Infix"; s = ne_lstring;
 	 l = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ] ->
-	   Metasyntax.check_infix_modifiers l;
-	   let (loc,s) = s in
-	   VernacSyntaxExtension (false,((loc,"x '"^s^"' y"),l))
+           let s = CAst.map (fun s -> "x '"^s^"' y") s in
+           VernacSyntaxExtension (true,(s,l))
 
-     | IDENT "Reserved"; IDENT "Notation"; local = obsolete_locality;
+     | IDENT "Reserved"; IDENT "Notation";
 	 s = ne_lstring;
 	 l = [ "("; l = LIST1 syntax_modifier SEP ","; ")" -> l | -> [] ]
-	 -> VernacSyntaxExtension (local,(s,l))
+         -> VernacSyntaxExtension (false, (s,l))
 
      (* "Print" "Grammar" should be here but is in "command" entry in order
         to factorize with other "Print"-based vernac entries *)
@@ -1184,9 +1153,6 @@ GEXTEND Gram
          Some (parse_compat_version s)
       | -> None ] ]
   ;
-  obsolete_locality:
-    [ [ IDENT "Local" -> true | -> false ] ]
-  ;
   level:
     [ [ IDENT "level"; n = natural -> NumLevel n
       | IDENT "next"; IDENT "level" -> NextLevel ] ]
@@ -1200,14 +1166,16 @@ GEXTEND Gram
       | IDENT "only"; IDENT "parsing" -> SetOnlyParsing
       | IDENT "compat"; s = STRING ->
         SetCompatVersion (parse_compat_version s)
-      | IDENT "format"; s1 = [s = STRING -> Loc.tag ~loc:!@loc s];
-                        s2 = OPT [s = STRING -> Loc.tag ~loc:!@loc s] ->
+      | IDENT "format"; s1 = [s = STRING -> CAst.make ~loc:!@loc s];
+                        s2 = OPT [s = STRING -> CAst.make ~loc:!@loc s] ->
           begin match s1, s2 with
-          | (_,k), Some s -> SetFormat(k,s)
+          | { CAst.v = k }, Some s -> SetFormat(k,s)
           | s, None -> SetFormat ("text",s) end
       | x = IDENT; ","; l = LIST1 [id = IDENT -> id ] SEP ","; "at";
         lev = level -> SetItemLevel (x::l,lev)
       | x = IDENT; "at"; lev = level -> SetItemLevel ([x],lev)
+      | x = IDENT; "at"; lev = level; b = constr_as_binder_kind -> SetItemLevelAsBinder ([x],b,Some lev)
+      | x = IDENT; b = constr_as_binder_kind -> SetItemLevelAsBinder ([x],b,None)
       | x = IDENT; typ = syntax_extension_type -> SetEntryType (x,typ)
     ] ]
   ;
@@ -1215,7 +1183,20 @@ GEXTEND Gram
     [ [ IDENT "ident" -> ETName | IDENT "global" -> ETReference
       | IDENT "bigint" -> ETBigint
       | IDENT "binder" -> ETBinder true
+      | IDENT "constr"; n = OPT at_level; b = constr_as_binder_kind -> ETConstrAsBinder (b,n)
+      | IDENT "pattern" -> ETPattern (false,None)
+      | IDENT "pattern"; "at"; IDENT "level"; n = natural -> ETPattern (false,Some n)
+      | IDENT "strict"; IDENT "pattern" -> ETPattern (true,None)
+      | IDENT "strict"; IDENT "pattern"; "at"; IDENT "level"; n = natural -> ETPattern (true,Some n)
       | IDENT "closed"; IDENT "binder" -> ETBinder false
     ] ]
   ;
+  at_level:
+    [ [ "at"; n = level -> n ] ]
+  ;
+  constr_as_binder_kind:
+    [ [ "as"; IDENT "ident" -> AsIdent
+      | "as"; IDENT "pattern" -> AsIdentOrPattern
+      | "as"; IDENT "strict"; IDENT "pattern" -> AsStrictPattern ] ]
+  ;
 END
diff --git a/parsing/highparsing.mllib b/parsing/highparsing.mllib
deleted file mode 100644
index 05e2911c2..000000000
--- a/parsing/highparsing.mllib
+++ /dev/null
@@ -1,4 +0,0 @@
-G_constr
-G_vernac
-G_prim
-G_proofs
diff --git a/parsing/parsing.mllib b/parsing/parsing.mllib
index 2a73d7bc6..1f29636b2 100644
--- a/parsing/parsing.mllib
+++ b/parsing/parsing.mllib
@@ -3,3 +3,7 @@ CLexer
 Pcoq
 Egramml
 Egramcoq
+G_constr
+G_vernac
+G_prim
+G_proofs
diff --git a/parsing/pcoq.ml b/parsing/pcoq.ml
index 81f02bf95..7a51908d9 100644
--- a/parsing/pcoq.ml
+++ b/parsing/pcoq.ml
@@ -15,8 +15,11 @@ let curry f x y = f (x, y)
 let uncurry f (x,y) = f x y
 
 (** Location Utils  *)
+let coq_file_of_ploc_file s =
+  if s = "" then Loc.ToplevelInput else Loc.InFile s
+
 let to_coqloc loc =
-  { Loc.fname = Ploc.file_name loc;
+  { Loc.fname = coq_file_of_ploc_file (Ploc.file_name loc);
     Loc.line_nb = Ploc.line_nb loc;
     Loc.bol_pos = Ploc.bol_pos loc;
     Loc.bp = Ploc.first_pos loc;
@@ -80,7 +83,7 @@ module type S =
       Gramext.position option * single_extend_statment list
   type coq_parsable
 
-  val parsable : ?file:string -> char Stream.t -> coq_parsable
+  val parsable : ?file:Loc.source -> char Stream.t -> coq_parsable
   val action : 'a -> action
   val entry_create : string -> 'a entry
   val entry_parse : 'a entry -> coq_parsable -> 'a
@@ -104,11 +107,11 @@ end with type 'a Entry.e = 'a Grammar.GMake(CLexer).Entry.e = struct
       Gramext.position option * single_extend_statment list
   type coq_parsable = parsable * CLexer.lexer_state ref
 
-  let parsable ?file c =
+  let parsable ?(file=Loc.ToplevelInput) c =
     let state = ref (CLexer.init_lexer_state file) in
     CLexer.set_lexer_state !state;
     let a = parsable c in
-    state := CLexer.release_lexer_state ();
+    state := CLexer.get_lexer_state ();
     (a,state)
 
   let action = Gramext.action
@@ -118,7 +121,7 @@ end with type 'a Entry.e = 'a Grammar.GMake(CLexer).Entry.e = struct
     CLexer.set_lexer_state !state;
     try
       let c = Entry.parse e p in
-      state := CLexer.release_lexer_state ();
+      state := CLexer.get_lexer_state ();
       c
     with Ploc.Exc (loc,e) ->
       CLexer.drop_lexer_state ();
@@ -130,7 +133,7 @@ end with type 'a Entry.e = 'a Grammar.GMake(CLexer).Entry.e = struct
     CLexer.set_lexer_state !state;
     try
       let a = f x in
-      state := CLexer.release_lexer_state ();
+      state := CLexer.get_lexer_state ();
       a
     with e ->
       CLexer.drop_lexer_state ();
@@ -199,7 +202,7 @@ end = struct
 
 end
 
-let camlp4_verbosity silent f x =
+let camlp5_verbosity silent f x =
   let a = !warning_verbose in
   warning_verbose := silent;
   f x;
@@ -271,7 +274,7 @@ type ext_kind =
 
 (** The list of extensions *)
 
-let camlp4_state = ref []
+let camlp5_state = ref []
 
 (** Deletion *)
 
@@ -296,13 +299,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_verbosity false (uncurry (G.extend e)) ext in
-  camlp4_state := ByEXTEND (undo, redo) :: !camlp4_state;
+  let redo () = camlp5_verbosity false (uncurry (G.extend e)) ext in
+  camlp5_state := ByEXTEND (undo, redo) :: !camlp5_state;
   redo ()
 
 let grammar_extend_sync e reinit ext =
-  camlp4_state := ByGrammar (ExtendRule (e, reinit, ext)) :: !camlp4_state;
-  camlp4_verbosity false (uncurry (G.extend e)) (of_coq_extend_statement ext)
+  camlp5_state := ByGrammar (ExtendRule (e, reinit, ext)) :: !camlp5_state;
+  camlp5_verbosity false (uncurry (G.extend e)) (of_coq_extend_statement ext)
 
 (** The apparent parser of Coq; encapsulate G to keep track
     of the extensions. *)
@@ -312,20 +315,20 @@ module Gram =
     include G
     let extend e =
       curry
-	(fun ext ->
-	   camlp4_state :=
-	     (ByEXTEND ((fun () -> grammar_delete e None ext),
-			(fun () -> uncurry (G.extend e) ext)))
-	   :: !camlp4_state;
-	   uncurry (G.extend e) ext)
+    (fun ext ->
+      camlp5_state :=
+        (ByEXTEND ((fun () -> grammar_delete e None ext),
+           (fun () -> uncurry (G.extend e) ext)))
+      :: !camlp5_state;
+      uncurry (G.extend e) ext)
     let delete_rule e pil =
       (* spiwack: if you use load an ML module which contains GDELETE_RULE
-	  in a section, God kills a kitty. As it would corrupt remove_grammars.
+      in a section, God kills a kitty. As it would corrupt remove_grammars.
           There does not seem to be a good way to undo a delete rule. As deleting
-	  takes fewer arguments than extending. The production rule isn't returned
-	  by delete_rule. If we could retrieve the necessary information, then
-	  ByEXTEND provides just the framework we need to allow this in section.
-	  I'm not entirely sure it makes sense, but at least it would be more correct.
+      takes fewer arguments than extending. The production rule isn't returned
+      by delete_rule. If we could retrieve the necessary information, then
+      ByEXTEND provides just the framework we need to allow this in section.
+      I'm not entirely sure it makes sense, but at least it would be more correct.
           *)
       G.delete_rule e pil
   end
@@ -337,18 +340,18 @@ module Gram =
 
 let rec remove_grammars n =
   if n>0 then
-    (match !camlp4_state with
+    (match !camlp5_state with
        | [] -> anomaly ~label:"Pcoq.remove_grammars" (Pp.str "too many rules to remove.")
        | ByGrammar (ExtendRule (g, reinit, ext)) :: t ->
            grammar_delete g reinit (of_coq_extend_statement ext);
-           camlp4_state := t;
+           camlp5_state := t;
            remove_grammars (n-1)
        | ByEXTEND (undo,redo)::t ->
            undo();
-           camlp4_state := t;
+           camlp5_state := t;
            remove_grammars n;
            redo();
-           camlp4_state := ByEXTEND (undo,redo) :: !camlp4_state)
+           camlp5_state := ByEXTEND (undo,redo) :: !camlp5_state)
 
 let make_rule r = [None, None, r]
 
@@ -441,7 +444,7 @@ module Prim =
 
     let name = Gram.entry_create "Prim.name"
     let identref = Gram.entry_create "Prim.identref"
-    let pidentref = Gram.entry_create "Prim.pidentref"
+    let ident_decl = Gram.entry_create "Prim.ident_decl"
     let pattern_ident = Gram.entry_create "pattern_ident"
     let pattern_identref = Gram.entry_create "pattern_identref"
 
@@ -471,6 +474,7 @@ module Constr =
     let global = make_gen_entry uconstr "global"
     let universe_level = make_gen_entry uconstr "universe_level"
     let sort = make_gen_entry uconstr "sort"
+    let sort_family = make_gen_entry uconstr "sort_family"
     let pattern = Gram.entry_create "constr:pattern"
     let constr_pattern = gec_constr "constr_pattern"
     let lconstr_pattern = gec_constr "lconstr_pattern"
@@ -499,8 +503,7 @@ module Vernac_ =
     let gallina_ext = gec_vernac "gallina_ext"
     let command = gec_vernac "command"
     let syntax = gec_vernac "syntax_command"
-    let vernac = gec_vernac "Vernac.vernac"
-    let vernac_eoi = eoi_entry vernac
+    let vernac_control = gec_vernac "Vernac.vernac_control"
     let rec_definition = gec_vernac "Vernac.rec_definition"
     let red_expr = make_gen_entry utactic "red_expr"
     let hint_info = gec_vernac "hint_info"
@@ -513,7 +516,7 @@ module Vernac_ =
       let act_eoi = Gram.action (fun _ loc -> None) in
       let rule = [
         ([ Symbols.stoken Tok.EOI ], act_eoi);
-        ([ Symbols.snterm (Gram.Entry.obj vernac) ], act_vernac );
+        ([ Symbols.snterm (Gram.Entry.obj vernac_control) ], act_vernac );
       ] in
       uncurry (Gram.extend main_entry) (None, make_rule rule)
 
@@ -538,11 +541,11 @@ let epsilon_value f e =
 
 (** Synchronized grammar extensions *)
 
-module GramState = Store.Make(struct end)
+module GramState = Store.Make ()
 
 type 'a grammar_extension = 'a -> GramState.t -> extend_rule list * GramState.t
 
-module GrammarCommand = Dyn.Make(struct end)
+module GrammarCommand = Dyn.Make ()
 module GrammarInterp = struct type 'a t = 'a grammar_extension end
 module GrammarInterpMap = GrammarCommand.Map(GrammarInterp)
 
@@ -607,8 +610,8 @@ let unfreeze (grams, lex) =
     the lexer state should not be resetted, since it contains
     keywords declared in g_*.ml4 *)
 
-let _ =
-  Summary.declare_summary "GRAMMAR_LEXER"
+let parser_summary_tag =
+  Summary.declare_summary_tag "GRAMMAR_LEXER"
     { Summary.freeze_function = freeze;
       Summary.unfreeze_function = unfreeze;
       Summary.init_function = Summary.nop }
@@ -631,6 +634,19 @@ let () =
   Grammar.register0 wit_ident (Prim.ident);
   Grammar.register0 wit_var (Prim.var);
   Grammar.register0 wit_ref (Prim.reference);
+  Grammar.register0 wit_sort_family (Constr.sort_family);
   Grammar.register0 wit_constr (Constr.constr);
   Grammar.register0 wit_red_expr (Vernac_.red_expr);
   ()
+
+(** Registering extra grammar *)
+
+type any_entry = AnyEntry : 'a Gram.entry -> any_entry
+
+let grammar_names : any_entry list String.Map.t ref = ref String.Map.empty
+
+let register_grammars_by_name name grams =
+  grammar_names := String.Map.add name grams !grammar_names
+
+let find_grammars_by_name name =
+  String.Map.find name !grammar_names
diff --git a/parsing/pcoq.mli b/parsing/pcoq.mli
index 445818e13..f36250176 100644
--- a/parsing/pcoq.mli
+++ b/parsing/pcoq.mli
@@ -73,7 +73,7 @@ module type S =
 
   type coq_parsable
 
-  val parsable : ?file:string -> char Stream.t -> coq_parsable
+  val parsable : ?file:Loc.source -> char Stream.t -> coq_parsable
   val action : 'a -> action
   val entry_create : string -> 'a entry
   val entry_parse : 'a entry -> coq_parsable -> 'a
@@ -124,7 +124,7 @@ end with type 'a Entry.e = 'a Grammar.GMake(CLexer).Entry.e
         |
         | Egrammar.make_constr_prod_item
         V
-      Gramext.g_symbol list which is sent to camlp4
+      Gramext.g_symbol list which is sent to camlp5
 
     For user level tactic notations, dynamic addition of new rules is
     also done in several steps:
@@ -161,9 +161,9 @@ end with type 'a Entry.e = 'a Grammar.GMake(CLexer).Entry.e
 
 *)
 
-(** Temporarily activate camlp4 verbosity *)
+(** Temporarily activate camlp5 verbosity *)
 
-val camlp4_verbosity : bool -> ('a -> unit) -> 'a -> unit
+val camlp5_verbosity : bool -> ('a -> unit) -> 'a -> unit
 
 (** Parse a string *)
 
@@ -192,17 +192,17 @@ module Prim :
     open Libnames
     val preident : string Gram.entry
     val ident : Id.t Gram.entry
-    val name : Name.t located Gram.entry
-    val identref : Id.t located Gram.entry
-    val pidentref : (Id.t located * (Id.t located list) option) Gram.entry
+    val name : lname Gram.entry
+    val identref : lident Gram.entry
+    val ident_decl : ident_decl Gram.entry
     val pattern_ident : Id.t Gram.entry
-    val pattern_identref : Id.t located Gram.entry
+    val pattern_identref : lident Gram.entry
     val base_ident : Id.t Gram.entry
     val natural : int Gram.entry
     val bigint : Constrexpr.raw_natural_number Gram.entry
     val integer : int Gram.entry
     val string : string Gram.entry
-    val lstring : string located Gram.entry
+    val lstring : lstring Gram.entry
     val qualid : qualid located Gram.entry
     val fullyqualid : Id.t list located Gram.entry
     val reference : reference Gram.entry
@@ -210,8 +210,8 @@ module Prim :
     val smart_global : reference or_by_notation Gram.entry
     val dirpath : DirPath.t Gram.entry
     val ne_string : string Gram.entry
-    val ne_lstring : string located Gram.entry
-    val var : Id.t located Gram.entry
+    val ne_lstring : lstring Gram.entry
+    val var : lident Gram.entry
   end
 
 module Constr :
@@ -225,6 +225,7 @@ module Constr :
     val global : reference Gram.entry
     val universe_level : glob_level Gram.entry
     val sort : glob_sort Gram.entry
+    val sort_family : Sorts.family Gram.entry
     val pattern : cases_pattern_expr Gram.entry
     val constr_pattern : constr_expr Gram.entry
     val lconstr_pattern : constr_expr Gram.entry
@@ -232,10 +233,10 @@ module Constr :
     val binder : local_binder_expr list Gram.entry (* closed_binder or variable *)
     val binders : local_binder_expr list Gram.entry (* list of binder *)
     val open_binders : local_binder_expr list Gram.entry
-    val binders_fixannot : (local_binder_expr list * (Id.t located option * recursion_order_expr)) Gram.entry
-    val typeclass_constraint : (Name.t located * bool * constr_expr) Gram.entry
+    val binders_fixannot : (local_binder_expr list * (lident option * recursion_order_expr)) Gram.entry
+    val typeclass_constraint : (lname * bool * constr_expr) Gram.entry
     val record_declaration : constr_expr Gram.entry
-    val appl_arg : (constr_expr * explicitation located option) Gram.entry
+    val appl_arg : (constr_expr * explicitation CAst.t option) Gram.entry
   end
 
 module Module :
@@ -250,9 +251,8 @@ module Vernac_ :
     val gallina_ext : vernac_expr Gram.entry
     val command : vernac_expr Gram.entry
     val syntax : vernac_expr Gram.entry
-    val vernac : vernac_expr Gram.entry
+    val vernac_control : vernac_control Gram.entry
     val rec_definition : (fixpoint_expr * decl_notation list) Gram.entry
-    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
@@ -260,7 +260,7 @@ module Vernac_ :
   end
 
 (** The main entry: reads an optional vernac command *)
-val main_entry : (Loc.t * vernac_expr) option Gram.entry
+val main_entry : (Loc.t * vernac_control) option Gram.entry
 
 (** Handling of the proof mode entry *)
 val get_command_entry : unit -> vernac_expr Gram.entry
@@ -312,3 +312,13 @@ val with_grammar_rule_protection : ('a -> 'b) -> 'a -> 'b
 (** Location Utils  *)
 val to_coqloc : Ploc.t -> Loc.t
 val (!@) : Ploc.t -> Loc.t
+
+type frozen_t
+val parser_summary_tag : frozen_t Summary.Dyn.tag
+
+(** Registering grammars by name *)
+
+type any_entry = AnyEntry : 'a Gram.entry -> any_entry
+
+val register_grammars_by_name : string -> any_entry list -> unit
+val find_grammars_by_name : string -> any_entry list
diff --git a/parsing/tok.ml b/parsing/tok.ml
index 0917e8d6d..fafad2779 100644
--- a/parsing/tok.ml
+++ b/parsing/tok.ml
@@ -60,7 +60,7 @@ let match_keyword kwd = function
   | KEYWORD kwd' when kwd = kwd' -> true
   | _ -> false
 
-(* Needed to fix Camlp4 signature.
+(* Needed to fix Camlp5 signature.
  Cannot use Pp because of silly Tox -> Compat -> Pp dependency *)
 let print ppf tok = Format.pp_print_string ppf (to_string tok)
 
diff --git a/parsing/tok.mli b/parsing/tok.mli
index 59a79dcd2..162310e2a 100644
--- a/parsing/tok.mli
+++ b/parsing/tok.mli
@@ -22,7 +22,7 @@ type t =
 val equal : t -> t -> bool
 val extract_string : t -> string
 val to_string : t -> string
-(* Needed to fit Camlp4 signature *)
+(* Needed to fit Camlp5 signature *)
 val print : Format.formatter -> t -> unit
 val match_keyword : string -> t -> bool
 (** for camlp5 *)
diff --git a/plugins/.dir-locals.el b/plugins/.dir-locals.el
deleted file mode 100644
index 4e8830f6c..000000000
--- a/plugins/.dir-locals.el
+++ /dev/null
@@ -1,4 +0,0 @@
-((coq-mode . ((eval . (let ((default-directory (locate-dominating-file
-						buffer-file-name ".dir-locals.el")))
-			(setq-local coq-prog-args `("-coqlib" ,(expand-file-name "..") "-R" ,(expand-file-name ".") "Coq"))
-			(setq-local coq-prog-name (expand-file-name "../bin/coqtop")))))))
diff --git a/plugins/.merlin b/plugins/.merlin
index dd6678ba0..2ba616962 100644
--- a/plugins/.merlin
+++ b/plugins/.merlin
@@ -1,2 +1 @@
 REC
-FLG -open API
diff --git a/plugins/btauto/g_btauto.ml4 b/plugins/btauto/g_btauto.ml4
index 23b91507c..896bb91f1 100644
--- a/plugins/btauto/g_btauto.ml4
+++ b/plugins/btauto/g_btauto.ml4
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma"  i*)
-
 open Ltac_plugin
 
 DECLARE PLUGIN "btauto_plugin"
diff --git a/plugins/btauto/refl_btauto.ml b/plugins/btauto/refl_btauto.ml
index 6281b2675..a09abfa19 100644
--- a/plugins/btauto/refl_btauto.ml
+++ b/plugins/btauto/refl_btauto.ml
@@ -12,12 +12,12 @@ let get_inductive dir s =
   let glob_ref () = Coqlib.find_reference contrib_name ("Coq" :: dir) s in
   Lazy.from_fun (fun () -> Globnames.destIndRef (glob_ref ()))
 
-let decomp_term sigma (c : Term.constr) =
-  Term.kind_of_term (EConstr.Unsafe.to_constr (Termops.strip_outer_cast sigma (EConstr.of_constr c)))
+let decomp_term sigma (c : Constr.t) =
+  Constr.kind (EConstr.Unsafe.to_constr (Termops.strip_outer_cast sigma (EConstr.of_constr c)))
 
-let lapp c v  = Term.mkApp (Lazy.force c, v)
+let lapp c v  = Constr.mkApp (Lazy.force c, v)
 
-let (===) = Term.eq_constr
+let (===) = Constr.equal
 
 module CoqList = struct
   let path = ["Init"; "Datatypes"]
@@ -53,17 +53,11 @@ end
 
 module Env = struct
 
-  module ConstrHashed = struct
-    type t = Term.constr
-    let equal = Term.eq_constr
-    let hash = Term.hash_constr
-  end
-
-  module ConstrHashtbl = Hashtbl.Make (ConstrHashed)
+  module ConstrHashtbl = Hashtbl.Make (Constr)
 
   type t = (int ConstrHashtbl.t * int ref)
 
-  let add (tbl, off) (t : Term.constr) =
+  let add (tbl, off) (t : Constr.t) =
     try ConstrHashtbl.find tbl t 
     with
     | Not_found -> 
@@ -103,7 +97,7 @@ module Bool = struct
   | Negb of t
   | Ifb of t * t * t
 
-  let quote (env : Env.t) sigma (c : Term.constr) : t =
+  let quote (env : Env.t) sigma (c : Constr.t) : t =
     let trueb = Lazy.force trueb in
     let falseb = Lazy.force falseb in
     let andb = Lazy.force andb in
@@ -170,7 +164,7 @@ module Btauto = struct
   | Bool.Xorb (b1, b2) -> lapp f_xor [|convert b1; convert b2|]
   | Bool.Ifb (b1, b2, b3) -> lapp f_ifb [|convert b1; convert b2; convert b3|]
 
-  let convert_env env : Term.constr = 
+  let convert_env env : Constr.t = 
     CoqList.of_list (Lazy.force Bool.typ) env
 
   let reify env t = lapp eval [|convert_env env; convert t|]
@@ -206,7 +200,8 @@ module Btauto = struct
         let assign = List.combine env var in
         let map_msg (key, v) =
           let b = if v then str "true" else str "false" in
-          let term = Printer.pr_constr key in
+          let sigma, env = Pfedit.get_current_context () in
+          let term = Printer.pr_constr_env env sigma key in
           term ++ spc () ++ str ":=" ++ spc () ++ b
         in
         let assign = List.map map_msg assign in
@@ -249,7 +244,7 @@ module Btauto = struct
           let env = Env.to_list env in
           let fl = reify env fl in
           let fr = reify env fr in
-          let changed_gl = Term.mkApp (c, [|typ; fl; fr|]) in
+          let changed_gl = Constr.mkApp (c, [|typ; fl; fr|]) in
           let changed_gl = EConstr.of_constr changed_gl in
           Tacticals.New.tclTHENLIST [
             Tactics.change_concl changed_gl;
diff --git a/plugins/cc/ccalgo.ml b/plugins/cc/ccalgo.ml
index 182821322..ccef9ab96 100644
--- a/plugins/cc/ccalgo.ml
+++ b/plugins/cc/ccalgo.ml
@@ -11,14 +11,15 @@
 (* Plus some e-matching and constructor handling by P. Corbineau *)
 
 open CErrors
-open Util
 open Pp
-open Goptions
 open Names
-open Term
+open Sorts
+open Constr
 open Vars
-open Tacmach
 open Evd
+open Goptions
+open Tacmach
+open Util
 
 let init_size=5
 
@@ -154,7 +155,7 @@ let rec term_equal t1 t2 =
 open Hashset.Combine
 
 let rec hash_term = function
-  | Symb c -> combine 1 (hash_constr c)
+  | Symb c -> combine 1 (Constr.hash c)
   | Product (s1, s2) -> combine3 2 (Sorts.hash s1) (Sorts.hash s2)
   | Eps i -> combine 3 (Id.hash i)
   | Appli (t1, t2) -> combine3 4 (hash_term t1) (hash_term t2)
@@ -215,7 +216,7 @@ type representative=
      mutable lfathers:Int.Set.t;
      mutable fathers:Int.Set.t;
      mutable inductive_status: inductive_status;
-     class_type : Term.types;
+     class_type : types;
      mutable functions: Int.Set.t PafMap.t} (*pac -> term = app(constr,t) *)
 
 type cl = Rep of representative| Eqto of int*equality
@@ -232,7 +233,7 @@ type node =
 module Constrhash = Hashtbl.Make
   (struct type t = constr
 	  let equal = eq_constr_nounivs
-	  let hash = hash_constr
+	  let hash = Constr.hash
    end)
 module Typehash = Constrhash
 
@@ -436,9 +437,9 @@ and make_app l=function
 and applist_proj c l =
   match c with
   | Symb s -> applist_projection s l
-  | _ -> applistc (constr_of_term c) l
+  | _ -> Term.applistc (constr_of_term c) l
 and applist_projection c l =
-  match kind_of_term c with
+  match Constr.kind c with
   | Const c when Environ.is_projection (fst c) (Global.env()) ->
     let p = Projection.make (fst c) false in
     (match l with 
@@ -446,15 +447,15 @@ and applist_projection c l =
       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
+      Term.it_mkLambda_or_LetIn (mkProj(p,mkRel 1)) ctx
     | hd :: tl ->
-      applistc (mkProj (p, hd)) tl)
-  | _ -> applistc c l
+      Term.applistc (mkProj (p, hd)) tl)
+  | _ -> Term.applistc c l
 
 let rec canonize_name sigma c =
   let c = EConstr.Unsafe.to_constr c in
   let func c = canonize_name sigma (EConstr.of_constr c) in
-    match kind_of_term c with
+    match Constr.kind c with
       | Const (kn,u) ->
 	  let canon_const = Constant.make1 (Constant.canonical kn) in 
 	    (mkConstU (canon_const,u))
@@ -837,7 +838,7 @@ let complete_one_class state i=
 	let _args =
 	  List.map (fun i -> constr_of_term (term state.uf  i))
 	    pac.args in
-	let typ = prod_applist _c (List.rev _args) in
+        let typ = Term.prod_applist _c (List.rev _args) in
 	let ct = app (term state.uf i) typ pac.arity in
 	  state.uf.epsilons <- pac :: state.uf.epsilons;
 	  ignore (add_term state ct)
diff --git a/plugins/cc/ccalgo.mli b/plugins/cc/ccalgo.mli
index f904aa3e6..23cd2161d 100644
--- a/plugins/cc/ccalgo.mli
+++ b/plugins/cc/ccalgo.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Util
-open Term
+open Constr
 open Names
 
 type pa_constructor =
@@ -85,7 +85,7 @@ type representative=
      mutable lfathers:Int.Set.t;
      mutable fathers:Int.Set.t;
      mutable inductive_status: inductive_status;
-     class_type : Term.types;
+     class_type : types;
      mutable functions: Int.Set.t PafMap.t} (*pac -> term = app(constr,t) *)
 
 type cl = Rep of representative| Eqto of int*equality
diff --git a/plugins/cc/ccproof.ml b/plugins/cc/ccproof.ml
index a43a167e8..97efaced8 100644
--- a/plugins/cc/ccproof.ml
+++ b/plugins/cc/ccproof.ml
@@ -10,7 +10,7 @@
 (* proof-trees that will be transformed into proof-terms in cctac.ml4   *)
 
 open CErrors
-open Term
+open Constr
 open Ccalgo
 open Pp
 
diff --git a/plugins/cc/ccproof.mli b/plugins/cc/ccproof.mli
index 9f53123db..a3e450134 100644
--- a/plugins/cc/ccproof.mli
+++ b/plugins/cc/ccproof.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Ccalgo
-open Term
+open Constr
 
 type rule=
     Ax of constr
diff --git a/plugins/cc/cctac.ml b/plugins/cc/cctac.ml
index 5a4c52456..7f8f60e46 100644
--- a/plugins/cc/cctac.ml
+++ b/plugins/cc/cctac.ml
@@ -12,7 +12,7 @@ open Evd
 open Names
 open Inductiveops
 open Declarations
-open Term
+open Constr
 open EConstr
 open Vars
 open Tactics
@@ -76,11 +76,11 @@ let rec decompose_term env sigma t=
 	let (mind,i_ind),u = c in 
 	let u = EInstance.kind sigma u in
 	let canon_mind = MutInd.make1 (MutInd.canonical mind) in
-	let canon_ind = canon_mind,i_ind in  (Symb (Term.mkIndU (canon_ind,u)))
+	let canon_ind = canon_mind,i_ind in  (Symb (Constr.mkIndU (canon_ind,u)))
     | Const (c,u) -> 
 	let u = EInstance.kind sigma u in
 	let canon_const = Constant.make1 (Constant.canonical c) in 
-	  (Symb (Term.mkConstU (canon_const,u)))
+	  (Symb (Constr.mkConstU (canon_const,u)))
     | Proj (p, c) -> 
 	let canon_const kn = Constant.make1 (Constant.canonical kn) in 
 	let p' = Projection.map canon_const p in
@@ -187,7 +187,7 @@ let make_prb gls depth additionnal_terms =
   let open Tacmach.New in
   let env=pf_env gls in
   let sigma=project gls in
-  let state = empty depth {it = Proofview.Goal.goal (Proofview.Goal.assume gls); sigma } in
+  let state = empty depth {it = Proofview.Goal.goal gls; sigma } in
   let pos_hyps = ref [] in
   let neg_hyps =ref [] in
     List.iter
@@ -198,7 +198,7 @@ let make_prb gls depth additionnal_terms =
       (fun decl ->
          let id = NamedDecl.get_id decl in
 	 begin
-	   let cid=Term.mkVar id in
+	   let cid=Constr.mkVar id in
 	   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
@@ -442,11 +442,11 @@ let cc_tactic depth additionnal_terms =
             let open Glob_term in
             let env = Proofview.Goal.env gl in
             let terms_to_complete = List.map (build_term_to_complete uf) (epsilons uf) in
-            let hole = CAst.make @@ GHole (Evar_kinds.InternalHole, Misctypes.IntroAnonymous, None) in
+            let hole = DAst.make @@ GHole (Evar_kinds.InternalHole, Misctypes.IntroAnonymous, None) in
             let pr_missing (c, missing) =
-              let c = Detyping.detype ~lax:true false [] env sigma c in
+              let c = Detyping.detype Detyping.Now ~lax:true false Id.Set.empty env sigma c in
               let holes = List.init missing (fun _ -> hole) in
-              Printer.pr_glob_constr_env env (CAst.make @@ GApp (c, holes))
+              Printer.pr_glob_constr_env env (DAst.make @@ GApp (c, holes))
             in
 	    Feedback.msg_info
 	      (Pp.str "Goal is solvable by congruence but some arguments are missing.");
diff --git a/plugins/cc/g_congruence.ml4 b/plugins/cc/g_congruence.ml4
index 6ed4672ce..0d677ac7a 100644
--- a/plugins/cc/g_congruence.ml4
+++ b/plugins/cc/g_congruence.ml4
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Ltac_plugin
 open Cctac
 open Stdarg
diff --git a/plugins/derive/Derive.v b/plugins/derive/Derive.v
index 0d5a93b03..d1046ae79 100644
--- a/plugins/derive/Derive.v
+++ b/plugins/derive/Derive.v
@@ -1 +1 @@
-Declare ML Module "derive_plugin".
\ No newline at end of file
+Declare ML Module "derive_plugin".
diff --git a/plugins/derive/derive.ml b/plugins/derive/derive.ml
index 1524079f4..c8c4c2dad 100644
--- a/plugins/derive/derive.ml
+++ b/plugins/derive/derive.ml
@@ -6,11 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+open Constr
 open Context.Named.Declaration
 
-let map_const_entry_body (f:Term.constr->Term.constr) (x:Safe_typing.private_constants Entries.const_entry_body)
+let map_const_entry_body (f:constr->constr) (x:Safe_typing.private_constants Entries.const_entry_body)
     : Safe_typing.private_constants Entries.const_entry_body =
-  Future.chain ~pure:true x begin fun ((b,ctx),fx) ->
+  Future.chain x begin fun ((b,ctx),fx) ->
     (f b , ctx) , fx
   end
 
@@ -37,9 +38,8 @@ let start_deriving f suchthat lemma =
         let f_type = EConstr.Unsafe.to_constr f_type in
         let ef = EConstr.Unsafe.to_constr ef in
         let env' = Environ.push_named (LocalDef (f, ef, f_type)) env in
-        let evdref = ref sigma in
-        let suchthat = Constrintern.interp_type_evars env' evdref suchthat in
-        TCons ( env' , !evdref , suchthat , (fun sigma _ ->
+        let sigma, suchthat = Constrintern.interp_type_evars env' sigma suchthat in
+        TCons ( env' , sigma , suchthat , (fun sigma _ ->
         TNil sigma))))))
     in
 
@@ -67,7 +67,7 @@ let start_deriving f suchthat lemma =
       let f_def = { f_def with Entries.const_entry_opaque = false } in
       let f_def = Entries.DefinitionEntry f_def , Decl_kinds.(IsDefinition Definition) in
       let f_kn = Declare.declare_constant f f_def in
-      let f_kn_term = Term.mkConst f_kn in
+      let f_kn_term = mkConst f_kn in
       (** In the type and body of the proof of [suchthat] there can be
           references to the variable [f]. It needs to be replaced by
           references to the constant [f] declared above. This substitution
diff --git a/plugins/derive/g_derive.ml4 b/plugins/derive/g_derive.ml4
index df701ed80..72057cd9b 100644
--- a/plugins/derive/g_derive.ml4
+++ b/plugins/derive/g_derive.ml4
@@ -8,8 +8,6 @@
 
 open Stdarg
 
-(*i camlp4deps: "grammar/grammar.cma"  i*)
-
 DECLARE PLUGIN "derive_plugin"
 
 let classify_derive_command _ = Vernacexpr.(VtStartProof ("Classic",Doesn'tGuaranteeOpacity,[]),VtLater)
diff --git a/plugins/extraction/CHANGES b/plugins/extraction/CHANGES
index cf97ae3ab..4bc3dba36 100644
--- a/plugins/extraction/CHANGES
+++ b/plugins/extraction/CHANGES
@@ -54,7 +54,7 @@ but also a few steps toward a more user-friendly extraction:
 
 * bug fixes: 
 - many concerning Records. 
-- a Stack Overflow with mutual inductive (PR#320)
+- a Stack Overflow with mutual inductive (BZ#320)
 - some optimizations have been removed since they were not type-safe:
   For example if e has type:  type 'x a = A
   Then:       match e with A -> A     -----X---->    e
@@ -125,7 +125,7 @@ but also a few steps toward a more user-friendly extraction:
 
   - the dummy constant "__" have changed. see README
 
-  - a few bug-fixes (#191 and others)
+  - a few bug-fixes (BZ#191 and others)
 
 7.2 -> 7.3
 
diff --git a/plugins/extraction/ExtrHaskellNatNum.v b/plugins/extraction/ExtrHaskellNatNum.v
index fabe9a4c6..09b044461 100644
--- a/plugins/extraction/ExtrHaskellNatNum.v
+++ b/plugins/extraction/ExtrHaskellNatNum.v
@@ -34,4 +34,4 @@ Extract Constant Init.Nat.sub => "(\n m -> Prelude.max 0 (n Prelude.- m))".
 Extract Constant Nat.div => "(\n m -> if m Prelude.== 0 then 0 else Prelude.div n m)".
 Extract Constant Nat.modulo => "(\n m -> if m Prelude.== 0 then 0 else Prelude.mod n m)".
 Extract Constant Init.Nat.div => "(\n m -> if m Prelude.== 0 then 0 else Prelude.div n m)".
-Extract Constant Init.Nat.modulo => "(\n m -> if m Prelude.== 0 then 0 else Prelude.mod n m)".
\ No newline at end of file
+Extract Constant Init.Nat.modulo => "(\n m -> if m Prelude.== 0 then 0 else Prelude.mod n m)".
diff --git a/plugins/extraction/ExtrOcamlIntConv.v b/plugins/extraction/ExtrOcamlIntConv.v
index fe6eb7780..ab13d75ad 100644
--- a/plugins/extraction/ExtrOcamlIntConv.v
+++ b/plugins/extraction/ExtrOcamlIntConv.v
@@ -96,4 +96,4 @@ Extraction "/tmp/test.ml"
   pos_of_int int_of_pos
   z_of_int int_of_z
   n_of_int int_of_n.
-*)
\ No newline at end of file
+*)
diff --git a/plugins/extraction/Extraction.v b/plugins/extraction/Extraction.v
index 1374a91ab..b3f9d6556 100644
--- a/plugins/extraction/Extraction.v
+++ b/plugins/extraction/Extraction.v
@@ -6,4 +6,4 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-Declare ML Module "extraction_plugin".
\ No newline at end of file
+Declare ML Module "extraction_plugin".
diff --git a/plugins/extraction/common.ml b/plugins/extraction/common.ml
index 9772ebd64..9aec190d0 100644
--- a/plugins/extraction/common.ml
+++ b/plugins/extraction/common.ml
@@ -405,7 +405,7 @@ let ref_renaming_fun (k,r) =
     let idg = safe_basename_of_global r in
     match l with
     | [""] -> (* this happens only at toplevel of the monolithic case *)
-      let globs = Id.Set.elements (get_global_ids ()) in
+      let globs = get_global_ids () in
       let id = next_ident_away (kindcase_id k idg) globs in
       Id.to_string id
     | _ -> modular_rename k idg
diff --git a/plugins/extraction/extract_env.ml b/plugins/extraction/extract_env.ml
index 89c2a0ae3..bc84df76b 100644
--- a/plugins/extraction/extract_env.ml
+++ b/plugins/extraction/extract_env.ml
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Miniml
-open Term
+open Constr
 open Declarations
 open Names
 open ModPath
@@ -138,7 +138,7 @@ let check_arity env cb =
 let check_fix env cb i =
   match cb.const_body with
     | Def lbody ->
-	(match kind_of_term (Mod_subst.force_constr lbody) with
+	(match Constr.kind (Mod_subst.force_constr lbody) with
 	  | Fix ((_,j),recd) when Int.equal i j -> check_arity env cb; (true,recd)
 	  | CoFix (j,recd) when Int.equal i j -> check_arity env cb; (false,recd)
 	  | _ -> raise Impossible)
@@ -146,8 +146,8 @@ let check_fix env cb i =
 
 let prec_declaration_equal (na1, ca1, ta1) (na2, ca2, ta2) =
   Array.equal Name.equal na1 na2 &&
-  Array.equal eq_constr ca1 ca2 &&
-  Array.equal eq_constr ta1 ta2
+  Array.equal Constr.equal ca1 ca2 &&
+  Array.equal Constr.equal ta1 ta2
 
 let factor_fix env l cb msb =
   let _,recd as check = check_fix env cb 0 in
@@ -281,7 +281,8 @@ and extract_msignature_spec env mp1 reso = function
       MTfunsig (mbid, extract_mbody_spec env mp mtb,
 		extract_msignature_spec env' mp1 reso me)
 
-and extract_mbody_spec env mp mb = match mb.mod_type_alg with
+and extract_mbody_spec : 'a. _ -> _ -> 'a generic_module_body -> _ =
+  fun env mp mb -> match mb.mod_type_alg with
   | Some ty -> extract_mexpression_spec env mp (mb.mod_type,ty)
   | None -> extract_msignature_spec env mp mb.mod_delta mb.mod_type
 
@@ -341,7 +342,7 @@ let rec extract_structure env mp reso ~all = function
 
 and extract_mexpr env mp = function
   | MEwith _ -> assert false (* no 'with' syntax for modules *)
-  | me when lang () != Ocaml ->
+  | me when lang () != Ocaml || Table.is_extrcompute () ->
       (* In Haskell/Scheme, we expand everything.
          For now, we also extract everything, dead code will be removed later
          (see [Modutil.optimize_struct]. *)
@@ -569,11 +570,12 @@ let print_structure_to_file (fn,si,mo) dry struc =
 let reset () =
   Visit.reset (); reset_tables (); reset_renaming_tables Everything
 
-let init modular library =
+let init ?(compute=false) modular library =
   check_inside_section (); check_inside_module ();
   set_keywords (descr ()).keywords;
   set_modular modular;
   set_library library;
+  set_extrcompute compute;
   reset ();
   if modular && lang () == Scheme then error_scheme ()
 
@@ -683,8 +685,22 @@ let extraction_library is_rec m =
   List.iter print struc;
   reset ()
 
+(** For extraction compute, we flatten all the module structure,
+    getting rid of module types or unapplied functors *)
+
+let flatten_structure struc =
+  let rec flatten_elem (lab,elem) = match elem with
+    |SEdecl d -> [d]
+    |SEmodtype _ -> []
+    |SEmodule m -> match m.ml_mod_expr with
+      |MEfunctor _ -> []
+      |MEident _ | MEapply _ -> assert false (* should be expanded *)
+      |MEstruct (_,elems) -> flatten_elems elems
+  and flatten_elems l = List.flatten (List.map flatten_elem l)
+  in flatten_elems (List.flatten (List.map snd struc))
+
 let structure_for_compute c =
-  init false false;
+  init false false ~compute:true;
   let env = Global.env () in
   let ast, mlt = Extraction.extract_constr env c in
   let ast = Mlutil.normalize ast in
@@ -693,8 +709,7 @@ let structure_for_compute c =
   let () = ast_iter_references add_ref add_ref add_ref ast in
   let refs = Refset.elements !refs in
   let struc = optimize_struct (refs,[]) (mono_environment refs []) in
-  let flatstruc = List.map snd (List.flatten (List.map snd struc)) in
-  flatstruc, ast, mlt
+  (flatten_structure struc), ast, mlt
 
 (* For the test-suite :
    extraction to a temporary file + run ocamlc on it *)
diff --git a/plugins/extraction/extract_env.mli b/plugins/extraction/extract_env.mli
index 5769ff117..dd8617738 100644
--- a/plugins/extraction/extract_env.mli
+++ b/plugins/extraction/extract_env.mli
@@ -34,5 +34,4 @@ val print_one_decl :
 (* Used by Extraction Compute *)
 
 val structure_for_compute :
-  Term.constr ->
-    Miniml.ml_flat_structure * Miniml.ml_ast * Miniml.ml_type
+  Constr.t -> (Miniml.ml_decl list) * Miniml.ml_ast * Miniml.ml_type
diff --git a/plugins/extraction/extraction.ml b/plugins/extraction/extraction.ml
index 7644b49ce..c169b7b50 100644
--- a/plugins/extraction/extraction.ml
+++ b/plugins/extraction/extraction.ml
@@ -10,6 +10,7 @@
 open Util
 open Names
 open Term
+open Constr
 open Vars
 open Declarations
 open Declareops
@@ -81,7 +82,7 @@ let whd_betaiotazeta t =
 
 let rec flag_of_type env t : flag =
   let t = whd_all env t in
-  match kind_of_term t with
+  match Constr.kind 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)
     | Sort _ -> (Info,TypeScheme)
@@ -111,14 +112,14 @@ let push_rel_assum (n, t) env =
 (*s [type_sign] gernerates a signature aimed at treating a type application. *)
 
 let rec type_sign env c =
-  match kind_of_term (whd_all env c) with
+  match Constr.kind (whd_all env 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_all env c) with
+  match Constr.kind (whd_all env 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
@@ -141,10 +142,11 @@ let make_typvar n vl =
     if not (String.contains s '\'') && Unicode.is_basic_ascii s then id
     else id_of_name Anonymous
   in
+  let vl = Id.Set.of_list vl in
   next_ident_away id' vl
 
 let rec type_sign_vl env c =
-  match kind_of_term (whd_all env c) with
+  match Constr.kind (whd_all env 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
@@ -152,7 +154,7 @@ let rec type_sign_vl env c =
     | _ -> [],[]
 
 let rec nb_default_params env c =
-  match kind_of_term (whd_all env c) with
+  match Constr.kind (whd_all env 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
@@ -206,7 +208,7 @@ let parse_ind_args si args relmax =
     | [] -> Int.Map.empty
     | Kill _ :: s -> parse (i+1) j s
     | Keep :: s ->
-      (match kind_of_term args.(i-1) with
+      (match Constr.kind args.(i-1) with
 	 | Rel k -> Int.Map.add (relmax+1-k) j (parse (i+1) (j+1) s)
 	 | _ -> parse (i+1) (j+1) s)
   in parse 1 1 si
@@ -223,7 +225,7 @@ let parse_ind_args si args relmax =
 
 
 let rec extract_type env db j c args =
-  match kind_of_term (whd_betaiotazeta c) with
+  match Constr.kind (whd_betaiotazeta c) with
     | App (d, args') ->
 	(* We just accumulate the arguments. *)
 	extract_type env db j d (Array.to_list args' @ args)
@@ -298,9 +300,9 @@ let rec extract_type env db j c args =
     | Proj (p,t) ->
        (* Let's try to reduce, if it hasn't already been done. *)
        if Projection.unfolded p then Tunknown
-       else extract_type env db j (Term.mkProj (Projection.unfold p, t)) args
+       else extract_type env db j (mkProj (Projection.unfold p, t)) args
     | Case _ | Fix _ | CoFix _ -> Tunknown
-    | _ -> assert false
+    | Var _ | Meta _ | Evar _ | Cast _ | LetIn _ | Construct _ -> assert false
 
 (*s Auxiliary function dealing with type application.
   Precondition: [r] is a type scheme represented by the signature [s],
@@ -330,7 +332,7 @@ and extract_type_scheme env db c p =
   if Int.equal p 0 then extract_type env db 0 c []
   else
     let c = whd_betaiotazeta c in
-    match kind_of_term c with
+    match Constr.kind c with
       | Lambda (n,t,d) ->
           extract_type_scheme (push_rel_assum (n,t) env) db d (p-1)
       | _ ->
@@ -414,8 +416,8 @@ and extract_really_ind env kn mib =
 	  let t = snd (decompose_prod_n npar types.(j)) in
 	  let prods,head = dest_prod epar t in
 	  let nprods = List.length prods in
-          let args = match kind_of_term head with
-            | App (f,args) -> args (* [kind_of_term f = Ind ip] *)
+          let args = match Constr.kind head with
+            | App (f,args) -> args (* [Constr.kind f = Ind ip] *)
             | _ -> [||]
           in
 	  let dbmap = parse_ind_args p.ip_sign args (nprods + npar) in
@@ -429,7 +431,7 @@ and extract_really_ind env kn mib =
 	let ip = (kn, 0) in
 	let r = IndRef ip in
 	if is_custom r then raise (I Standard);
-	if mib.mind_finite == Decl_kinds.CoFinite then raise (I Coinductive);
+        if mib.mind_finite == CoFinite then raise (I Coinductive);
 	if not (Int.equal mib.mind_ntypes 1) then raise (I Standard);
 	let p,u = packets.(0) in
 	if p.ip_logical then raise (I Standard);
@@ -443,7 +445,7 @@ and extract_really_ind env kn mib =
 	if Option.is_empty mib.mind_record then raise (I Standard);
 	(* Now we're sure it's a record. *)
 	(* First, we find its field names. *)
-	let rec names_prod t = match kind_of_term t with
+	let rec names_prod t = match Constr.kind t with
 	  | Prod(n,_,t) -> n::(names_prod t)
 	  | LetIn(_,_,_,t) -> names_prod t
 	  | Cast(t,_,_) -> names_prod t
@@ -502,7 +504,7 @@ and extract_really_ind env kn mib =
 *)
 
 and extract_type_cons env db dbmap c i =
-  match kind_of_term (whd_all env c) with
+  match Constr.kind (whd_all env 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
@@ -563,7 +565,7 @@ let record_constant_type env kn opt_typ =
 (* [mlt] is the ML type we want our extraction of [(c args)] to have. *)
 
 let rec extract_term env mle mlt c args =
-  match kind_of_term c with
+  match Constr.kind c with
     | App (f,a) ->
 	extract_term env mle mlt f (Array.to_list a @ args)
     | Lambda (n, t, d) ->
@@ -873,7 +875,7 @@ let decomp_lams_eta_n n m env c t =
 (* Let's try to identify some situation where extracted code
    will allow generalisation of type variables *)
 
-let rec gentypvar_ok c = match kind_of_term c with
+let rec gentypvar_ok c = match Constr.kind c with
   | Lambda _ | Const _ -> true
   | App (c,v) ->
       (* if all arguments are variables, these variables will
diff --git a/plugins/extraction/extraction.mli b/plugins/extraction/extraction.mli
index e1d43f340..b15b88ed2 100644
--- a/plugins/extraction/extraction.mli
+++ b/plugins/extraction/extraction.mli
@@ -9,7 +9,7 @@
 (*s Extraction from Coq terms to Miniml. *)
 
 open Names
-open Term
+open Constr
 open Declarations
 open Environ
 open Miniml
diff --git a/plugins/extraction/g_extraction.ml4 b/plugins/extraction/g_extraction.ml4
index 23452febd..4b6de58bd 100644
--- a/plugins/extraction/g_extraction.ml4
+++ b/plugins/extraction/g_extraction.ml4
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Pcoq.Prim
 
 DECLARE PLUGIN "extraction_plugin"
@@ -42,14 +40,20 @@ ARGUMENT EXTEND int_or_id
 END
 
 let pr_language = function
-  | Ocaml -> str "Ocaml"
+  | Ocaml -> str "OCaml"
   | Haskell -> str "Haskell"
   | Scheme -> str "Scheme"
   | JSON -> str "JSON"
 
+let warn_deprecated_ocaml_spelling =
+  CWarnings.create ~name:"deprecated-ocaml-spelling" ~category:"deprecated"
+    (fun () ->
+      strbrk ("The spelling \"OCaml\" should be used instead of \"Ocaml\"."))
+
 VERNAC ARGUMENT EXTEND language
 PRINTED BY pr_language
-| [ "Ocaml" ] -> [ Ocaml ]
+| [ "Ocaml" ] -> [ let _ = warn_deprecated_ocaml_spelling () in Ocaml ]
+| [ "OCaml" ] -> [ Ocaml ]
 | [ "Haskell" ] -> [ Haskell ]
 | [ "Scheme" ] -> [ Scheme ]
 | [ "JSON" ] -> [ JSON ]
diff --git a/plugins/extraction/haskell.ml b/plugins/extraction/haskell.ml
index 0f537abec..28abb7f57 100644
--- a/plugins/extraction/haskell.ml
+++ b/plugins/extraction/haskell.ml
@@ -58,7 +58,6 @@ let preamble mod_name comment used_modules usf =
    else
      str "#ifdef __GLASGOW_HASKELL__" ++ fnl () ++
      str "import qualified GHC.Base" ++ fnl () ++
-     str "import qualified GHC.Prim" ++ fnl () ++
      str "#else" ++ fnl () ++
      str "-- HUGS" ++ fnl () ++
      str "import qualified IOExts" ++ fnl () ++
@@ -78,7 +77,7 @@ let preamble mod_name comment used_modules usf =
   (if not usf.tunknown then mt ()
    else
      str "#ifdef __GLASGOW_HASKELL__" ++ fnl () ++
-     str "type Any = GHC.Prim.Any" ++ fnl () ++
+     str "type Any = GHC.Base.Any" ++ fnl () ++
      str "#else" ++ fnl () ++
      str "-- HUGS" ++ fnl () ++
      str "type Any = ()" ++ fnl () ++
@@ -145,7 +144,7 @@ let rec pp_expr par env args =
     | MLrel n ->
 	let id = get_db_name n env in
         (* Try to survive to the occurrence of a Dummy rel.
-           TODO: we should get rid of this hack (cf. #592) *)
+           TODO: we should get rid of this hack (cf. BZ#592) *)
         let id = if Id.equal id dummy_name then Id.of_string "__" else id in
         apply (Id.print id)
     | MLapp (f,args') ->
diff --git a/plugins/extraction/miniml.mli b/plugins/extraction/miniml.mli
index edebba49d..5e967ef37 100644
--- a/plugins/extraction/miniml.mli
+++ b/plugins/extraction/miniml.mli
@@ -187,8 +187,6 @@ type ml_structure = (ModPath.t * ml_module_structure) list
 
 type ml_signature = (ModPath.t * ml_module_sig) list
 
-type ml_flat_structure = ml_structure_elem list
-
 type unsafe_needs = {
   mldummy : bool;
   tdummy : bool;
diff --git a/plugins/extraction/mlutil.ml b/plugins/extraction/mlutil.ml
index a4c2bcd88..b01b0198d 100644
--- a/plugins/extraction/mlutil.ml
+++ b/plugins/extraction/mlutil.ml
@@ -127,11 +127,15 @@ let rec mgu = function
   | Taxiom, Taxiom -> ()
   | _ -> raise Impossible
 
-let needs_magic p = try mgu p; false with Impossible -> true
+let skip_typing () = lang () == Scheme || is_extrcompute ()
 
-let put_magic_if b a = if b && lang () != Scheme then MLmagic a else a
+let needs_magic p =
+  if skip_typing () then false
+  else try mgu p; false with Impossible -> true
 
-let put_magic p a = if needs_magic p && lang () != Scheme then MLmagic a else a
+let put_magic_if b a = if b then MLmagic a else a
+
+let put_magic p a = if needs_magic p then MLmagic a else a
 
 let generalizable a =
   lang () != Ocaml ||
@@ -769,6 +773,20 @@ let eta_red e =
 	else e
     | _ -> e
 
+(* Performs an eta-reduction when the core is atomic,
+   or otherwise returns None *)
+
+let atomic_eta_red e =
+  let ids,t = collect_lams e in
+  let n = List.length ids in
+  match t with
+  | MLapp (f,a) when test_eta_args_lift 0 n a ->
+     (match f with
+      | MLrel k when k>n -> Some (MLrel (k-n))
+      | MLglob _ | MLexn _ | MLdummy _ -> Some f
+      | _ -> None)
+  | _ -> None
+
 (*s Computes all head linear beta-reductions possible in [(t a)].
   Non-linear head beta-redex become let-in. *)
 
@@ -1053,6 +1071,10 @@ let rec simpl o = function
      simpl o (MLcase(typ,e,br'))
   | MLmagic(MLdummy _ as e) when lang () == Haskell -> e
   | MLmagic(MLexn _ as e) -> e
+  | MLlam _ as e ->
+     (match atomic_eta_red e with
+      | Some e' -> e'
+      | None -> ast_map (simpl o) e)
   | a -> ast_map (simpl o) a
 
 (* invariant : list [a] of arguments is non-empty *)
diff --git a/plugins/extraction/ocaml.ml b/plugins/extraction/ocaml.ml
index 9cbc3fd71..5d0f9c167 100644
--- a/plugins/extraction/ocaml.ml
+++ b/plugins/extraction/ocaml.ml
@@ -100,11 +100,41 @@ let pp_global k r = str (str_global k r)
 
 let pp_modname mp = str (Common.pp_module mp)
 
+(* grammar from OCaml 4.06 manual, "Prefix and infix symbols" *)
+
+let infix_symbols =
+  ['=' ; '<' ; '>' ; '@' ; '^' ; ';' ; '&' ; '+' ; '-' ; '*' ; '/' ; '$' ; '%' ]
+let operator_chars =
+  [ '!' ; '$' ; '%' ; '&' ; '*' ; '+' ; '-' ; '.' ; '/' ; ':' ; '<' ; '=' ; '>' ; '?' ; '@' ; '^' ; '|' ; '~' ]
+
+(* infix ops in OCaml, but disallowed by preceding grammar *)
+
+let builtin_infixes =
+  [ "::" ; "," ]
+
+let substring_all_opchars s start stop =
+  let rec check_char i =
+    if i >= stop then true
+    else
+      List.mem s.[i] operator_chars && check_char (i+1)
+  in
+  check_char start
+
 let is_infix r =
   is_inline_custom r &&
   (let s = find_custom r in
-   let l = String.length s in
-   l >= 2 && s.[0] == '(' && s.[l-1] == ')')
+   let len = String.length s in
+   len >= 3 &&
+   (* parenthesized *)
+   (s.[0] == '(' && s.[len-1] == ')' &&
+      let inparens = String.trim (String.sub s 1 (len - 2)) in
+      let inparens_len = String.length inparens in
+      (* either, begins with infix symbol, any remainder is all operator chars *)
+      (List.mem inparens.[0] infix_symbols && substring_all_opchars inparens 1 inparens_len) ||
+      (* or, starts with #, at least one more char, all are operator chars *)
+      (inparens.[0] == '#' && inparens_len >= 2 && substring_all_opchars inparens 1 inparens_len) ||
+      (* or, is an OCaml built-in infix *)
+      (List.mem inparens builtin_infixes)))
 
 let get_infix r =
   let s = find_custom r in
diff --git a/plugins/extraction/table.ml b/plugins/extraction/table.ml
index ca98f07e8..5903733a6 100644
--- a/plugins/extraction/table.ml
+++ b/plugins/extraction/table.ml
@@ -250,6 +250,11 @@ let modular () = !modular_ref
 let set_library b = library_ref := b
 let library () = !library_ref
 
+let extrcompute = ref false
+
+let set_extrcompute b = extrcompute := b
+let is_extrcompute () = !extrcompute
+
 (*s Printing. *)
 
 (* The following functions work even on objects not in [Global.env ()].
@@ -481,7 +486,7 @@ let check_loaded_modfile mp = match base_mp mp with
       if not (Library.library_is_loaded dp) then begin
 	match base_mp (Lib.current_mp ()) with
 	  | MPfile dp' when not (DirPath.equal dp dp') ->
-	      err (str "Please load library " ++ pr_dirpath dp ++ str " first.")
+            err (str "Please load library " ++ DirPath.print dp ++ str " first.")
 	  | _ -> ()
       end
   | _ -> ()
@@ -750,11 +755,11 @@ let extraction_implicit r l =
 
 let blacklist_table = Summary.ref Id.Set.empty ~name:"ExtrBlacklist"
 
-let modfile_ids = ref []
+let modfile_ids = ref Id.Set.empty
 let modfile_mps = ref MPmap.empty
 
 let reset_modfile () =
-  modfile_ids := Id.Set.elements !blacklist_table;
+  modfile_ids := !blacklist_table;
   modfile_mps := MPmap.empty
 
 let string_of_modfile mp =
@@ -763,7 +768,7 @@ let string_of_modfile mp =
     let id = Id.of_string (raw_string_of_modfile mp) in
     let id' = next_ident_away id !modfile_ids in
     let s' = Id.to_string id' in
-    modfile_ids := id' :: !modfile_ids;
+    modfile_ids := Id.Set.add id' !modfile_ids;
     modfile_mps := MPmap.add mp s' !modfile_mps;
     s'
 
diff --git a/plugins/extraction/table.mli b/plugins/extraction/table.mli
index 7e47d0bc8..e52e419fd 100644
--- a/plugins/extraction/table.mli
+++ b/plugins/extraction/table.mli
@@ -165,6 +165,9 @@ val modular : unit -> bool
 val set_library : bool -> unit
 val library : unit -> bool
 
+val set_extrcompute : bool -> unit
+val is_extrcompute : unit -> bool
+
 (*s Table for custom inlining *)
 
 val to_inline : global_reference -> bool
@@ -177,7 +180,7 @@ val implicits_of_global : global_reference -> Int.Set.t
 (*s Table for user-given custom ML extractions. *)
 
 (* UGLY HACK: registration of a function defined in [extraction.ml] *)
-val type_scheme_nb_args_hook : (Environ.env -> Term.constr -> int) Hook.t
+val type_scheme_nb_args_hook : (Environ.env -> Constr.t -> int) Hook.t
 
 val is_custom : global_reference -> bool
 val is_inline_custom : global_reference -> bool
diff --git a/plugins/firstorder/formula.ml b/plugins/firstorder/formula.ml
index db1a46a03..4c59996aa 100644
--- a/plugins/firstorder/formula.ml
+++ b/plugins/firstorder/formula.ml
@@ -8,7 +8,7 @@
 
 open Hipattern
 open Names
-open Term
+open Constr
 open EConstr
 open Vars
 open Termops
@@ -39,7 +39,7 @@ exception Is_atom of constr
 let meta_succ m = m+1
 
 let rec nb_prod_after n c=
-  match kind_of_term c with
+  match Constr.kind c with
     | Prod (_,_,b) ->if n>0 then nb_prod_after (n-1) b else
 	1+(nb_prod_after 0 b)
     | _ -> 0
@@ -55,7 +55,8 @@ let ind_hyps env sigma nevar ind largs =
   let types= Inductiveops.arities_of_constructors env ind in
   let myhyps t =
     let t = EConstr.of_constr t in
-    let t1=Termops.prod_applist sigma t largs in
+    let nparam_decls = Context.Rel.length (fst (Global.lookup_inductive (fst ind))).mind_params_ctxt in
+    let t1=Termops.prod_applist_assum sigma nparam_decls t largs in
     let t2=snd (decompose_prod_n_assum sigma nevar t1) in
       fst (decompose_prod_assum sigma t2) in
     Array.map myhyps types
diff --git a/plugins/firstorder/formula.mli b/plugins/firstorder/formula.mli
index 106c469c6..3b6b711c0 100644
--- a/plugins/firstorder/formula.mli
+++ b/plugins/firstorder/formula.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Term
+open Constr
 open EConstr
 open Globnames
 
diff --git a/plugins/firstorder/g_ground.ml4 b/plugins/firstorder/g_ground.ml4
index 1e7da3250..3c6ab47e9 100644
--- a/plugins/firstorder/g_ground.ml4
+++ b/plugins/firstorder/g_ground.ml4
@@ -6,7 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma"  i*)
 
 open Ltac_plugin
 open Formula
@@ -40,17 +39,17 @@ let _=
   in
     declare_int_option gdopt
 
-let congruence_depth=ref 100
 
 let _=
+  let congruence_depth=ref 100 in
   let gdopt=
-    { optdepr=false;
+    { optdepr=true; (* noop *)
       optname="Congruence Depth";
       optkey=["Congruence";"Depth"];
       optread=(fun ()->Some !congruence_depth);
       optwrite=
    (function
-	None->congruence_depth:=0
+        None->congruence_depth:=0
       |	Some i->congruence_depth:=(max i 0))}
   in
     declare_int_option gdopt
@@ -65,11 +64,14 @@ let default_intuition_tac =
 let (set_default_solver, default_solver, print_default_solver) = 
   Tactic_option.declare_tactic_option ~default:default_intuition_tac "Firstorder default solver"
 
-VERNAC COMMAND EXTEND Firstorder_Set_Solver CLASSIFIED AS SIDEFF
+VERNAC COMMAND FUNCTIONAL EXTEND Firstorder_Set_Solver CLASSIFIED AS SIDEFF
 | [ "Set" "Firstorder" "Solver" tactic(t) ] -> [
-    set_default_solver 
-      (Locality.make_section_locality (Locality.LocalityFixme.consume ()))
-      (Tacintern.glob_tactic t) ]
+    fun ~atts ~st -> let open Vernacinterp in
+      set_default_solver
+        (Locality.make_section_locality atts.locality)
+        (Tacintern.glob_tactic t);
+        st
+  ]
 END
 
 VERNAC COMMAND EXTEND Firstorder_Print_Solver CLASSIFIED AS QUERY
diff --git a/plugins/firstorder/ground.ml b/plugins/firstorder/ground.ml
index f660ba734..09147d606 100644
--- a/plugins/firstorder/ground.ml
+++ b/plugins/firstorder/ground.ml
@@ -11,7 +11,7 @@ open Formula
 open Sequent
 open Rules
 open Instances
-open Term
+open Constr
 open Tacmach.New
 open Tacticals.New
 
@@ -37,7 +37,7 @@ let ground_tac solver startseq =
     let () =
       if Tacinterp.get_debug()=Tactic_debug.DebugOn 0
       then
-        let gl = { Evd.it = Proofview.Goal.goal (Proofview.Goal.assume gl); sigma = project gl } in
+        let gl = { Evd.it = Proofview.Goal.goal gl; sigma = project gl } in
         Feedback.msg_debug (Printer.pr_goal gl)
     in
     tclORELSE (axiom_tac seq.gl seq)
diff --git a/plugins/firstorder/instances.ml b/plugins/firstorder/instances.ml
index 169073630..3409471a7 100644
--- a/plugins/firstorder/instances.ml
+++ b/plugins/firstorder/instances.ml
@@ -24,7 +24,7 @@ open Misctypes
 open Context.Rel.Declaration
 
 let compare_instance inst1 inst2=
-        let cmp c1 c2 = OrderedConstr.compare (EConstr.Unsafe.to_constr c1) (EConstr.Unsafe.to_constr c2) in
+        let cmp c1 c2 = Constr.compare (EConstr.Unsafe.to_constr c1) (EConstr.Unsafe.to_constr c2) in
 	match inst1,inst2 with
 	    Phantom(d1),Phantom(d2)->
 	      (cmp d1 d2)
@@ -115,8 +115,8 @@ let mk_open_instance env evmap id idc m t =
       let nid=(fresh_id_in_env avoid var_id env) in
       let (evmap, (c, _)) = Evarutil.new_type_evar env evmap Evd.univ_flexible in
       let decl = LocalAssum (Name nid, c) in
-	aux (n-1) (nid::avoid) (EConstr.push_rel decl env) evmap (decl::decls) in
-  let evmap, decls = aux m [] env evmap [] in
+	aux (n-1) (Id.Set.add nid avoid) (EConstr.push_rel decl env) evmap (decl::decls) in
+  let evmap, decls = aux m Id.Set.empty env evmap [] in
   (evmap, decls, revt)
 
 (* tactics   *)
diff --git a/plugins/firstorder/rules.ml b/plugins/firstorder/rules.ml
index d6309b057..1a6eba8c6 100644
--- a/plugins/firstorder/rules.ml
+++ b/plugins/firstorder/rules.ml
@@ -235,8 +235,8 @@ let constant str = Universes.constr_of_global
   @@ Coqlib.coq_reference "User" ["Init";"Logic"] str
 
 let defined_connectives=lazy
-  [AllOccurrences,EvalConstRef (fst (Term.destConst (constant "not")));
-   AllOccurrences,EvalConstRef (fst (Term.destConst (constant "iff")))]
+  [AllOccurrences,EvalConstRef (fst (Constr.destConst (constant "not")));
+   AllOccurrences,EvalConstRef (fst (Constr.destConst (constant "iff")))]
 
 let normalize_evaluables=
   Proofview.Goal.enter begin fun gl ->
diff --git a/plugins/firstorder/rules.mli b/plugins/firstorder/rules.mli
index d8d4c1a38..5c46f4cec 100644
--- a/plugins/firstorder/rules.mli
+++ b/plugins/firstorder/rules.mli
@@ -6,9 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Term
-open EConstr
 open Names
+open Constr
+open EConstr
 open Globnames
 
 type tactic = unit Proofview.tactic
diff --git a/plugins/firstorder/sequent.ml b/plugins/firstorder/sequent.ml
index 05194164b..ea2d076ed 100644
--- a/plugins/firstorder/sequent.ml
+++ b/plugins/firstorder/sequent.ml
@@ -54,13 +54,7 @@ struct
 	(priority e1.pat) - (priority e2.pat)
 end
 
-module OrderedConstr=
-struct
-  type t=Term.constr
-  let compare=Term.compare
-end
-
-type h_item = global_reference * (int*Term.constr) option
+type h_item = global_reference * (int*Constr.t) option
 
 module Hitem=
 struct
@@ -70,13 +64,13 @@ struct
     if c = 0 then
       let cmp (i1, c1) (i2, c2) =
         let c = Int.compare i1 i2 in
-        if c = 0 then OrderedConstr.compare c1 c2 else c
+        if c = 0 then Constr.compare c1 c2 else c
       in
       Option.compare cmp co1 co2
     else c
 end
 
-module CM=Map.Make(OrderedConstr)
+module CM=Map.Make(Constr)
 
 module History=Set.Make(Hitem)
 
diff --git a/plugins/firstorder/sequent.mli b/plugins/firstorder/sequent.mli
index ca6079c8b..7f4a6dd86 100644
--- a/plugins/firstorder/sequent.mli
+++ b/plugins/firstorder/sequent.mli
@@ -10,11 +10,9 @@ open EConstr
 open Formula
 open Globnames
 
-module OrderedConstr: Set.OrderedType with type t=Term.constr
+module CM: CSig.MapS with type key=Constr.t
 
-module CM: CSig.MapS with type key=Term.constr
-
-type h_item = global_reference * (int*Term.constr) option
+type h_item = global_reference * (int*Constr.t) option
 
 module History: Set.S with type elt = h_item
 
diff --git a/plugins/firstorder/unify.mli b/plugins/firstorder/unify.mli
index d3e8aeee8..390aa8c85 100644
--- a/plugins/firstorder/unify.mli
+++ b/plugins/firstorder/unify.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Term
+open Constr
 open EConstr
 
 exception UFAIL of constr*constr
diff --git a/plugins/fourier/fourierR.ml b/plugins/fourier/fourierR.ml
index 68af1b3b6..d9e9375c0 100644
--- a/plugins/fourier/fourierR.ml
+++ b/plugins/fourier/fourierR.ml
@@ -12,7 +12,7 @@
 des inéquations et équations sont entiers. En attendant la tactique Field.
 *)
 
-open Term
+open Constr
 open Tactics
 open Names
 open Globnames
@@ -27,11 +27,7 @@ qui donne le coefficient d'un terme du calcul des constructions,
 qui est zéro si le terme n'y est pas.
 *)
 
-module Constrhash = Hashtbl.Make
-  (struct type t = constr
-	  let equal = eq_constr
-	  let hash = hash_constr
-   end)
+module Constrhash = Hashtbl.Make(Constr)
 
 type flin = {fhom: rational Constrhash.t;
              fcste:rational};;
@@ -84,7 +80,7 @@ let string_of_R_constant kn =
     | _ -> "constant_not_of_R"
 
 let rec string_of_R_constr c =
- match kind_of_term c with
+ match Constr.kind c with
    Cast (c,_,_) -> string_of_R_constr c
   |Const (c,_) -> string_of_R_constant c
   | _ -> "not_of_constant"
@@ -92,7 +88,7 @@ let rec string_of_R_constr c =
 exception NoRational
 
 let rec rational_of_constr c =
-  match kind_of_term c with
+  match Constr.kind c with
   | Cast (c,_,_) -> (rational_of_constr c)
   | App (c,args) ->
       (match (string_of_R_constr c) with
@@ -125,7 +121,7 @@ exception NoLinear
 
 let rec flin_of_constr c =
   try(
-    match kind_of_term c with
+    match Constr.kind c with
   | Cast (c,_,_) -> (flin_of_constr c)
   | App (c,args) ->
       (match (string_of_R_constr c) with
@@ -192,9 +188,9 @@ exception NoIneq
 let ineq1_of_constr (h,t) =
   let h = EConstr.Unsafe.to_constr h in
   let t = EConstr.Unsafe.to_constr t in
-    match (kind_of_term t) with
+    match (Constr.kind t) with
       | App (f,args) ->
-        (match kind_of_term f with
+        (match Constr.kind f with
           | Const (c,_) when Array.length args = 2 ->
             let t1= args.(0) in
             let t2= args.(1) in
@@ -233,7 +229,7 @@ let ineq1_of_constr (h,t) =
             let t0= args.(0) in
             let t1= args.(1) in
             let t2= args.(2) in
-	    (match (kind_of_term t0) with
+	    (match (Constr.kind t0) with
               | Const (c,_) ->
 		(match (string_of_R_constant c) with
 		  | "R"->
@@ -438,7 +434,7 @@ let tac_use h =
 
 (*
 let is_ineq (h,t) =
-    match (kind_of_term t) with
+    match (Constr.kind t) with
 	App (f,args) ->
 	  (match (string_of_R_constr f) with
 	       "Rlt" -> true
@@ -479,7 +475,7 @@ let rec fourier () =
     (* si le but est une inéquation, on introduit son contraire,
        et le but à prouver devient False *)
     try 
-      match (kind_of_term goal) with
+      match (Constr.kind goal) with
       App (f,args) ->
       let get = eget in
       (match (string_of_R_constr f) with
diff --git a/plugins/fourier/g_fourier.ml4 b/plugins/fourier/g_fourier.ml4
index 682673e8d..16dd4c886 100644
--- a/plugins/fourier/g_fourier.ml4
+++ b/plugins/fourier/g_fourier.ml4
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Ltac_plugin
 open FourierR
 
diff --git a/plugins/funind/functional_principles_proofs.ml b/plugins/funind/functional_principles_proofs.ml
index 5f6d78359..d04887a48 100644
--- a/plugins/funind/functional_principles_proofs.ml
+++ b/plugins/funind/functional_principles_proofs.ml
@@ -1,7 +1,7 @@
 open Printer
 open CErrors
 open Util
-open Term
+open Constr
 open EConstr
 open Vars
 open Namegen
@@ -44,6 +44,10 @@ let observe_tac s tac g = observe_tac_stream (str s) tac g
   *)
 
 
+let pr_leconstr_fp =
+  let sigma, env = Pfedit.get_current_context () in
+  Printer.pr_leconstr_env env sigma
+
 let debug_queue = Stack.create ()
 
 let rec print_debug_queue e = 
@@ -172,7 +176,7 @@ let is_incompatible_eq sigma t =
 	| _ -> false
     with e when CErrors.noncritical e -> false
   in
-  if res then   observe (str "is_incompatible_eq " ++ Printer.pr_leconstr t);
+  if res then   observe (str "is_incompatible_eq " ++ pr_leconstr_fp t);
   res
 
 let change_hyp_with_using msg hyp_id t tac : tactic =
@@ -220,7 +224,8 @@ let find_rectype env sigma c =
 let isAppConstruct ?(env=Global.env ()) sigma t =
   try
     let t',l = find_rectype env sigma t in
-    observe (str "isAppConstruct : " ++ Printer.pr_leconstr t ++ str " -> " ++ Printer.pr_leconstr (applist  (t',l)));
+    observe (str "isAppConstruct : " ++ Printer.pr_leconstr_env env sigma t ++ str " -> " ++
+             Printer.pr_leconstr_env env sigma (applist  (t',l)));
     true
   with Not_found -> false
 
@@ -233,7 +238,8 @@ exception NoChange
 let change_eq env sigma hyp_id (context:rel_context) x t end_of_type  =
   let nochange ?t' msg  =
     begin
-      observe (str ("Not treating ( "^msg^" )") ++ pr_leconstr t  ++ str "    " ++ match t' with None -> str "" | Some t -> Printer.pr_leconstr t );
+      observe (str ("Not treating ( "^msg^" )") ++ pr_leconstr_env env sigma t  ++ str "    " ++
+               match t' with None -> str "" | Some t -> Printer.pr_leconstr_env env sigma t );
       raise NoChange;
     end
   in
@@ -318,7 +324,7 @@ let change_eq env sigma hyp_id (context:rel_context) x t end_of_type  =
 	context
     in
     let new_type_of_hyp =
-      Reductionops.nf_betaiota sigma new_type_of_hyp in
+      Reductionops.nf_betaiota env sigma new_type_of_hyp in
     let new_ctxt,new_end_of_type =
       decompose_prod_n_assum sigma ctxt_size new_type_of_hyp
     in
@@ -587,7 +593,7 @@ let treat_new_case ptes_infos nb_prod continue_tac term dyn_infos =
     tclTHENLIST
       [
 	(* We first introduce the variables *)
-	tclDO nb_first_intro (Proofview.V82.of_tactic (intro_avoiding dyn_infos.rec_hyps));
+	tclDO nb_first_intro (Proofview.V82.of_tactic (intro_avoiding (Id.Set.of_list dyn_infos.rec_hyps)));
 	(* Then the equation itself *)
 	Proofview.V82.of_tactic (intro_using heq_id);
 	onLastHypId (fun heq_id -> tclTHENLIST [
@@ -692,6 +698,7 @@ let build_proof
     : tactic =
   let rec build_proof_aux do_finalize dyn_infos : tactic =
     fun g ->
+        let env = pf_env g in
         let sigma = project g in
 (*      observe (str "proving on " ++ Printer.pr_lconstr_env (pf_env g) term);*)
 	match EConstr.kind sigma dyn_infos.info with
@@ -788,7 +795,7 @@ let build_proof
 		      do_finalize dyn_infos  g
 		  | Lambda _ ->
 		      let new_term =
-                        Reductionops.nf_beta sigma dyn_infos.info in
+                        Reductionops.nf_beta env sigma dyn_infos.info in
 		      build_proof do_finalize {dyn_infos with info = new_term}
 			g
 		  | LetIn _ ->
@@ -841,7 +848,7 @@ let build_proof
 	  | Rel _ -> anomaly (Pp.str "Free var in goal conclusion!")
   and build_proof do_finalize dyn_infos g =
 (*     observe (str "proving with "++Printer.pr_lconstr dyn_infos.info++ str " on goal " ++ pr_gls g); *)
-    observe_tac_stream (str "build_proof with " ++ Printer.pr_leconstr dyn_infos.info ) (build_proof_aux do_finalize dyn_infos) g
+    observe_tac_stream (str "build_proof with " ++ pr_leconstr_fp dyn_infos.info ) (build_proof_aux do_finalize dyn_infos) g
   and build_proof_args do_finalize dyn_infos (* f_args'  args *) :tactic =
     fun g ->
       let (f_args',args) = dyn_infos.info in
@@ -1135,7 +1142,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 	       princ_params
 	    );
     observe (str "fbody_with_full_params := " ++
-	       pr_leconstr fbody_with_full_params
+               pr_leconstr_env (Global.env ()) !evd fbody_with_full_params
 	    );
     let all_funs_with_full_params =
       Array.map (fun f -> applist(f, List.rev_map var_of_decl full_params)) all_funs
@@ -1147,7 +1154,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 	    let bodies_with_all_params =
 	      Array.map
 		(fun body ->
-		   Reductionops.nf_betaiota (project g)
+                   Reductionops.nf_betaiota (pf_env g) (project g)
 		     (applist(substl (List.rev (Array.to_list all_funs_with_full_params)) body,
 			      List.rev_map var_of_decl princ_params))
 		)
@@ -1185,12 +1192,12 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 		   let body_with_param,num =
 		     let body = get_body fnames.(i) in
 		     let body_with_full_params =
-		       Reductionops.nf_betaiota (project g) (
+                       Reductionops.nf_betaiota (pf_env g) (project g) (
 			 applist(body,List.rev_map var_of_decl full_params))
 		     in
 		     match EConstr.kind (project g) body_with_full_params with
 		       | Fix((_,num),(_,_,bs)) ->
-			       Reductionops.nf_betaiota (project g)
+                               Reductionops.nf_betaiota (pf_env g) (project g)
 				 (
 				   (applist
 				      (substl
@@ -1273,7 +1280,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 		     nb_rec_hyps = -100;
 		     rec_hyps = [];
 		     info =
-		       Reductionops.nf_betaiota (project g)
+                       Reductionops.nf_betaiota (pf_env g) (project g)
 			 (applist(fix_body,List.rev_map mkVar args_id));
 		     eq_hyps = []
 		   }
@@ -1333,7 +1340,7 @@ let prove_princ_for_struct (evd:Evd.evar_map ref) interactive_proof fun_num fnam
 		     nb_rec_hyps = -100;
 		     rec_hyps = [];
 		     info =
-		       Reductionops.nf_betaiota Evd.empty
+                       Reductionops.nf_betaiota (pf_env g) Evd.empty
 			 (applist(fbody_with_full_params,
 				  (List.rev_map var_of_decl princ_params)@
 				    (List.rev_map mkVar args_id)
@@ -1614,7 +1621,7 @@ let prove_principle_for_gen
       let hid =
 	next_ident_away_in_goal
 	  (Id.of_string "prov")
-	  hyps
+	  (Id.Set.of_list hyps)
       in
       tclTHENLIST
 	[
diff --git a/plugins/funind/functional_principles_types.ml b/plugins/funind/functional_principles_types.ml
index 513fce248..7a9bbd92c 100644
--- a/plugins/funind/functional_principles_types.ml
+++ b/plugins/funind/functional_principles_types.ml
@@ -1,7 +1,9 @@
 open Printer
 open CErrors
-open Util
 open Term
+open Sorts
+open Util
+open Constr
 open Vars
 open Namegen
 open Names
@@ -11,7 +13,6 @@ open Tactics
 open Context.Rel.Declaration
 open Indfun_common
 open Functional_principles_proofs
-open Misctypes
 
 module RelDecl = Context.Rel.Declaration
 
@@ -40,7 +41,7 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
     | decl :: predicates ->
        (match Context.Rel.Declaration.get_name decl with
 	| Name x ->
-	   let id = Namegen.next_ident_away x avoid in
+	   let id = Namegen.next_ident_away x (Id.Set.of_list avoid) in
 	   Hashtbl.add tbl id x;
 	   RelDecl.set_name (Name id) decl :: change_predicates_names (id::avoid) predicates
 	| Anonymous -> anomaly (Pp.str "Anonymous property binder."))
@@ -81,7 +82,7 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
   let is_pte =
     let set = List.fold_right Id.Set.add ptes_vars Id.Set.empty in
     fun t ->
-      match kind_of_term t with
+      match Constr.kind t with
 	| Var id -> Id.Set.mem id set
 	| _ -> false
   in
@@ -101,13 +102,13 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
   let pre_princ = EConstr.Unsafe.to_constr pre_princ in
   let pre_princ = substl (List.map mkVar ptes_vars) pre_princ in
   let is_dom c =
-    match kind_of_term c with
+    match Constr.kind c with
       | Ind((u,_),_) -> MutInd.equal u rel_as_kn
       | Construct(((u,_),_),_) -> MutInd.equal u rel_as_kn
       | _ -> false
   in
   let get_fun_num c =
-    match kind_of_term c with
+    match Constr.kind c with
       | Ind((_,num),_) -> num
       | Construct(((_,num),_),_) -> num
       | _ -> assert false
@@ -115,12 +116,14 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
   let dummy_var = mkVar (Id.of_string "________") in
   let mk_replacement c i args =
     let res = mkApp(rel_to_fun.(i), Array.map pop (array_get_start args)) in
-    observe (str "replacing " ++ pr_lconstr c ++ str " by "  ++ pr_lconstr res);
+    observe (str "replacing " ++
+             pr_lconstr_env env Evd.empty c ++ str " by "  ++
+             pr_lconstr_env env Evd.empty res);
     res
   in
   let rec compute_new_princ_type remove env pre_princ : types*(constr list) =
     let (new_princ_type,_) as res =
-      match kind_of_term pre_princ with
+      match Constr.kind pre_princ with
 	| Rel n ->
 	    begin
 	      try match Environ.lookup_rel n env with
@@ -150,12 +153,12 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
 	    in
 	    let new_f,binders_to_remove_from_f = compute_new_princ_type remove env f in
 	    applistc new_f new_args,
-	    list_union_eq eq_constr binders_to_remove_from_f binders_to_remove
+	    list_union_eq Constr.equal binders_to_remove_from_f binders_to_remove
 	| LetIn(x,v,t,b) ->
 	    compute_new_princ_type_for_letin remove env x v t b
 	| _ -> pre_princ,[]
     in
-(*     let _ = match kind_of_term pre_princ with *)
+(*     let _ = match Constr.kind pre_princ with *)
 (* 	| Prod _ -> *)
 (* 	    observe(str "compute_new_princ_type for "++ *)
 (* 	      pr_lconstr_env env pre_princ ++ *)
@@ -171,13 +174,13 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
 	let new_x : Name.t = get_name (Termops.ids_of_context env) x in
 	let new_env = Environ.push_rel (LocalAssum (x,t)) env in
 	let new_b,binders_to_remove_from_b = compute_new_princ_type remove new_env b in
-	 if List.exists (eq_constr (mkRel 1)) binders_to_remove_from_b
-	 then (pop new_b), filter_map (eq_constr (mkRel 1)) pop binders_to_remove_from_b
+	 if List.exists (Constr.equal (mkRel 1)) binders_to_remove_from_b
+	 then (pop new_b), filter_map (Constr.equal (mkRel 1)) pop binders_to_remove_from_b
 	 else
 	   (
 	     bind_fun(new_x,new_t,new_b),
 	     list_union_eq
-	       eq_constr
+	       Constr.equal
 	       binders_to_remove_from_t
 	       (List.map pop binders_to_remove_from_b)
 	   )
@@ -190,7 +193,7 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
 	| Toberemoved_with_rel (n,c) ->
 (* 	    observe (str "Decl of "++Ppconstr.Name.print x ++ str " is removed "); *)
 	    let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [c] n b)  in
-	    new_b, list_add_set_eq eq_constr (mkRel n) (List.map pop binders_to_remove_from_b)
+	    new_b, list_add_set_eq Constr.equal (mkRel n) (List.map pop binders_to_remove_from_b)
     end
   and compute_new_princ_type_for_letin remove env x v t b =
     begin
@@ -200,14 +203,14 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
 	let new_x : Name.t = get_name (Termops.ids_of_context env) x in
 	let new_env = Environ.push_rel (LocalDef (x,v,t)) env in
 	let new_b,binders_to_remove_from_b = compute_new_princ_type remove new_env b in
-	if List.exists (eq_constr (mkRel 1)) binders_to_remove_from_b
-	then (pop new_b),filter_map (eq_constr (mkRel 1)) pop binders_to_remove_from_b
+	if List.exists (Constr.equal (mkRel 1)) binders_to_remove_from_b
+	then (pop new_b),filter_map (Constr.equal (mkRel 1)) pop binders_to_remove_from_b
 	else
 	  (
 	    mkLetIn(new_x,new_v,new_t,new_b),
 	    list_union_eq
-	      eq_constr
-	      (list_union_eq eq_constr binders_to_remove_from_t binders_to_remove_from_v)
+	      Constr.equal
+	      (list_union_eq Constr.equal binders_to_remove_from_t binders_to_remove_from_v)
 	      (List.map pop binders_to_remove_from_b)
 	  )
 
@@ -219,12 +222,12 @@ let compute_new_princ_type_from_rel rel_to_fun sorts princ_type =
 	| Toberemoved_with_rel (n,c) ->
 (* 	    observe (str "Decl of "++Ppconstr.Name.print x ++ str " is removed "); *)
 	    let new_b,binders_to_remove_from_b = compute_new_princ_type remove env (substnl [c] n b)  in
-	    new_b, list_add_set_eq eq_constr (mkRel n) (List.map pop binders_to_remove_from_b)
+	    new_b, list_add_set_eq Constr.equal (mkRel n) (List.map pop binders_to_remove_from_b)
     end
   and  compute_new_princ_type_with_acc remove env e (c_acc,to_remove_acc)  =
     let new_e,to_remove_from_e = compute_new_princ_type remove env e
     in
-    new_e::c_acc,list_union_eq eq_constr to_remove_from_e to_remove_acc
+    new_e::c_acc,list_union_eq Constr.equal to_remove_from_e to_remove_acc
   in
 (*   observe (str "Computing new principe from " ++ pr_lconstr_env  env_with_params_and_predicates pre_princ); *)
   let pre_res,_ =
@@ -286,7 +289,7 @@ let build_functional_principle (evd:Evd.evar_map ref) interactive_proof old_prin
   (*    let time2 = System.get_time ()  in *)
   (*    Pp.msgnl (str "computing principle type := " ++ System.fmt_time_difference time1 time2); *)
   let new_princ_name =
-    next_ident_away_in_goal (Id.of_string "___________princ_________") []
+    next_ident_away_in_goal (Id.of_string "___________princ_________") Id.Set.empty
   in
   let _ = Typing.e_type_of ~refresh:true (Global.env ()) evd (EConstr.of_constr new_principle_type) in
   let hook = Lemmas.mk_hook (hook new_principle_type) in
@@ -330,7 +333,7 @@ let generate_functional_principle (evd: Evd.evar_map ref)
       | Some (id) -> id,id
       | None ->
 	  let id_of_f = Label.to_id (Constant.label (fst f)) in
-	  id_of_f,Indrec.make_elimination_ident id_of_f (family_of_sort type_sort)
+	  id_of_f,Indrec.make_elimination_ident id_of_f (Sorts.family type_sort)
   in
   let names = ref [new_princ_name] in
   let hook =
@@ -339,13 +342,17 @@ let generate_functional_principle (evd: Evd.evar_map ref)
     then
       (*     let id_of_f = Label.to_id (con_label f) in *)
       let register_with_sort fam_sort =
-	let evd' = Evd.from_env (Global.env ()) in
-	let evd',s = Evd.fresh_sort_in_family env evd' fam_sort in
-	let name = Indrec.make_elimination_ident base_new_princ_name fam_sort in
-	let evd',value = change_property_sort evd' s new_principle_type new_princ_name in
-	let evd' = fst (Typing.type_of ~refresh:true (Global.env ()) evd' (EConstr.of_constr value)) in
-	(* Pp.msgnl (str "new principle := " ++ pr_lconstr value); *)
-	let ce = Declare.definition_entry ~poly:(Flags.is_universe_polymorphism ()) ~univs:(snd (Evd.universe_context evd')) value in
+        let evd' = Evd.from_env (Global.env ()) in
+        let evd',s = Evd.fresh_sort_in_family env evd' fam_sort in
+        let name = Indrec.make_elimination_ident base_new_princ_name fam_sort in
+        let evd',value = change_property_sort evd' s new_principle_type new_princ_name in
+        let evd' = fst (Typing.type_of ~refresh:true (Global.env ()) evd' (EConstr.of_constr value)) in
+        (* Pp.msgnl (str "new principle := " ++ pr_lconstr value); *)
+        let univs =
+          let poly = Flags.is_universe_polymorphism () in
+          Evd.const_univ_entry ~poly evd'
+        in
+        let ce = Declare.definition_entry ~univs value in
 	ignore(
 	  Declare.declare_constant
 	    name
@@ -389,7 +396,7 @@ exception Not_Rec
 
 let get_funs_constant mp dp =
   let get_funs_constant const e : (Names.Constant.t*int) array =
-    match kind_of_term ((strip_lam e)) with
+    match Constr.kind ((strip_lam e)) with
       | Fix((_,(na,_,_))) ->
 	  Array.mapi
 	    (fun i na ->
@@ -430,7 +437,7 @@ let get_funs_constant mp dp =
       let first_params = List.hd l_params  in
       List.iter
 	(fun params ->
-	   if not (List.equal (fun (n1, c1) (n2, c2) -> Name.equal n1 n2 && eq_constr c1 c2) first_params params)
+	   if not (List.equal (fun (n1, c1) (n2, c2) -> Name.equal n1 n2 && Constr.equal c1 c2) first_params params)
 	   then user_err Pp.(str "Not a mutal recursive block")
 	)
 	l_params
@@ -439,7 +446,7 @@ let get_funs_constant mp dp =
     let _check_bodies =
       try
 	let extract_info is_first body =
-	  match kind_of_term body with
+	  match Constr.kind body with
 	    | Fix((idxs,_),(na,ta,ca)) -> (idxs,na,ta,ca)
 	    | _ ->
 		if is_first && Int.equal (List.length l_bodies) 1
@@ -450,7 +457,7 @@ let get_funs_constant mp dp =
 	let check body  = (* Hope this is correct *)
 	  let eq_infos (ia1, na1, ta1, ca1) (ia2, na2, ta2, ca2) =
             Array.equal Int.equal ia1 ia2 && Array.equal Name.equal na1 na2 &&
-            Array.equal eq_constr ta1 ta2 && Array.equal eq_constr ca1 ca2
+            Array.equal Constr.equal ta1 ta2 && Array.equal Constr.equal ca1 ca2
 	  in
 	  if not (eq_infos first_infos (extract_info false body))
 	  then  user_err Pp.(str "Not a mutal recursive block")
@@ -463,7 +470,7 @@ let get_funs_constant mp dp =
 exception No_graph_found
 exception Found_type of int
 
-let make_scheme evd (fas : (pconstant*glob_sort) list) : Safe_typing.private_constants definition_entry list =
+let make_scheme evd (fas : (pconstant*Sorts.family) list) : Safe_typing.private_constants definition_entry list =
   let env = Global.env () in
   let funs = List.map fst fas in
   let first_fun = List.hd funs in
@@ -500,7 +507,7 @@ let make_scheme evd (fas : (pconstant*glob_sort) list) : Safe_typing.private_con
   let i = ref (-1) in
   let sorts =
     List.rev_map (fun (_,x) ->
-		  Evarutil.evd_comb1 (Evd.fresh_sort_in_family env) evd (Pretyping.interp_elimination_sort x)
+		  Evarutil.evd_comb1 (Evd.fresh_sort_in_family env) evd x
 	     )
       fas
   in
@@ -564,7 +571,7 @@ let make_scheme evd (fas : (pconstant*glob_sort) list) : Safe_typing.private_con
       List.map (* we can now compute the other principles *)
 	(fun scheme_type ->
 	   incr i;
-	   observe (Printer.pr_lconstr scheme_type);
+           observe (Printer.pr_lconstr_env env sigma scheme_type);
 	   let type_concl = (strip_prod_assum scheme_type) in
 	   let applied_f = List.hd (List.rev (snd (decompose_app type_concl))) in
 	   let f = fst (decompose_app applied_f) in
@@ -574,10 +581,10 @@ let make_scheme evd (fas : (pconstant*glob_sort) list) : Safe_typing.private_con
 		let t =  (strip_prod_assum t) in
 		let applied_g = List.hd (List.rev (snd (decompose_app t))) in
 		let g = fst (decompose_app applied_g) in
-		if eq_constr f g
+		if Constr.equal f g
 		then raise (Found_type j);
-		observe (Printer.pr_lconstr f ++ str " <> " ++
-			   Printer.pr_lconstr g)
+                observe (Printer.pr_lconstr_env env sigma f ++ str " <> " ++
+                         Printer.pr_lconstr_env env sigma g)
 
 	     )
 	     ta;
@@ -674,7 +681,7 @@ let build_case_scheme fa =
   let scheme_type = EConstr.Unsafe.to_constr ((Typing.unsafe_type_of env sigma) (EConstr.of_constr scheme)) in
   let sorts =
     (fun (_,_,x) ->
-       Universes.new_sort_in_family (Pretyping.interp_elimination_sort x)
+       Universes.new_sort_in_family x
     )
       fa
   in
diff --git a/plugins/funind/functional_principles_types.mli b/plugins/funind/functional_principles_types.mli
index 5a7ffe059..ad396a2cb 100644
--- a/plugins/funind/functional_principles_types.mli
+++ b/plugins/funind/functional_principles_types.mli
@@ -7,8 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
-open Misctypes
+open Constr
 
 val generate_functional_principle :
   Evd.evar_map ref -> 
@@ -30,15 +29,10 @@ val generate_functional_principle :
   (EConstr.constr array -> int -> Tacmach.tactic) ->
   unit
 
-val compute_new_princ_type_from_rel : constr array -> Sorts.t array ->
-  types -> types
-
-
 exception No_graph_found
 
 val make_scheme :   Evd.evar_map ref ->
- (pconstant*glob_sort) list -> Safe_typing.private_constants Entries.definition_entry list
-
-val build_scheme : (Id.t*Libnames.reference*glob_sort) list ->  unit
-val build_case_scheme : (Id.t*Libnames.reference*glob_sort)  ->  unit
+ (pconstant*Sorts.family) list -> Safe_typing.private_constants Entries.definition_entry list
 
+val build_scheme : (Id.t*Libnames.reference*Sorts.family) list ->  unit
+val build_case_scheme : (Id.t*Libnames.reference*Sorts.family)  ->  unit
diff --git a/plugins/funind/g_indfun.ml4 b/plugins/funind/g_indfun.ml4
index 16d9f200f..ac7a2f284 100644
--- a/plugins/funind/g_indfun.ml4
+++ b/plugins/funind/g_indfun.ml4
@@ -5,7 +5,6 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i camlp4deps: "grammar/grammar.cma" i*)
 open Ltac_plugin
 open Util
 open Pp
@@ -144,8 +143,7 @@ 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
+  Pptactic.declare_extra_vernac_genarg_pprule wit_function_rec_definition_loc raw_printer
 
 (* TASSI: n'importe quoi ! *)
 VERNAC COMMAND EXTEND Function
@@ -155,7 +153,7 @@ VERNAC COMMAND EXTEND Function
            | _,((_,(_,CStructRec),_,_,_),_) -> false) recsl in
          match
            Vernac_classifier.classify_vernac
-             (Vernacexpr.VernacFixpoint(None, List.map snd recsl))
+             (Vernacexpr.(VernacExpr([], VernacFixpoint(Decl_kinds.NoDischarge, List.map snd recsl))))
          with
          | Vernacexpr.VtSideff ids, _ when hard ->
              Vernacexpr.(VtStartProof ("Classic", GuaranteesOpacity, ids), VtLater)
@@ -166,11 +164,11 @@ END
 let pr_fun_scheme_arg (princ_name,fun_name,s) =
   Names.Id.print princ_name ++ str " :=" ++ spc() ++ str "Induction for " ++
   Libnames.pr_reference fun_name ++ spc() ++ str "Sort " ++
-  Ppconstr.pr_glob_sort s
+  Termops.pr_sort_family s
 
 VERNAC ARGUMENT EXTEND fun_scheme_arg
 PRINTED BY pr_fun_scheme_arg
-| [ ident(princ_name) ":=" "Induction" "for" reference(fun_name) "Sort" sort(s) ] -> [ (princ_name,fun_name,s) ]
+| [ ident(princ_name) ":=" "Induction" "for" reference(fun_name) "Sort" sort_family(s) ] -> [ (princ_name,fun_name,s) ]
 END
 
 
diff --git a/plugins/funind/glob_term_to_relation.ml b/plugins/funind/glob_term_to_relation.ml
index 8cf5e8442..22881c32c 100644
--- a/plugins/funind/glob_term_to_relation.ml
+++ b/plugins/funind/glob_term_to_relation.ml
@@ -1,7 +1,7 @@
 open Printer
 open Pp
 open Names
-open Term
+open Constr
 open Vars
 open Glob_term
 open Glob_ops
@@ -34,10 +34,10 @@ type glob_context = (binder_type*glob_constr) list
 
 
 let rec solve_trivial_holes pat_as_term e =
-  match pat_as_term.CAst.v,e.CAst.v with
+  match DAst.get pat_as_term, DAst.get e with
   | GHole _,_ -> e
   | GApp(fp,argsp),GApp(fe,argse) when glob_constr_eq fp fe ->
-       CAst.make (GApp((solve_trivial_holes fp fe),List.map2 solve_trivial_holes argsp argse))
+       DAst.make (GApp((solve_trivial_holes fp fe),List.map2 solve_trivial_holes argsp argse))
   | _,_ -> pat_as_term
                                               
 (*
@@ -120,13 +120,13 @@ let combine_args arg args =
 
 
 let ids_of_binder =  function
-  | LetIn Anonymous | Prod Anonymous | Lambda Anonymous -> []
-  | LetIn (Name id)  | Prod (Name id) | Lambda (Name id) -> [id]
+  | LetIn Anonymous | Prod Anonymous | Lambda Anonymous -> Id.Set.empty
+  | LetIn (Name id)  | Prod (Name id) | Lambda (Name id) -> Id.Set.singleton id
 
 let rec change_vars_in_binder mapping = function
     [] -> []
   | (bt,t)::l ->
-      let new_mapping = List.fold_right Id.Map.remove (ids_of_binder bt) mapping in
+      let new_mapping = Id.Set.fold Id.Map.remove (ids_of_binder bt) mapping in
       (bt,change_vars mapping t)::
 	(if Id.Map.is_empty new_mapping
 	 then l
@@ -137,27 +137,27 @@ let rec replace_var_by_term_in_binder x_id term = function
   | [] -> []
   | (bt,t)::l ->
       (bt,replace_var_by_term x_id term t)::
-	if Id.List.mem x_id (ids_of_binder bt)
+	if Id.Set.mem x_id (ids_of_binder bt)
 	then l
 	else replace_var_by_term_in_binder x_id term l
 
-let add_bt_names bt = List.append (ids_of_binder bt)
+let add_bt_names bt = Id.Set.union (ids_of_binder bt)
 
 let apply_args ctxt body args =
   let need_convert_id avoid id =
-    List.exists (is_free_in id) args || Id.List.mem id avoid
+    List.exists (is_free_in id) args || Id.Set.mem id avoid
   in
   let need_convert avoid  bt =
-    List.exists (need_convert_id avoid) (ids_of_binder bt)
+    Id.Set.exists (need_convert_id avoid) (ids_of_binder bt)
   in
-  let next_name_away (na:Name.t) (mapping: Id.t Id.Map.t) (avoid: Id.t list) =
+  let next_name_away (na:Name.t) (mapping: Id.t Id.Map.t) (avoid: Id.Set.t) =
     match na with
-       | Name id when Id.List.mem id avoid ->
+       | Name id when Id.Set.mem id avoid ->
 	   let new_id = Namegen.next_ident_away id avoid in
-	   Name new_id,Id.Map.add id new_id mapping,new_id::avoid
+	   Name new_id,Id.Map.add id new_id mapping,Id.Set.add new_id avoid
        | _ -> na,mapping,avoid
   in
-  let next_bt_away bt (avoid:Id.t list) =
+  let next_bt_away bt (avoid:Id.Set.t) =
     match bt with
       | LetIn na ->
 	  let new_na,mapping,new_avoid = next_name_away na Id.Map.empty avoid  in
@@ -182,15 +182,15 @@ let apply_args ctxt body args =
 	  let new_avoid,new_ctxt',new_body,new_id =
 	    if need_convert_id avoid id
 	    then
-	      let new_avoid =  id::avoid in
+	      let new_avoid =  Id.Set.add id avoid in
 	      let new_id = Namegen.next_ident_away id new_avoid in
-	      let new_avoid' = new_id :: new_avoid in
+	      let new_avoid' = Id.Set.add new_id new_avoid in
 	      let mapping = Id.Map.add id new_id Id.Map.empty in
 	      let new_ctxt' = change_vars_in_binder mapping ctxt' in
 	      let new_body = change_vars mapping body in
 	      new_avoid',new_ctxt',new_body,new_id
 	    else
-	      id::avoid,ctxt',body,id
+	      Id.Set.add id avoid,ctxt',body,id
 	  in
 	  let new_body = replace_var_by_term new_id arg new_body in
 	  let new_ctxt' = replace_var_by_term_in_binder new_id arg new_ctxt' in
@@ -214,7 +214,7 @@ let apply_args ctxt body args =
 	  in
 	  (new_bt,t)::new_ctxt',new_body
   in
-  do_apply []  ctxt body args
+  do_apply Id.Set.empty ctxt body args
 
 
 let combine_app f args =
@@ -361,7 +361,7 @@ let add_pat_variables pat typ env : Environ.env =
   let rec add_pat_variables env pat typ  : Environ.env =
     observe (str "new rel env := " ++ Printer.pr_rel_context_of env (Evd.from_env env));
 
-    match pat.CAst.v with
+    match DAst.get pat with
       | PatVar na -> Environ.push_rel (RelDecl.LocalAssum (na,typ)) env
       | PatCstr(c,patl,na) ->
 	  let Inductiveops.IndType(indf,indargs) =
@@ -378,29 +378,30 @@ let add_pat_variables pat typ env : Environ.env =
     fst (
       Context.Rel.fold_outside
 	(fun decl (env,ctxt) ->
-         let open Context.Rel.Declaration in
-	 match decl with
+           let open Context.Rel.Declaration in
+           let sigma, _ = Pfedit.get_current_context () 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 = 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 () ++
-			  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 (LocalDef (id,new_v,new_t)) env,mkVar id::ctxt)
-      )
+             let new_t =  substl ctxt t in
+             observe (str "for variable " ++ Ppconstr.pr_id id ++  fnl () ++
+                      str "old type := " ++ Printer.pr_lconstr_env env sigma t ++ fnl () ++
+                      str "new type := " ++ Printer.pr_lconstr_env env sigma 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 = substl ctxt v in
+             observe (str "for variable " ++ Ppconstr.pr_id id ++  fnl () ++
+                      str "old type := "  ++ Printer.pr_lconstr_env env sigma t ++ fnl () ++
+                      str "new type := "  ++ Printer.pr_lconstr_env env sigma new_t ++ fnl () ++
+                      str "old value := " ++ Printer.pr_lconstr_env env sigma v ++ fnl () ++
+                      str "new value := " ++ Printer.pr_lconstr_env env sigma new_v ++ fnl ()
+                     );
+             let open Context.Named.Declaration in
+             (Environ.push_named (LocalDef (id,new_v,new_t)) env,mkVar id::ctxt)
+        )
 	(Environ.rel_context new_env)
 	~init:(env,[])
     )
@@ -411,7 +412,7 @@ let add_pat_variables pat typ env : Environ.env =
 
 
 
-let rec pattern_to_term_and_type env typ  = CAst.with_val (function
+let rec pattern_to_term_and_type env typ  = DAst.with_val (function
   | PatVar Anonymous -> assert false
   | PatVar (Name id) ->
 	mkGVar id
@@ -434,7 +435,7 @@ let rec pattern_to_term_and_type env typ  = CAst.with_val (function
 	Array.to_list
 	  (Array.init
 	     (cst_narg - List.length patternl)
-	     (fun i -> Detyping.detype false [] env (Evd.from_env env) (EConstr.of_constr csta.(i)))
+	     (fun i -> Detyping.detype Detyping.Now false Id.Set.empty env (Evd.from_env env) (EConstr.of_constr csta.(i)))
 	  )
       in
       let patl_as_term =
@@ -478,9 +479,9 @@ let rec pattern_to_term_and_type env typ  = CAst.with_val (function
 
 
 let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return =
-  observe (str " Entering : " ++ Printer.pr_glob_constr rt);
+  observe (str " Entering : " ++ Printer.pr_glob_constr_env env rt);
   let open CAst in
-  match rt.v with
+  match DAst.get rt with
     | GRef _ | GVar _ | GEvar _ | GPatVar _ | GSort _  | GHole _ ->
 	(* do nothing (except changing type of course) *)
 	mk_result [] rt avoid
@@ -496,13 +497,13 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return =
 	    (mk_result [] [] avoid)
 	in
 	begin
-	  match f.v with
+	  match DAst.get f with
 	    | GLambda _  -> 
 		let rec aux t l = 
 		  match l with 
 		    | [] -> t
-		    | u::l -> CAst.make @@
-			match t.v with 
+		    | u::l -> DAst.make @@
+			match DAst.get t with 
 			  | GLambda(na,_,nat,b) -> 
 			      GLetIn(na,u,None,aux b l)
 			  | _ -> 
@@ -519,7 +520,7 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return =
 		*)
 		let rt_as_constr,ctx = Pretyping.understand env (Evd.from_env env) rt in
 		let rt_typ = Typing.unsafe_type_of env (Evd.from_env env) (EConstr.of_constr rt_as_constr) in
-		let res_raw_type = Detyping.detype false [] env (Evd.from_env env) rt_typ in
+		let res_raw_type = Detyping.detype Detyping.Now false Id.Set.empty env (Evd.from_env env) rt_typ in
 		let res = fresh_id args_res.to_avoid "_res" in
 		let new_avoid = res::args_res.to_avoid in
 		let res_rt = mkGVar res in
@@ -559,12 +560,12 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return =
 		  match n with
 		    | Name id when List.exists (is_free_in id) args ->
 			(* need to alpha-convert the name *)
-			let new_id = Namegen.next_ident_away id avoid in
+			let new_id = Namegen.next_ident_away id (Id.Set.of_list avoid) in
 			let new_avoid = id:: avoid in
 			let new_b =
 			  replace_var_by_term
 			    id
-			    (CAst.make @@ GVar id)
+			    (DAst.make @@ GVar id)
 			    b
 			in
 			(Name new_id,new_b,new_avoid)
@@ -590,6 +591,7 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return =
 		*)
 		build_entry_lc env funnames avoid (mkGApp(b,args))
 	    | GRec _ -> user_err Pp.(str "Not handled GRec")
+            | GProj _ -> user_err Pp.(str "Funind does not support primitive projections")
 	    | GProd _ -> user_err Pp.(str "Cannot apply a type")
 	end (* end of the application treatement *)
 
@@ -626,7 +628,7 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return =
 	   then the one corresponding to the value [t]
 	   and combine the two result
 	*)
-        let v = match typ with None -> v | Some t -> CAst.make ?loc:rt.loc @@ GCast (v,CastConv t) in
+        let v = match typ with None -> v | Some t -> DAst.make ?loc:rt.loc @@ GCast (v,CastConv t) in
 	let v_res = build_entry_lc env funnames avoid v in
 	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) (EConstr.of_constr v_as_constr) in
@@ -651,8 +653,8 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return =
 	  try Inductiveops.find_inductive env (Evd.from_env env) b_typ
 	  with Not_found ->
 	    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")
+                               Printer.pr_glob_constr_env env b ++ str " in " ++
+                               Printer.pr_glob_constr_env env rt ++ str ". try again with a cast")
 	in
 	let case_pats = build_constructors_of_type (fst ind) [] in
 	assert (Int.equal (Array.length case_pats) 2);
@@ -683,8 +685,8 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return =
 	    try Inductiveops.find_inductive env (Evd.from_env env) b_typ
 	    with Not_found ->
 	      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")
+                                 Printer.pr_glob_constr_env env b ++ str " in " ++
+                                 Printer.pr_glob_constr_env env rt ++ str ". try again with a cast")
 	  in
 	  let case_pats = build_constructors_of_type (fst ind) nal_as_glob_constr in
 	  assert (Int.equal (Array.length case_pats) 1);
@@ -696,6 +698,7 @@ let rec build_entry_lc env funnames avoid rt : glob_constr build_entry_return =
     | GRec _ -> user_err Pp.(str "Not handled GRec")
     | GCast(b,_) ->
 	build_entry_lc env funnames  avoid b
+    | GProj(_,_) -> user_err Pp.(str "Funind does not support primitive projections")
 and build_entry_lc_from_case env funname make_discr
     (el:tomatch_tuples)
     (brl:Glob_term.cases_clauses) avoid :
@@ -773,7 +776,7 @@ and build_entry_lc_from_case_term env types funname make_discr patterns_to_preve
 			  Typing.unsafe_type_of env_with_pat_ids (Evd.from_env env) (EConstr.mkVar id)
 			in
 			let raw_typ_of_id =
-			  Detyping.detype false []
+			  Detyping.detype Detyping.Now false Id.Set.empty
 			    env_with_pat_ids (Evd.from_env env) typ_of_id
 			in
 			mkGProd (Name id,raw_typ_of_id,acc))
@@ -819,7 +822,7 @@ and build_entry_lc_from_case_term env types funname make_discr patterns_to_preve
 	      (fun pat e typ_as_constr ->
 		 let this_pat_ids = ids_of_pat pat in
 		 let typ_as_constr = EConstr.of_constr typ_as_constr in
-		 let typ = Detyping.detype false [] new_env (Evd.from_env env) typ_as_constr in
+		 let typ = Detyping.detype Detyping.Now false Id.Set.empty new_env (Evd.from_env env) typ_as_constr in
 		 let pat_as_term = pattern_to_term pat in
                  (* removing trivial holes *) 
                  let pat_as_term = solve_trivial_holes pat_as_term e in 
@@ -833,7 +836,7 @@ and build_entry_lc_from_case_term env types funname make_discr patterns_to_preve
 		      then (Prod (Name id),
 		      let typ_of_id = Typing.unsafe_type_of new_env (Evd.from_env env) (EConstr.mkVar id) in
 		      let raw_typ_of_id =
-			Detyping.detype false [] new_env (Evd.from_env env) typ_of_id
+			Detyping.detype Detyping.Now false Id.Set.empty new_env (Evd.from_env env) typ_of_id
 		      in
 		      raw_typ_of_id
 			   )::acc
@@ -875,37 +878,45 @@ and build_entry_lc_from_case_term env types funname make_discr patterns_to_preve
 	{ brl'_res with result = this_branch_res@brl'_res.result }
 
 
-let is_res id =
-  try
+let is_res r = match DAst.get r with
+| GVar id ->
+  begin try
     String.equal (String.sub (Id.to_string id) 0 4) "_res"
-  with Invalid_argument _ -> false
+  with Invalid_argument _ -> false end
+| _ -> false
 
+let is_gr c gr = match DAst.get c with
+| GRef (r, _) -> Globnames.eq_gr r gr
+| _ -> false
 
+let is_gvar c = match DAst.get c with
+| GVar id -> true
+| _ -> false
 
 let same_raw_term rt1 rt2 = 
-  match CAst.(rt1.v, rt2.v) with 
+  match DAst.get rt1, DAst.get rt2 with 
     | GRef(r1,_), GRef (r2,_) -> Globnames.eq_gr r1 r2
     | GHole _, GHole _ -> true
     | _ -> false
 let decompose_raw_eq lhs rhs = 
-  let rec decompose_raw_eq lhs rhs acc = 
-    observe (str "decomposing eq for " ++ pr_glob_constr lhs ++ str " " ++ pr_glob_constr rhs);
-    let (rhd,lrhs) = glob_decompose_app rhs in 
-    let (lhd,llhs) = glob_decompose_app lhs in 
-    observe (str "lhd := " ++ pr_glob_constr lhd);
-    observe (str "rhd := " ++ pr_glob_constr rhd);
+  let _, env = Pfedit.get_current_context () in
+  let rec decompose_raw_eq lhs rhs acc =
+    observe (str "decomposing eq for " ++ pr_glob_constr_env env lhs ++ str " " ++ pr_glob_constr_env env rhs);
+    let (rhd,lrhs) = glob_decompose_app rhs in
+    let (lhd,llhs) = glob_decompose_app lhs in
+    observe (str "lhd := " ++ pr_glob_constr_env env lhd);
+    observe (str "rhd := " ++ pr_glob_constr_env env rhd);
     observe (str "llhs := " ++ int (List.length llhs));
     observe (str "lrhs := " ++ int (List.length lrhs));
-    let sllhs = List.length llhs in 
-    let slrhs = List.length lrhs in 
-    if same_raw_term lhd rhd && Int.equal sllhs slrhs 
+    let sllhs = List.length llhs in
+    let slrhs = List.length lrhs in
+    if same_raw_term lhd rhd && Int.equal sllhs slrhs
     then
       (* let _ = assert false in  *)
       List.fold_right2 decompose_raw_eq	llhs lrhs acc
     else (lhs,rhs)::acc
   in
   decompose_raw_eq lhs rhs []
-     
 
 exception Continue
 (*
@@ -914,26 +925,27 @@ exception Continue
    eliminates some meaningless equalities, applies some rewrites......
 *)
 let rec rebuild_cons env nb_args relname args crossed_types depth rt =
-  observe (str "rebuilding : " ++ pr_glob_constr rt);
+  observe (str "rebuilding : " ++ pr_glob_constr_env env rt);
   let open Context.Rel.Declaration in
   let open CAst in
-  match rt.v with
+  match DAst.get rt with
     | GProd(n,k,t,b) ->
 	let not_free_in_t id = not (is_free_in id t) in
 	let new_crossed_types = t::crossed_types in
 	begin
-	  match t with
-	    | { v = GApp(({ v = GVar res_id } as res_rt),args') } when is_res res_id ->
+	  match DAst.get t with
+	    | GApp(res_rt ,args') when is_res res_rt ->
 		begin
-		  match args' with
-		    | { v = GVar this_relname }::args' ->
+                  let arg = List.hd args' in
+		  match DAst.get arg with
+		    | GVar this_relname ->
 			(*i The next call to mk_rel_id is
 			  valid since we are constructing the graph
 			  Ensures by: obvious
 			  i*)
 
 			let new_t =
-			  mkGApp(mkGVar(mk_rel_id this_relname),args'@[res_rt])
+			  mkGApp(mkGVar(mk_rel_id this_relname),List.tl args'@[res_rt])
 			in
 			let t',ctx = Pretyping.understand env (Evd.from_env env) new_t in
 			let new_env = Environ.push_rel (LocalAssum (n,t')) env in
@@ -948,12 +960,16 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 		    | _ -> (* the first args is the name of the function! *)
 			assert false
 		end
-	    | { loc = loc1; v = GApp({ loc = loc2; v = GRef(eq_as_ref,_) },[ty; { loc = loc3; v = GVar id};rt]) }
-		when Globnames.eq_gr eq_as_ref (Lazy.force Coqlib.coq_eq_ref)  && n == Anonymous
+	    | GApp(eq_as_ref,[ty; id ;rt])
+		when is_gvar id && is_gr eq_as_ref (Lazy.force Coqlib.coq_eq_ref)  && n == Anonymous
 		  ->
+                let loc1 = rt.CAst.loc in
+                let loc2 = eq_as_ref.CAst.loc in
+                let loc3 = id.CAst.loc in
+                let id = match DAst.get id with GVar id -> id | _ -> assert false in
 		begin
 		  try
-		    observe (str "computing new type for eq : " ++ pr_glob_constr rt);
+                    observe (str "computing new type for eq : " ++ pr_glob_constr_env env rt);
 		    let t' =
 		      try fst (Pretyping.understand env (Evd.from_env env) t)(*FIXME*)
                       with e when CErrors.noncritical e -> raise Continue
@@ -985,10 +1001,10 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 		    let params,arg' =
 		      ((Util.List.chop nparam args'))
 		    in
-		    let rt_typ = CAst.make @@
-		       GApp(CAst.make @@ GRef (Globnames.IndRef (fst ind),None),
+		    let rt_typ = DAst.make @@
+		       GApp(DAst.make @@ GRef (Globnames.IndRef (fst ind),None),
 			    (List.map
-			      (fun p -> Detyping.detype false []
+			      (fun p -> Detyping.detype Detyping.Now false Id.Set.empty
 				 env (Evd.from_env env)
 				 (EConstr.of_constr p)) params)@(Array.to_list
 				      (Array.make
@@ -996,13 +1012,13 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 					 (mkGHole ()))))
 		    in
 		    let eq' =
-		      CAst.make ?loc:loc1 @@ GApp(CAst.make ?loc:loc2 @@GRef(jmeq,None),[ty;CAst.make ?loc:loc3 @@ GVar id;rt_typ;rt])
+		      DAst.make ?loc:loc1 @@ GApp(DAst.make ?loc:loc2 @@GRef(jmeq,None),[ty;DAst.make ?loc:loc3 @@ GVar id;rt_typ;rt])
 		    in
-		    observe (str "computing new type for jmeq : " ++ pr_glob_constr eq');
+                    observe (str "computing new type for jmeq : " ++ pr_glob_constr_env env eq');
 		    let eq'_as_constr,ctx = Pretyping.understand env (Evd.from_env env) eq' in
 		    observe (str " computing new type for jmeq : done") ;
 		    let new_args =
-		      match kind_of_term eq'_as_constr with
+		      match Constr.kind eq'_as_constr with
 			| App(_,[|_;_;ty;_|]) ->
 			    let ty = Array.to_list (snd (destApp ty)) in
 			    let ty' = snd (Util.List.chop nparam ty) in
@@ -1015,12 +1031,12 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 				   match na with
 				     | Anonymous -> acc
 				     | Name id' ->
-					 (id',Detyping.detype false []
+					 (id',Detyping.detype Detyping.Now false Id.Set.empty
 					    env
                                             (Evd.from_env env)
 					    arg)::acc
 				 else if isVar var_as_constr
-				 then (destVar var_as_constr,Detyping.detype false []
+				 then (destVar var_as_constr,Detyping.detype Detyping.Now false Id.Set.empty
 					 env
                                          (Evd.from_env env)
 					 arg)::acc
@@ -1065,8 +1081,8 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 		     mkGProd(n,t,new_b),id_to_exclude
 		     else new_b, Id.Set.add id id_to_exclude
 		  *)
-	    | { loc = loc1; v = GApp({ loc = loc2; v = GRef(eq_as_ref,_) },[ty;rt1;rt2]) }
-		when Globnames.eq_gr eq_as_ref (Lazy.force Coqlib.coq_eq_ref) && n == Anonymous
+	    | GApp(eq_as_ref,[ty;rt1;rt2])
+		when is_gr eq_as_ref (Lazy.force Coqlib.coq_eq_ref) && n == Anonymous
 		  ->
 	      begin
 		try 
@@ -1077,7 +1093,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 		      List.fold_left 
 			(fun acc (lhs,rhs) -> 
 			  mkGProd(Anonymous,
-				  mkGApp(mkGRef(eq_as_ref),[mkGHole ();lhs;rhs]),acc)
+				  mkGApp(mkGRef(Lazy.force Coqlib.coq_eq_ref),[mkGHole ();lhs;rhs]),acc)
 			)
 			b
 			l
@@ -1085,7 +1101,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 		    rebuild_cons env nb_args relname args crossed_types depth new_rt
 		  else raise Continue
 	      with Continue -> 
-		observe (str "computing new type for prod : " ++ pr_glob_constr rt);
+                observe (str "computing new type for prod : " ++ pr_glob_constr_env env rt);
 		let t',ctx = Pretyping.understand env (Evd.from_env env) t in
 		let new_env = Environ.push_rel (LocalAssum (n,t')) env in
 		let new_b,id_to_exclude =
@@ -1101,7 +1117,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 		  | _ -> mkGProd(n,t,new_b),Id.Set.filter not_free_in_t id_to_exclude
 	      end
 	    | _ ->
-		observe (str "computing new type for prod : " ++ pr_glob_constr rt);
+                observe (str "computing new type for prod : " ++ pr_glob_constr_env env rt);
 		let t',ctx = Pretyping.understand env (Evd.from_env env) t in
 		let new_env = Environ.push_rel (LocalAssum (n,t')) env in
 		let new_b,id_to_exclude =
@@ -1120,7 +1136,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 	begin
 	  let not_free_in_t id = not (is_free_in id t) in
 	  let new_crossed_types = t :: crossed_types in
-	  observe (str "computing new type for lambda : " ++ pr_glob_constr rt);
+          observe (str "computing new type for lambda : " ++ pr_glob_constr_env env rt);
 	  let t',ctx = Pretyping.understand env (Evd.from_env env) t in
 	  match n with
 	    | Name id ->
@@ -1135,14 +1151,14 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 		then
 		  new_b, Id.Set.remove id (Id.Set.filter not_free_in_t id_to_exclude)
 		else
-		  CAst.make @@ GProd(n,k,t,new_b),Id.Set.filter not_free_in_t id_to_exclude
+		  DAst.make @@ GProd(n,k,t,new_b),Id.Set.filter not_free_in_t id_to_exclude
 	    | _ -> anomaly (Pp.str "Should not have an anonymous function here.")
 		(* We have renamed all the anonymous functions during alpha_renaming phase *)
 
 	end
     | GLetIn(n,v,t,b) ->
 	begin
-          let t = match t with None -> v | Some t -> CAst.make ?loc:rt.loc @@ GCast (v,CastConv t) in
+          let t = match t with None -> v | Some t -> DAst.make ?loc:rt.loc @@ GCast (v,CastConv t) in
 	  let not_free_in_t id = not (is_free_in id t) in
 	  let evd = (Evd.from_env env) in
 	  let t',ctx = Pretyping.understand env evd t in
@@ -1158,7 +1174,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 	  match n with
 	    | Name id when Id.Set.mem id id_to_exclude && depth >= nb_args  ->
 		new_b,Id.Set.remove id (Id.Set.filter not_free_in_t id_to_exclude)
-	    | _ -> CAst.make @@ GLetIn(n,t,None,new_b), (* HOPING IT WOULD WORK *)
+	    | _ -> DAst.make @@ GLetIn(n,t,None,new_b), (* HOPING IT WOULD WORK *)
 		Id.Set.filter not_free_in_t id_to_exclude
 	end
     | GLetTuple(nal,(na,rto),t,b) ->
@@ -1184,7 +1200,7 @@ let rec rebuild_cons env nb_args relname args crossed_types depth rt =
 (* 	    | Name id when Id.Set.mem id id_to_exclude ->  *)
 (* 		new_b,Id.Set.remove id (Id.Set.filter not_free_in_t id_to_exclude) *)
 (* 	    | _ -> *)
-	  CAst.make @@ GLetTuple(nal,(na,None),t,new_b),
+	  DAst.make @@ GLetTuple(nal,(na,None),t,new_b),
 		Id.Set.filter not_free_in_t (Id.Set.union id_to_exclude id_to_exclude')
 
 	end
@@ -1210,12 +1226,15 @@ let rebuild_cons env nb_args relname args crossed_types rt =
 
    TODO: Find a valid way to deal with implicit arguments here!
 *)
-let rec compute_cst_params relnames params gt = CAst.with_val (function
+let rec compute_cst_params relnames params gt = DAst.with_val (function
   | GRef _ | GVar _ | GEvar _ | GPatVar _ -> params
-  | GApp({ CAst.v = GVar relname' },rtl) when Id.Set.mem relname' relnames ->
-      compute_cst_params_from_app [] (params,rtl)
   | GApp(f,args) ->
+    begin match DAst.get f with
+    | GVar relname' when Id.Set.mem relname' relnames ->
+      compute_cst_params_from_app [] (params,args)
+    | _ ->
       List.fold_left (compute_cst_params relnames) params (f::args)
+    end
   | GLambda(_,_,t,b) | GProd(_,_,t,b) | GLetTuple(_,_,t,b) ->
       let t_params = compute_cst_params relnames params t in
       compute_cst_params relnames t_params b
@@ -1228,14 +1247,14 @@ let rec compute_cst_params relnames params gt = CAst.with_val (function
 		 discrimination ones *)
   | GSort _ -> params
   | GHole _ -> params
-  | GIf _ | GRec _ | GCast _ ->
+  | GIf _ | GRec _ | GCast _ | GProj _ ->
       raise (UserError(Some "compute_cst_params", str "Not handled case"))
   ) gt
 and compute_cst_params_from_app acc (params,rtl) =
+  let is_gid id c = match DAst.get c with GVar id' -> Id.equal id id' | _ -> false in
   match params,rtl with
     | _::_,[] -> assert false (* the rel has at least nargs + 1 arguments ! *)
-    | ((Name id,_,None) as param)::params', { CAst.v = GVar id' }::rtl'
-	when Id.compare id id' == 0 ->
+    | ((Name id,_,None) as param)::params', c::rtl' when is_gid id c ->
 	compute_cst_params_from_app (param::acc) (params',rtl')
     | _  -> List.rev acc
 
@@ -1276,12 +1295,12 @@ let rec rebuild_return_type rt =
         CAst.make ?loc @@ Constrexpr.CProdN(n,rebuild_return_type t')
     | Constrexpr.CLetIn(na,v,t,t') ->
 	CAst.make ?loc @@ Constrexpr.CLetIn(na,v,t,rebuild_return_type t')
-    | _ -> CAst.make ?loc @@ Constrexpr.CProdN([[Loc.tag Anonymous],
-				       Constrexpr.Default Decl_kinds.Explicit, rt],
+    | _ -> CAst.make ?loc @@ Constrexpr.CProdN([Constrexpr.CLocalAssum ([CAst.make Anonymous],
+                                       Constrexpr.Default Decl_kinds.Explicit, rt)],
 			    CAst.make @@ Constrexpr.CSort(GType []))
 
 let do_build_inductive
-      evd (funconstants: Term.pconstant list) (funsargs: (Name.t * glob_constr * glob_constr option) list list)
+      evd (funconstants: pconstant list) (funsargs: (Name.t * glob_constr * glob_constr option) list list)
       returned_types
       (rtl:glob_constr list) =
   let _time1 = System.get_time () in
@@ -1332,12 +1351,12 @@ let do_build_inductive
 	(fun (n,t,typ) acc ->
           match typ with
           | Some typ ->
-	     CAst.make @@ Constrexpr.CLetIn((Loc.tag n),with_full_print (Constrextern.extern_glob_constr Id.Set.empty) t,
+             CAst.make @@ Constrexpr.CLetIn((CAst.make n),with_full_print (Constrextern.extern_glob_constr Id.Set.empty) t,
                               Some (with_full_print (Constrextern.extern_glob_constr Id.Set.empty) typ),
 			      acc)
 	  | None ->
 	     CAst.make @@ Constrexpr.CProdN
-	       ([[(Loc.tag n)],Constrexpr_ops.default_binder_kind,with_full_print (Constrextern.extern_glob_constr Id.Set.empty) t],
+               ([Constrexpr.CLocalAssum([CAst.make n],Constrexpr_ops.default_binder_kind,with_full_print (Constrextern.extern_glob_constr Id.Set.empty) t)],
 		acc
 	       )
 	)
@@ -1399,12 +1418,12 @@ let do_build_inductive
       (fun (n,t,typ) acc ->
          match typ with
          | Some typ ->
-	   CAst.make @@ Constrexpr.CLetIn((Loc.tag n),with_full_print (Constrextern.extern_glob_constr Id.Set.empty) t,
+           CAst.make @@ Constrexpr.CLetIn((CAst.make n),with_full_print (Constrextern.extern_glob_constr Id.Set.empty) t,
                               Some (with_full_print (Constrextern.extern_glob_constr Id.Set.empty) typ),
 			    acc)
 	 | None ->
            CAst.make @@ Constrexpr.CProdN
-	   ([[(Loc.tag n)],Constrexpr_ops.default_binder_kind,with_full_print (Constrextern.extern_glob_constr Id.Set.empty) t],
+           ([Constrexpr.CLocalAssum([CAst.make n],Constrexpr_ops.default_binder_kind,with_full_print (Constrextern.extern_glob_constr Id.Set.empty) t)],
 	    acc
 	   )
       )
@@ -1431,18 +1450,18 @@ let do_build_inductive
       (fun (n,t,typ) ->
          match typ with
          | Some typ ->
-	   Constrexpr.CLocalDef((Loc.tag n), Constrextern.extern_glob_constr Id.Set.empty t,
+           Constrexpr.CLocalDef((CAst.make n), Constrextern.extern_glob_constr Id.Set.empty t,
                                   Some (with_full_print (Constrextern.extern_glob_constr Id.Set.empty) typ))
 	 | None ->
 	 Constrexpr.CLocalAssum
-	   ([(Loc.tag n)], Constrexpr_ops.default_binder_kind, Constrextern.extern_glob_constr Id.Set.empty t)
+           ([(CAst.make n)], Constrexpr_ops.default_binder_kind, Constrextern.extern_glob_constr Id.Set.empty t)
       )
       rels_params
   in
   let ext_rels_constructors =
     Array.map (List.map
       (fun (id,t) ->
-	 false,((Loc.tag id),
+         false,((CAst.make id),
 		with_full_print
 		  (Constrextern.extern_glob_type Id.Set.empty) ((* zeta_normalize *) (alpha_rt rel_params_ids t))
 	       )
@@ -1450,7 +1469,7 @@ let do_build_inductive
       (rel_constructors)
   in
   let rel_ind i ext_rel_constructors =
-    (((Loc.tag @@ relnames.(i)), None),
+    (((CAst.make @@ relnames.(i)), None),
     rel_params,
     Some rel_arities.(i),
     ext_rel_constructors),[]
@@ -1480,8 +1499,8 @@ let do_build_inductive
   let _time2 = System.get_time () in
   try
     with_full_print
-      (Flags.silently (Command.do_mutual_inductive rel_inds (Flags.is_universe_polymorphism ()) false false))
-      Decl_kinds.Finite
+      (Flags.silently (ComInductive.do_mutual_inductive rel_inds (Flags.is_universe_polymorphism ()) false false))
+      Declarations.Finite
   with
     | UserError(s,msg) as e ->
 	let _time3 = System.get_time () in
@@ -1492,7 +1511,7 @@ let do_build_inductive
 	in
 	let msg =
 	  str "while trying to define"++ spc () ++
-	    Ppvernac.pr_vernac (Vernacexpr.VernacInductive(Vernacexpr.GlobalNonCumulativity,false,Decl_kinds.Finite,repacked_rel_inds))
+            Ppvernac.pr_vernac Vernacexpr.(VernacExpr([], VernacInductive(GlobalNonCumulativity,false,Declarations.Finite,repacked_rel_inds)))
 	    ++ fnl () ++
 	    msg
 	in
@@ -1507,7 +1526,7 @@ let do_build_inductive
 	in
 	let msg =
 	  str "while trying to define"++ spc () ++
-	    Ppvernac.pr_vernac (Vernacexpr.VernacInductive(Vernacexpr.GlobalNonCumulativity,false,Decl_kinds.Finite,repacked_rel_inds))
+            Ppvernac.pr_vernac Vernacexpr.(VernacExpr([], VernacInductive(GlobalNonCumulativity,false,Declarations.Finite,repacked_rel_inds)))
 	    ++ fnl () ++
 	    CErrors.print reraise
 	in
diff --git a/plugins/funind/glob_term_to_relation.mli b/plugins/funind/glob_term_to_relation.mli
index 0cab5a6d3..ff0e98d00 100644
--- a/plugins/funind/glob_term_to_relation.mli
+++ b/plugins/funind/glob_term_to_relation.mli
@@ -11,7 +11,7 @@ val build_inductive :
   Id.t list -> (* The list of function name *) 
  *)
   Evd.evar_map ->
-  Term.pconstant list -> 
+  Constr.pconstant list -> 
   (Name.t*Glob_term.glob_constr*Glob_term.glob_constr option) list list -> (* The list of function args *)
   Constrexpr.constr_expr list -> (* The list of function returned type *)
   Glob_term.glob_constr list -> (* the list of body *)
diff --git a/plugins/funind/glob_termops.ml b/plugins/funind/glob_termops.ml
index 003bb4e30..41eb48657 100644
--- a/plugins/funind/glob_termops.ml
+++ b/plugins/funind/glob_termops.ml
@@ -10,83 +10,26 @@ open Misctypes
    Some basic functions to rebuild glob_constr
    In each of them the location is Loc.ghost
 *)
-let mkGRef ref          = CAst.make @@ GRef(ref,None)
-let mkGVar id           = CAst.make @@ GVar(id)
-let mkGApp(rt,rtl)      = CAst.make @@ GApp(rt,rtl)
-let mkGLambda(n,t,b)    = CAst.make @@ GLambda(n,Explicit,t,b)
-let mkGProd(n,t,b)      = CAst.make @@ GProd(n,Explicit,t,b)
-let mkGLetIn(n,b,t,c)   = CAst.make @@ GLetIn(n,b,t,c)
-let mkGCases(rto,l,brl) = CAst.make @@ GCases(Term.RegularStyle,rto,l,brl)
-let mkGSort s           = CAst.make @@ GSort(s)
-let mkGHole ()          = CAst.make @@ GHole(Evar_kinds.BinderType Anonymous,Misctypes.IntroAnonymous,None)
-let mkGCast(b,t)        = CAst.make @@ GCast(b,CastConv t)
+let mkGRef ref          = DAst.make @@ GRef(ref,None)
+let mkGVar id           = DAst.make @@ GVar(id)
+let mkGApp(rt,rtl)      = DAst.make @@ GApp(rt,rtl)
+let mkGLambda(n,t,b)    = DAst.make @@ GLambda(n,Explicit,t,b)
+let mkGProd(n,t,b)      = DAst.make @@ GProd(n,Explicit,t,b)
+let mkGLetIn(n,b,t,c)   = DAst.make @@ GLetIn(n,b,t,c)
+let mkGCases(rto,l,brl) = DAst.make @@ GCases(Term.RegularStyle,rto,l,brl)
+let mkGHole ()          = DAst.make @@ GHole(Evar_kinds.BinderType Anonymous,Misctypes.IntroAnonymous,None)
 
 (*
   Some basic functions to decompose glob_constrs
   These are analogous to the ones constrs
 *)
-let glob_decompose_prod =
-  let rec glob_decompose_prod args = function
-  | { CAst.v = GProd(n,k,t,b) } ->
-      glob_decompose_prod ((n,t)::args) b
-  | rt -> args,rt
-  in
-  glob_decompose_prod []
-
-let glob_decompose_prod_or_letin =
-  let rec glob_decompose_prod args = function
-  | { CAst.v = GProd(n,k,t,b) } ->
-      glob_decompose_prod ((n,None,Some t)::args) b
-  | { CAst.v = GLetIn(n,b,t,c) } ->
-      glob_decompose_prod ((n,Some b,t)::args) c
-  | rt -> args,rt
-  in
-  glob_decompose_prod []
-
-let glob_compose_prod =
-  List.fold_left (fun b (n,t) -> mkGProd(n,t,b))
-
-let glob_compose_prod_or_letin =
-  List.fold_left (
-      fun concl decl ->
-	match decl with
-	  | (n,None,Some t) -> mkGProd(n,t,concl)
-	  | (n,Some bdy,t) -> mkGLetIn(n,bdy,t,concl)
-	  | _ -> assert false)
-
-let glob_decompose_prod_n n =
-  let rec glob_decompose_prod i args c =
-    if i<=0 then args,c
-    else
-      match c with
-	| { CAst.v = GProd(n,_,t,b) } ->
-	    glob_decompose_prod (i-1) ((n,t)::args) b
-	| rt -> args,rt
-  in
-  glob_decompose_prod n []
-
-
-let glob_decompose_prod_or_letin_n n =
-  let rec glob_decompose_prod i args c =
-    if i<=0 then args,c
-    else
-      match c with
-	| { CAst.v = GProd(n,_,t,b) } ->
-	    glob_decompose_prod (i-1) ((n,None,Some t)::args) b
-	| { CAst.v = GLetIn(n,b,t,c) } ->
-	    glob_decompose_prod (i-1) ((n,Some b,t)::args) c
-	| rt -> args,rt
-  in
-  glob_decompose_prod n []
-
-
 let glob_decompose_app =
   let rec decompose_rapp acc rt =
 (*     msgnl (str "glob_decompose_app on : "++ Printer.pr_glob_constr rt); *)
-    match rt with
-    | { CAst.v = GApp(rt,rtl) } ->
+    match DAst.get rt with
+    | GApp(rt,rtl) ->
 	decompose_rapp (List.fold_left (fun y x -> x::y) acc rtl) rt
-    | rt -> rt,List.rev acc
+    | _ -> rt,List.rev acc
   in
   decompose_rapp []
 
@@ -101,18 +44,6 @@ let glob_make_eq ?(typ= mkGHole ()) t1 t2  =
 let glob_make_neq t1 t2 =
   mkGApp(mkGRef (Lazy.force Coqlib.coq_not_ref),[glob_make_eq t1 t2])
 
-(* [glob_make_or P1 P2] build the glob_constr corresponding to [P1 \/ P2] *)
-let glob_make_or t1 t2 = mkGApp (mkGRef(Lazy.force Coqlib.coq_or_ref),[t1;t2])
-
-(* [glob_make_or_list [P1;...;Pn]] build the glob_constr corresponding
-   to [P1 \/ ( .... \/ Pn)]
-*)
-let rec glob_make_or_list = function
-  | [] -> invalid_arg "mk_or"
-  | [e] -> e
-  | e::l -> glob_make_or e (glob_make_or_list l)
-
-
 let remove_name_from_mapping mapping na =
   match na with
     | Anonymous -> mapping
@@ -120,7 +51,7 @@ let remove_name_from_mapping mapping na =
 
 let change_vars =
   let rec change_vars mapping rt =
-    CAst.map_with_loc (fun ?loc -> function
+    DAst.map_with_loc (fun ?loc -> function
       | GRef _ as x -> x
       | GVar id ->
 	  let new_id =
@@ -178,6 +109,7 @@ let change_vars =
       | GCast(b,c) ->
 	  GCast(change_vars mapping b,
 		Miscops.map_cast_type (change_vars mapping) c)
+      | GProj(p,c) -> GProj(p, change_vars mapping c)
       ) rt
   and change_vars_br mapping ((loc,(idl,patl,res)) as br) =
     let new_mapping = List.fold_right Id.Map.remove idl mapping in
@@ -191,22 +123,22 @@ let change_vars =
 
 let rec alpha_pat excluded pat =
   let loc = pat.CAst.loc in
-  match pat.CAst.v with
+  match DAst.get pat with
     | PatVar Anonymous ->
 	let new_id = Indfun_common.fresh_id excluded "_x" in
-	(CAst.make ?loc @@ PatVar(Name new_id)),(new_id::excluded),Id.Map.empty
+	(DAst.make ?loc @@ PatVar(Name new_id)),(new_id::excluded),Id.Map.empty
     | PatVar(Name id) ->
 	if Id.List.mem id excluded
 	then
-	  let new_id = Namegen.next_ident_away id excluded in
-	  (CAst.make ?loc @@ PatVar(Name new_id)),(new_id::excluded),
+	  let new_id = Namegen.next_ident_away id (Id.Set.of_list excluded) in
+	  (DAst.make ?loc @@ PatVar(Name new_id)),(new_id::excluded),
 	(Id.Map.add id new_id Id.Map.empty)
 	else pat, excluded,Id.Map.empty
     | PatCstr(constr,patl,na) ->
 	let new_na,new_excluded,map =
 	  match na with
 	    | Name id when Id.List.mem id excluded ->
-		let new_id = Namegen.next_ident_away id excluded in
+		let new_id = Namegen.next_ident_away id (Id.Set.of_list excluded) in
 		Name new_id,new_id::excluded, Id.Map.add id new_id Id.Map.empty
 	    | _ -> na,excluded,Id.Map.empty
 	in
@@ -219,7 +151,7 @@ let rec alpha_pat excluded pat =
 	    ([],new_excluded,map)
 	    patl
 	in
-        (CAst.make ?loc @@ PatCstr(constr,List.rev new_patl,new_na)),new_excluded,new_map
+        (DAst.make ?loc @@ PatCstr(constr,List.rev new_patl,new_na)),new_excluded,new_map
 
 let alpha_patl excluded patl  =
   let patl,new_excluded,map =
@@ -238,7 +170,7 @@ let alpha_patl excluded patl  =
 
 let raw_get_pattern_id pat acc =
   let rec get_pattern_id pat =
-    match pat.CAst.v with
+    match DAst.get pat with
       | PatVar(Anonymous) -> assert false
       | PatVar(Name id) ->
 	  [id]
@@ -257,11 +189,11 @@ let get_pattern_id pat = raw_get_pattern_id pat []
 
 let rec alpha_rt excluded rt =
   let loc = rt.CAst.loc in
-  let new_rt = CAst.make ?loc @@
-    match rt.CAst.v with
+  let new_rt = DAst.make ?loc @@
+    match DAst.get rt with
       | GRef _ | GVar _ | GEvar _ | GPatVar _ as rt -> rt
       | GLambda(Anonymous,k,t,b) ->
-	  let new_id = Namegen.next_ident_away (Id.of_string "_x") excluded in
+	  let new_id = Namegen.next_ident_away (Id.of_string "_x") (Id.Set.of_list excluded) in
 	  let new_excluded = new_id :: excluded in
 	  let new_t = alpha_rt new_excluded t in
 	  let new_b = alpha_rt new_excluded b in
@@ -276,7 +208,7 @@ let rec alpha_rt excluded rt =
 	let new_c = alpha_rt excluded c in
 	GLetIn(Anonymous,new_b,new_t,new_c)
     | GLambda(Name id,k,t,b) ->
-	let new_id = Namegen.next_ident_away id excluded in
+	let new_id = Namegen.next_ident_away id (Id.Set.of_list excluded) in
 	let t,b =
 	  if Id.equal new_id id
 	  then t, b
@@ -289,7 +221,7 @@ let rec alpha_rt excluded rt =
 	let new_b = alpha_rt new_excluded b in
 	GLambda(Name new_id,k,new_t,new_b)
     | GProd(Name id,k,t,b) ->
-	let new_id = Namegen.next_ident_away id excluded in
+	let new_id = Namegen.next_ident_away id (Id.Set.of_list excluded) in
 	let new_excluded = new_id::excluded in
 	let t,b =
 	  if Id.equal new_id id
@@ -302,7 +234,7 @@ let rec alpha_rt excluded rt =
 	let new_b = alpha_rt new_excluded b in
 	GProd(Name new_id,k,new_t,new_b)
     | GLetIn(Name id,b,t,c) ->
-	let new_id = Namegen.next_ident_away id excluded in
+	let new_id = Namegen.next_ident_away id (Id.Set.of_list excluded) in
 	let c =
 	  if Id.equal new_id id then c
 	  else change_vars (Id.Map.add id new_id Id.Map.empty) c
@@ -320,7 +252,7 @@ let rec alpha_rt excluded rt =
 	       match na with
 		 | Anonymous -> (na::nal,excluded,mapping)
 		 | Name id ->
-		     let new_id = Namegen.next_ident_away id excluded in
+		     let new_id = Namegen.next_ident_away id (Id.Set.of_list excluded) in
 		     if Id.equal new_id id
 		     then
 		       na::nal,id::excluded,mapping
@@ -362,6 +294,7 @@ let rec alpha_rt excluded rt =
 	GApp(alpha_rt excluded f,
 	     List.map (alpha_rt excluded) args
 	    )
+    | GProj(p,c) -> GProj(p, alpha_rt excluded c)
   in
   new_rt
 
@@ -377,7 +310,7 @@ and alpha_br excluded (loc,(ids,patl,res)) =
    [is_free_in id rt] checks if [id] is a free variable in [rt]
 *)
 let is_free_in id =
-  let rec is_free_in x = CAst.with_loc_val (fun ?loc -> function
+  let rec is_free_in x = DAst.with_loc_val (fun ?loc -> function
     | GRef _ ->  false
     | GVar id' -> Id.compare id' id == 0
     | GEvar _ -> false
@@ -413,6 +346,7 @@ let is_free_in id =
     | GHole _ -> false
     | GCast (b,(CastConv t|CastVM t|CastNative t)) -> is_free_in b || is_free_in t
     | GCast (b,CastCoerce) -> is_free_in b
+    | GProj (_,c) -> is_free_in c
     ) x
   and is_free_in_br (_,(ids,_,rt)) =
     (not (Id.List.mem id ids)) && is_free_in rt
@@ -421,7 +355,7 @@ let is_free_in id =
 
 
 
-let rec pattern_to_term pt = CAst.with_val (function
+let rec pattern_to_term pt = DAst.with_val (function
   | PatVar Anonymous -> assert false
   | PatVar(Name id) ->
 	mkGVar id
@@ -448,8 +382,8 @@ let rec pattern_to_term pt = CAst.with_val (function
 
 
 let replace_var_by_term x_id term =
-  let rec replace_var_by_pattern x = CAst.map (function
-      | GVar id when Id.compare id x_id == 0 -> term.CAst.v
+  let rec replace_var_by_pattern x = DAst.map (function
+      | GVar id when Id.compare id x_id == 0 -> DAst.get term
       | GRef _
       | GVar _
       | GEvar _
@@ -506,6 +440,8 @@ let replace_var_by_term x_id term =
       | GCast(b,c) ->
 	  GCast(replace_var_by_pattern b,
 		Miscops.map_cast_type replace_var_by_pattern c)
+      | GProj(p,c) ->
+        GProj(p,replace_var_by_pattern c)
     ) x
   and replace_var_by_pattern_br ((loc,(idl,patl,res)) as br) =
     if List.exists (fun id -> Id.compare id x_id == 0) idl
@@ -522,11 +458,10 @@ exception NotUnifiable
 
 let rec are_unifiable_aux  = function
   | [] -> ()
-  | eq::eqs ->
-      let open CAst in
-      match eq with
-	 | { v = PatVar _ },_ | _, { v = PatVar _ } -> are_unifiable_aux eqs
-	 | { v = PatCstr(constructor1,cpl1,_) }, { v = PatCstr(constructor2,cpl2,_) } ->
+  | (l, r) ::eqs ->
+      match DAst.get l, DAst.get r with
+	 | PatVar _ ,_ | _, PatVar _-> are_unifiable_aux eqs
+	 | PatCstr(constructor1,cpl1,_), PatCstr(constructor2,cpl2,_) ->
 	     if not (eq_constructor constructor2 constructor1)
 	     then raise NotUnifiable
 	     else
@@ -545,11 +480,10 @@ let are_unifiable pat1 pat2 =
 
 let rec eq_cases_pattern_aux  = function
   | [] -> ()
-  | eq::eqs ->
-      let open CAst in
-      match eq with
-	 | { v = PatVar _ }, { v = PatVar _ } -> eq_cases_pattern_aux eqs
-	 | { v = PatCstr(constructor1,cpl1,_) }, { v = PatCstr(constructor2,cpl2,_) } ->
+  | (l, r) ::eqs ->
+      match DAst.get l, DAst.get r with
+	 | PatVar _, PatVar _ -> eq_cases_pattern_aux eqs
+	 | PatCstr(constructor1,cpl1,_), PatCstr(constructor2,cpl2,_) ->
 	     if not (eq_constructor constructor2 constructor1)
 	     then raise NotUnifiable
 	     else
@@ -569,7 +503,7 @@ let eq_cases_pattern pat1 pat2 =
 
 
 let ids_of_pat =
-  let rec ids_of_pat ids = CAst.with_val (function
+  let rec ids_of_pat ids = DAst.with_val (function
     | PatVar Anonymous -> ids
     | PatVar(Name id) -> Id.Set.add id ids
     | PatCstr(_,patl,_) -> List.fold_left ids_of_pat ids patl
@@ -577,112 +511,21 @@ let ids_of_pat =
   in
   ids_of_pat Id.Set.empty
 
-let id_of_name = function
-  | Anonymous -> Id.of_string "x"
-  | Name x -> x
-
-(* TODO: finish Rec caes *)
-let ids_of_glob_constr c =
-  let rec ids_of_glob_constr acc {loc; CAst.v = c} =
-    let idof = id_of_name in
-    match c with
-      | GVar id -> id::acc
-      | GApp (g,args) ->
-          ids_of_glob_constr [] g @ List.flatten (List.map (ids_of_glob_constr []) args) @ acc
-      | GLambda (na,k,ty,c) -> idof na :: ids_of_glob_constr [] ty @ ids_of_glob_constr [] c @ acc
-      | GProd (na,k,ty,c) -> idof na :: ids_of_glob_constr [] ty @ ids_of_glob_constr [] c @ acc
-      | GLetIn (na,b,t,c) -> idof na :: ids_of_glob_constr [] b @ Option.cata (ids_of_glob_constr []) [] t @ ids_of_glob_constr [] c @ acc
-      | GCast (c,(CastConv t|CastVM t|CastNative t)) -> ids_of_glob_constr [] c @ ids_of_glob_constr [] t @ acc
-      | GCast (c,CastCoerce) -> ids_of_glob_constr [] c @ acc
-      | GIf (c,(na,po),b1,b2) -> ids_of_glob_constr [] c @ ids_of_glob_constr [] b1 @ ids_of_glob_constr [] b2 @ acc
-      | GLetTuple (nal,(na,po),b,c) ->
-          List.map idof nal @ ids_of_glob_constr [] b @ ids_of_glob_constr [] c @ acc
-      | GCases (sty,rtntypopt,tml,brchl) ->
-	  List.flatten (List.map (fun (_,(idl,patl,c)) -> idl @ ids_of_glob_constr [] c) brchl)
-      | GRec _ -> failwith "Fix inside a constructor branch"
-      | (GSort _ | GHole _ | GRef _ | GEvar _ | GPatVar _) -> []
-  in
-  (* build the set *)
-  List.fold_left (fun acc x -> Id.Set.add x acc) Id.Set.empty (ids_of_glob_constr [] c)
-
-
-
-
-
-let zeta_normalize =
-  let rec zeta_normalize_term x = CAst.map (function
-      | GRef _
-      | GVar _
-      | GEvar _
-      | GPatVar _ as rt -> rt
-      | GApp(rt',rtl) ->
-	  GApp(zeta_normalize_term rt',
-	       List.map zeta_normalize_term rtl
-	      )
-      | GLambda(name,k,t,b) ->
-	  GLambda(name,
-		  k,
-		  zeta_normalize_term t,
-		  zeta_normalize_term b
-		 )
-      | GProd(name,k,t,b) ->
-	  GProd(name,
-	        k,
-		zeta_normalize_term t,
-		zeta_normalize_term b
-		 )
-      | GLetIn(Name id,def,typ,b) ->
-	  (zeta_normalize_term (replace_var_by_term id def b)).CAst.v
-      | GLetIn(Anonymous,def,typ,b) ->
-          (zeta_normalize_term b).CAst.v
-      | GLetTuple(nal,(na,rto),def,b) ->
-	  GLetTuple(nal,
-		    (na,Option.map zeta_normalize_term rto),
-		    zeta_normalize_term def,
-		    zeta_normalize_term b
-		   )
-      | GCases(sty,infos,el,brl) ->
-	  GCases(sty,
-		 infos,
-		 List.map (fun (e,x) -> (zeta_normalize_term e,x)) el,
-		 List.map zeta_normalize_br brl
-		)
-      | GIf(b,(na,e_option),lhs,rhs) ->
-	  GIf(zeta_normalize_term b,
-	      (na,Option.map zeta_normalize_term e_option),
-	      zeta_normalize_term lhs,
-	      zeta_normalize_term rhs
-	     )
-      | GRec _ -> raise (UserError(None,str "Not handled GRec"))
-      | GSort _
-      | GHole _ as rt -> rt
-      | GCast(b,c) ->
-	  GCast(zeta_normalize_term b,
-                Miscops.map_cast_type zeta_normalize_term c)
-    ) x
-  and zeta_normalize_br (loc,(idl,patl,res)) =
-    (loc,(idl,patl,zeta_normalize_term res))
-  in
-  zeta_normalize_term
-
-
-
-
 let expand_as =
 
-  let rec add_as map ({loc; CAst.v = pat } as rt) =
-    match pat with
+  let rec add_as map rt =
+    match DAst.get rt with
       | PatVar _ -> map
       | PatCstr(_,patl,Name id) ->
 	  Id.Map.add id (pattern_to_term rt) (List.fold_left add_as map patl)
       | PatCstr(_,patl,_) -> List.fold_left add_as map patl
   in
-  let rec expand_as map = CAst.map (function
+  let rec expand_as map = DAst.map (function
       | GRef _ | GEvar _ | GPatVar _ | GSort _ | GHole _ as rt -> rt
       | GVar id as rt ->
 	  begin
 	    try
-	      (Id.Map.find id map).CAst.v
+	      DAst.get (Id.Map.find id map)
 	    with Not_found -> rt
 	  end
       | GApp(f,args) -> GApp(expand_as map f,List.map (expand_as map) args)
@@ -702,6 +545,7 @@ let expand_as =
       | GCases(sty,po,el,brl) ->
 	  GCases(sty, Option.map (expand_as map) po, List.map (fun (rt,t) -> expand_as map rt,t) el,
 		List.map (expand_as_br map) brl)
+      | GProj(p,c) -> GProj(p, expand_as map c)
     )
   and expand_as_br map (loc,(idl,cpl,rt)) =
     (loc,(idl,cpl, expand_as (List.fold_left add_as map cpl) rt))
@@ -718,12 +562,12 @@ let resolve_and_replace_implicits ?(flags=Pretyping.all_and_fail_flags) ?(expect
   (* we first (pseudo) understand [rt] and get back the computed evar_map *)
   (* FIXME : JF (30/03/2017) I'm not completely sure to have split understand as needed. 
 If someone knows how to prevent solved existantial removal in  understand, please do not hesitate to change the computation of [ctx] here *) 
-  let ctx,_ = Pretyping.ise_pretype_gen flags env sigma Glob_ops.empty_lvar expected_type rt in
+  let ctx,_,_ = Pretyping.ise_pretype_gen flags env sigma Glob_ops.empty_lvar expected_type rt in
   let ctx, f = Evarutil.nf_evars_and_universes ctx in
 
   (* then we map [rt] to replace the implicit holes by their values *)
   let rec change rt =
-    match rt.CAst.v with
+    match DAst.get rt with
     | GHole(ImplicitArg(grk,pk,bk),_,_) -> (* we only want to deal with implicit arguments *)
        (
          try (* we scan the new evar map to find the evar corresponding to this hole (by looking the source *)
@@ -743,7 +587,7 @@ If someone knows how to prevent solved existantial removal in  understand, pleas
            match evi.evar_body with
            | Evar_defined c ->
            (* we just have to lift the solution in glob_term *)
-              Detyping.detype false [] env ctx (EConstr.of_constr (f c))
+              Detyping.detype Detyping.Now false Id.Set.empty env ctx (EConstr.of_constr (f c))
            | Evar_empty -> rt (* the hole was not solved : we do nothing *)
        )
     | (GHole(BinderType na,_,_)) -> (* we only want to deal with implicit arguments *)
@@ -765,7 +609,7 @@ If someone knows how to prevent solved existantial removal in  understand, pleas
                 match evi.evar_body with
                 | Evar_defined c ->
                    (* we just have to lift the solution in glob_term *)
-                   Detyping.detype false [] env ctx (EConstr.of_constr (f c))
+                   Detyping.detype Detyping.Now false Id.Set.empty env ctx (EConstr.of_constr (f c))
                 | Evar_empty -> rt (* the hole was not solved : we d when falseo nothing *)
          in 
          res
diff --git a/plugins/funind/glob_termops.mli b/plugins/funind/glob_termops.mli
index 99a258de9..7088ae596 100644
--- a/plugins/funind/glob_termops.mli
+++ b/plugins/funind/glob_termops.mli
@@ -1,6 +1,5 @@
 open Names
 open Glob_term
-open Misctypes
 
 (* [get_pattern_id pat] returns a list of all the variable appearing in [pat] *)
 val get_pattern_id : cases_pattern -> Id.t list
@@ -21,22 +20,11 @@ val mkGLambda : Name.t * glob_constr * glob_constr -> glob_constr
 val mkGProd : Name.t * glob_constr * glob_constr -> glob_constr
 val mkGLetIn : Name.t * glob_constr * glob_constr option * glob_constr -> glob_constr
 val mkGCases : glob_constr option * tomatch_tuples * cases_clauses -> glob_constr
-val mkGSort : glob_sort -> glob_constr
 val mkGHole : unit -> glob_constr (* we only build Evd.BinderType Anonymous holes *)
-val mkGCast : glob_constr* glob_constr -> glob_constr
 (*
   Some basic functions to decompose glob_constrs
   These are analogous to the ones constrs
 *)
-val glob_decompose_prod : glob_constr -> (Name.t*glob_constr) list * glob_constr
-val glob_decompose_prod_or_letin :
-  glob_constr -> (Name.t*glob_constr option*glob_constr option) list * glob_constr
-val glob_decompose_prod_n : int -> glob_constr -> (Name.t*glob_constr) list * glob_constr
-val glob_decompose_prod_or_letin_n : int -> glob_constr ->
-  (Name.t*glob_constr option*glob_constr option) list * glob_constr
-val glob_compose_prod : glob_constr -> (Name.t*glob_constr) list  ->  glob_constr
-val glob_compose_prod_or_letin: glob_constr ->
-  (Name.t*glob_constr option*glob_constr option) list  ->  glob_constr
 val glob_decompose_app : glob_constr -> glob_constr*(glob_constr list)
 
 
@@ -44,14 +32,6 @@ val glob_decompose_app : glob_constr -> glob_constr*(glob_constr list)
 val  glob_make_eq : ?typ:glob_constr -> glob_constr -> glob_constr -> glob_constr
 (* [glob_make_neq t1 t2] build the glob_constr corresponding to [t1 <> t2] *)
 val  glob_make_neq : glob_constr -> glob_constr -> glob_constr
-(* [glob_make_or P1 P2] build the glob_constr corresponding to [P1 \/ P2] *)
-val  glob_make_or : glob_constr -> glob_constr -> glob_constr
-
-(* [glob_make_or_list [P1;...;Pn]] build the glob_constr corresponding
-   to [P1 \/ ( .... \/ Pn)]
-*)
-val  glob_make_or_list : glob_constr list -> glob_constr
-
 
 (* alpha_conversion functions *)
 
@@ -109,18 +89,8 @@ val eq_cases_pattern : cases_pattern -> cases_pattern -> bool
 *)
 val   ids_of_pat : cases_pattern -> Id.Set.t
 
-(* TODO: finish this function (Fix not treated) *)
-val ids_of_glob_constr: glob_constr -> Id.Set.t
-
-(*
-   removing let_in construction in a glob_constr
-*)
-val zeta_normalize : Glob_term.glob_constr -> Glob_term.glob_constr
-
-
 val expand_as : glob_constr -> glob_constr
 
-
 (* [resolve_and_replace_implicits ?expected_type env sigma rt] solves implicits of [rt] w.r.t. [env] and [sigma] and then replace them by their solution 
  *)
 val resolve_and_replace_implicits :
diff --git a/plugins/funind/indfun.ml b/plugins/funind/indfun.ml
index 8769f5668..e19fc9b62 100644
--- a/plugins/funind/indfun.ml
+++ b/plugins/funind/indfun.ml
@@ -1,7 +1,8 @@
 open CErrors
+open Sorts
 open Util
 open Names
-open Term
+open Constr
 open EConstr
 open Pp
 open Indfun_common
@@ -46,7 +47,7 @@ let functional_induction with_clean c princl pat =
 		  try find_Function_infos c'
 		  with Not_found ->
 		    user_err  (str "Cannot find induction information on "++
-				       Printer.pr_leconstr (mkConst c') )
+                                       Printer.pr_leconstr_env (Tacmach.pf_env g) sigma (mkConst c') )
 		in
 		match Tacticals.elimination_sort_of_goal g with
 		| InProp -> finfo.prop_lemma
@@ -74,7 +75,7 @@ let functional_induction with_clean c princl pat =
 		    (* mkConst(const_of_id princ_name ),g (\* FIXME *\) *)
 		  with Not_found -> (* This one is neither defined ! *)
 		    user_err  (str "Cannot find induction principle for "
-				     ++Printer.pr_leconstr (mkConst c') )
+                                     ++ Printer.pr_leconstr_env (Tacmach.pf_env g) sigma (mkConst c') )
 	      in
 	      let princ = EConstr.of_constr princ in
 	      (princ,NoBindings,Tacmach.pf_unsafe_type_of g' princ,g')
@@ -154,11 +155,11 @@ let build_newrecursive
   let sigma = Evd.from_env env0 in
   let (rec_sign,rec_impls) =
     List.fold_left
-      (fun (env,impls) (((_,recname),_),bl,arityc,_) ->
+      (fun (env,impls) (({CAst.v=recname},_),bl,arityc,_) ->
         let arityc = Constrexpr_ops.mkCProdN bl arityc in
         let arity,ctx = Constrintern.interp_type env0 sigma arityc in
-	let evdref = ref (Evd.from_env env0) in
-	let _, (_, impls') = Constrintern.interp_context_evars env evdref bl in
+        let evd = Evd.from_env env0 in
+        let evd, (_, (_, impls')) = Constrintern.interp_context_evars env evd bl in
 	let impl = Constrintern.compute_internalization_data env0 Constrintern.Recursive arity impls' in
         let open Context.Named.Declaration in
         (Environ.push_named (LocalAssum (recname,arity)) env, Id.Map.add recname impl impls))
@@ -191,7 +192,7 @@ let error msg = user_err Pp.(str msg)
 let is_rec names =
   let names = List.fold_right Id.Set.add names Id.Set.empty in
   let check_id id names =  Id.Set.mem id names in
-  let rec lookup names gt = match gt.CAst.v with
+  let rec lookup names gt = match DAst.get gt with
     | GVar(id) -> check_id id names
     | GRef _ | GEvar _ | GPatVar _ | GSort _ |  GHole _ -> false
     | GCast(b,_) -> lookup names b
@@ -214,6 +215,7 @@ let is_rec names =
     | GCases(_,_,el,brl) ->
 	List.exists (fun (e,_) -> lookup names e) el ||
 	  List.exists (lookup_br names) brl
+    | GProj(_,c) -> lookup names c
   and lookup_br names (_,(idl,_,rt)) =
     let new_names = List.fold_right Id.Set.remove idl names in
     lookup new_names rt
@@ -281,7 +283,6 @@ let derive_inversion fix_names =
       in
       Invfun.derive_correctness
 	Functional_principles_types.make_scheme
-	functional_induction
 	fix_names_as_constant
 	lind;
       with e when CErrors.noncritical e ->
@@ -343,7 +344,7 @@ let generate_principle (evd:Evd.evar_map ref) pconstants on_error
     is_general do_built (fix_rec_l:(Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list) list) recdefs  interactive_proof
     (continue_proof : int -> Names.Constant.t array -> EConstr.constr array -> int ->
       Tacmach.tactic) : unit =
-  let names = List.map (function (((_, name),_),_,_,_,_),_ -> name) fix_rec_l in
+  let names = List.map (function (({CAst.v=name},_),_,_,_,_),_ -> name) fix_rec_l in
   let fun_bodies = List.map2 prepare_body fix_rec_l recdefs in
   let funs_args = List.map fst fun_bodies in
   let funs_types =  List.map (function ((_,_,_,types,_),_) -> types) fix_rec_l in
@@ -364,7 +365,7 @@ let generate_principle (evd:Evd.evar_map ref) pconstants on_error
 		 f_R_mut)
 	in
 	let fname_kn (((fname,_),_,_,_,_),_) =
-	  let f_ref = Ident fname in
+          let f_ref = Ident CAst.(with_loc_val (fun ?loc n -> (loc,n)) fname) in
 	  locate_with_msg
 	    (pr_reference f_ref++str ": Not an inductive type!")
 	    locate_constant
@@ -403,15 +404,16 @@ let generate_principle (evd:Evd.evar_map ref) pconstants on_error
 
 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 ->
+    | [(({CAst.v=fname},pl),_,bl,ret_type,body),_] when not is_rec ->
       let body = match body with | Some body -> body | None -> user_err ~hdr:"Function" (str "Body of Function must be given") in 
-      Command.do_definition
+      ComDefinition.do_definition
+        ~program_mode:false
 	fname
 	(Decl_kinds.Global,(Flags.is_universe_polymorphism ()),Decl_kinds.Definition) pl
 	bl None body (Some ret_type) (Lemmas.mk_hook (fun _ _ -> ()));
        let evd,rev_pconstants =
 	 List.fold_left
-	   (fun (evd,l) ((((_,fname),_),_,_,_,_),_) ->
+           (fun (evd,l) ((({CAst.v=fname},_),_,_,_,_),_) ->
 	    let evd,c =
 	      Evd.fresh_global
 		(Global.env ()) evd (Constrintern.locate_reference (Libnames.qualid_of_ident fname)) in
@@ -425,10 +427,10 @@ let register_struct is_rec (fixpoint_exprl:(Vernacexpr.fixpoint_expr * Vernacexp
        in
        evd,List.rev rev_pconstants
     | _ ->
-       Command.do_fixpoint Global (Flags.is_universe_polymorphism ()) fixpoint_exprl;
+       ComFixpoint.do_fixpoint Global (Flags.is_universe_polymorphism ()) fixpoint_exprl;
        let evd,rev_pconstants =
 	 List.fold_left
-	   (fun (evd,l) ((((_,fname),_),_,_,_,_),_) ->
+           (fun (evd,l) ((({CAst.v=fname},_),_,_,_,_),_) ->
 	    let evd,c =
 	      Evd.fresh_global
 		(Global.env ()) evd (Constrintern.locate_reference (Libnames.qualid_of_ident fname)) in
@@ -458,7 +460,7 @@ let register_wf ?(is_mes=false) fname rec_impls wf_rel_expr wf_arg using_lemmas
   let rec_arg_num =
     let names =
       List.map
-	snd
+        CAst.(with_val (fun x -> x))
 	(Constrexpr_ops.names_of_local_assums args)
     in
     match wf_arg with
@@ -474,8 +476,8 @@ let register_wf ?(is_mes=false) fname rec_impls wf_rel_expr wf_arg using_lemmas
 	 (None,(Ident (Loc.tag fname)),None) ,
 	 (List.map
 	    (function
-	       | _,Anonymous -> assert false
-	       | _,Name e -> (Constrexpr_ops.mkIdentC e)
+               | {CAst.v=Anonymous} -> assert false
+               | {CAst.v=Name e} -> (Constrexpr_ops.mkIdentC e)
 	    )
 	    (Constrexpr_ops.names_of_local_assums args)
 	 )
@@ -513,7 +515,7 @@ let register_mes fname rec_impls wf_mes_expr wf_rel_expr_opt wf_arg using_lemmas
       | None ->
 	  begin
 	    match args with
-	      | [Constrexpr.CLocalAssum ([(_,Name x)],k,t)] -> t,x
+              | [Constrexpr.CLocalAssum ([{CAst.v=Name x}],k,t)] -> t,x
 	      | _ -> error "Recursive argument must be specified"
 	  end
       | Some wf_args ->
@@ -523,7 +525,7 @@ let register_mes fname rec_impls wf_mes_expr wf_rel_expr_opt wf_arg using_lemmas
 		(function
 		   | Constrexpr.CLocalAssum(l,k,t) ->
 		       List.exists
-			 (function (_,Name id) -> Id.equal id wf_args | _ -> false)
+                         (function {CAst.v=Name id} -> Id.equal id wf_args | _ -> false)
 			 l
 		   | _ -> false
 		)
@@ -544,7 +546,7 @@ let register_mes fname rec_impls wf_mes_expr wf_rel_expr_opt wf_arg using_lemmas
 	  let fun_from_mes =
 	    let applied_mes =
 	      Constrexpr_ops.mkAppC(wf_mes_expr,[Constrexpr_ops.mkIdentC wf_arg])    in
-	    Constrexpr_ops.mkLambdaC ([(Loc.tag @@ Name wf_arg)],Constrexpr_ops.default_binder_kind,wf_arg_type,applied_mes)
+            Constrexpr_ops.mkLambdaC ([CAst.make @@ Name wf_arg],Constrexpr_ops.default_binder_kind,wf_arg_type,applied_mes)
 	  in
 	  let wf_rel_from_mes =
 	    Constrexpr_ops.mkAppC(Constrexpr_ops.mkRefC  ltof,[wf_arg_type;fun_from_mes])
@@ -555,7 +557,7 @@ let register_mes fname rec_impls wf_mes_expr wf_rel_expr_opt wf_arg using_lemmas
 	    let a = Names.Id.of_string "___a" in 
 	    let b = Names.Id.of_string "___b" in 
 	    Constrexpr_ops.mkLambdaC(
-	      [Loc.tag @@ Name a;Loc.tag @@ Name b],
+              [CAst.make @@ Name a; CAst.make @@ Name b],
 	      Constrexpr.Default Explicit,
 	      wf_arg_type,
 	      Constrexpr_ops.mkAppC(wf_rel_expr,
@@ -589,11 +591,11 @@ and rebuild_nal aux bk bl' nal typ =
 	match nal,typ with 
 	  | _,{ CAst.v = CProdN([],typ) } -> rebuild_nal aux bk bl' nal typ
 	  | [], _ -> rebuild_bl aux bl' typ
-	  | na::nal,{ CAst.v = CProdN((na'::nal',bk',nal't)::rest,typ') } ->
-	     if Name.equal (snd na) (snd na') || Name.is_anonymous (snd na')
+          | na::nal,{ CAst.v = CProdN(CLocalAssum(na'::nal',bk',nal't)::rest,typ') } ->
+             if Name.equal (na.CAst.v) (na'.CAst.v) || Name.is_anonymous (na'.CAst.v)
 	     then
 	       let assum = CLocalAssum([na],bk,nal't) in
-	       let new_rest = if nal' = [] then rest else ((nal',bk',nal't)::rest) in 
+               let new_rest = if nal' = [] then rest else (CLocalAssum(nal',bk',nal't)::rest) in
 	       rebuild_nal
 		 (assum::aux)
 		 bk
@@ -602,7 +604,7 @@ and rebuild_nal aux bk bl' nal typ =
 		 (CAst.make @@ CProdN(new_rest,typ'))
 	     else
 	       let assum = CLocalAssum([na'],bk,nal't) in
-	       let new_rest = if nal' = [] then rest else ((nal',bk',nal't)::rest) in 
+               let new_rest = if nal' = [] then rest else (CLocalAssum(nal',bk',nal't)::rest) in
 	       rebuild_nal
 		 (assum::aux)
 		 bk
@@ -615,8 +617,8 @@ and rebuild_nal aux bk bl' nal typ =
 let rebuild_bl aux bl typ = rebuild_bl aux bl typ
 
 let recompute_binder_list (fixpoint_exprl : (Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list) list) = 
-  let fixl,ntns = Command.extract_fixpoint_components false fixpoint_exprl in
-  let ((_,_,typel),_,ctx,_) = Command.interp_fixpoint fixl ntns in
+  let fixl,ntns = ComFixpoint.extract_fixpoint_components false fixpoint_exprl in
+  let ((_,_,typel),_,ctx,_) = ComFixpoint.interp_fixpoint ~cofix:false fixl ntns in
   let constr_expr_typel = 
     with_full_print (List.map (fun c -> Constrextern.extern_constr false (Global.env ()) (Evd.from_ctx ctx) (EConstr.of_constr c))) typel in
   let fixpoint_exprl_with_new_bl = 
@@ -636,7 +638,7 @@ let do_generate_principle pconstants on_error register_built interactive_proof
   let _is_struct =
     match fixpoint_exprl with
       | [((_,(wf_x,Constrexpr.CWfRec wf_rel),_,_,_),_) as fixpoint_expr] ->
- 	  let (((((_,name),pl),_,args,types,body)),_)  as fixpoint_expr =
+          let (((({CAst.v=name},pl),_,args,types,body)),_)  as fixpoint_expr =
 	    match recompute_binder_list [fixpoint_expr] with 
 	      | [e] -> e
 	      | _ -> assert false
@@ -657,10 +659,10 @@ let do_generate_principle pconstants on_error register_built interactive_proof
 	      true
 	  in
 	  if register_built
-	  then register_wf name rec_impls wf_rel (map_option snd wf_x) using_lemmas args types body pre_hook;
+          then register_wf name rec_impls wf_rel (map_option (fun x -> x.CAst.v) wf_x) using_lemmas args types body pre_hook;
 	  false
       |[((_,(wf_x,Constrexpr.CMeasureRec(wf_mes,wf_rel_opt)),_,_,_),_) as fixpoint_expr] ->
- 	  let (((((_,name),_),_,args,types,body)),_)  as fixpoint_expr =
+          let (((({CAst.v=name},_),_,args,types,body)),_)  as fixpoint_expr =
 	    match recompute_binder_list [fixpoint_expr] with 
 	      | [e] -> e
 	      | _ -> assert false
@@ -681,7 +683,7 @@ let do_generate_principle pconstants on_error register_built interactive_proof
 	      true
 	  in
 	  if register_built
-	  then register_mes name rec_impls wf_mes wf_rel_opt (map_option snd wf_x) using_lemmas args types body pre_hook;
+          then register_mes name rec_impls wf_mes wf_rel_opt (map_option (fun x -> x.CAst.v) wf_x) using_lemmas args types body pre_hook;
 	  true
       | _ ->
 	  List.iter (function ((_na,(_,ord),_args,_body,_type),_not) ->
@@ -694,7 +696,7 @@ let do_generate_principle pconstants on_error register_built interactive_proof
 	    fixpoint_exprl;
 	let fixpoint_exprl = recompute_binder_list fixpoint_exprl in 
 	let fix_names =
-	  List.map (function ((((_,name),_),_,_,_,_),_) -> name) fixpoint_exprl
+          List.map (function ((({CAst.v=name},_),_,_,_,_),_) -> name) fixpoint_exprl
 	in
 	(* ok all the expressions are structural *)
   	let recdefs,rec_impls = build_newrecursive fixpoint_exprl in
@@ -729,10 +731,14 @@ let rec add_args id new_args = CAst.map (function
       end
   | CFix  _  | CCoFix _ -> anomaly ~label:"add_args " (Pp.str "todo.")
   | CProdN(nal,b1) ->
-        CProdN(List.map (fun (nal,k,b2) -> (nal,k,add_args id new_args b2)) nal,
+        CProdN(List.map (function  CLocalAssum (nal,k,b2) -> CLocalAssum (nal,k,add_args id new_args b2)
+                                 | CLocalDef (na,b1,t) -> CLocalDef (na,add_args id new_args b1,Option.map (add_args id new_args) t)
+                                 | CLocalPattern _ -> user_err (Pp.str "pattern with quote not allowed here.")) nal,
 	     add_args id new_args  b1)
   | CLambdaN(nal,b1) ->
-      CLambdaN(List.map (fun (nal,k,b2) -> (nal,k,add_args id new_args  b2)) nal,
+      CLambdaN(List.map (function  CLocalAssum (nal,k,b2) -> CLocalAssum (nal,k,add_args id new_args b2)
+                                 | CLocalDef (na,b1,t) -> CLocalDef (na,add_args id new_args b1,Option.map (add_args id new_args) t)
+                                 | CLocalPattern _ -> user_err (Pp.str "pattern with quote not allowed here.")) nal,
 	       add_args id new_args  b1)
   | CLetIn(na,b1,t,b2) ->
       CLetIn(na,add_args id new_args b1,Option.map (add_args id new_args) t,add_args id new_args b2)
@@ -751,7 +757,7 @@ let rec add_args id new_args = CAst.map (function
 	     List.map (fun (b,na,b_option) ->
 			 add_args id new_args b,
 			 na, b_option) cel,
-	     List.map (fun (loc,(cpl,e)) -> Loc.tag ?loc @@ (cpl,add_args id new_args e)) cal
+             List.map CAst.(map (fun (cpl,e) -> (cpl,add_args id new_args e))) cal
 	    )
   | CLetTuple(nal,(na,b_option),b1,b2) ->
       CLetTuple(nal,(na,Option.map (add_args id new_args) b_option),
@@ -778,6 +784,7 @@ let rec add_args id new_args = CAst.map (function
   | CNotation _ -> anomaly ~label:"add_args " (Pp.str "CNotation.")
   | CGeneralization _ -> anomaly ~label:"add_args " (Pp.str "CGeneralization.")
   | CDelimiters _ -> anomaly ~label:"add_args " (Pp.str "CDelimiters.")
+  | CProj _ -> user_err Pp.(str "Funind does not support primitive projections")
   )
 exception Stop of  Constrexpr.constr_expr
 
@@ -790,7 +797,7 @@ let rec chop_n_arrow n t =
   then t (* If we have already removed all the arrows then return the type *)
   else (* If not we check the form of [t] *)
     match t.CAst.v with
-      | Constrexpr.CProdN(nal_ta',t') -> (* If we have a forall, to result are possible :
+      | Constrexpr.CProdN(nal_ta',t') -> (* If we have a forall, two results are possible :
 					     either we need to discard more than the number of arrows contained
 					     in this product declaration then we just recall [chop_n_arrow] on
 					     the remaining number of arrow to chop and [t'] we discard it and
@@ -802,7 +809,7 @@ let rec chop_n_arrow n t =
 	      let new_n =
 		let rec aux (n:int) = function
 		    [] -> n
-		| (nal,k,t'')::nal_ta' ->
+                | CLocalAssum(nal,k,t'')::nal_ta' ->
 		    let nal_l = List.length nal in
 		    if n >= nal_l
 		    then
@@ -810,9 +817,10 @@ let rec chop_n_arrow n t =
 		    else
 		      let new_t' = CAst.make @@
 			Constrexpr.CProdN(
-					((snd (List.chop n nal)),k,t'')::nal_ta',t')
+                                        CLocalAssum((snd (List.chop n nal)),k,t'')::nal_ta',t')
 		      in
 		      raise (Stop new_t')
+                | _ -> anomaly (Pp.str "Not enough products.")
 		in
 		aux n nal_ta'
 	    in
@@ -825,28 +833,26 @@ let rec chop_n_arrow n t =
 let rec get_args b t : Constrexpr.local_binder_expr list *
     Constrexpr.constr_expr * Constrexpr.constr_expr =
   match b.CAst.v with
-    | Constrexpr.CLambdaN ((nal_ta), b') ->
+    | Constrexpr.CLambdaN (CLocalAssum(nal,k,ta) as d::rest, b') ->
 	begin
-	  let n =
-	    (List.fold_left (fun n (nal,_,_) ->
-			       n+List.length nal) 0 nal_ta )
-	  in
-	  let nal_tas,b'',t'' = get_args b' (chop_n_arrow n t) in
-	  (List.map (fun (nal,k,ta) ->
-		       (Constrexpr.CLocalAssum (nal,k,ta))) nal_ta)@nal_tas, b'',t''
+          let n = List.length nal in
+          let nal_tas,b'',t'' = get_args (CAst.make ?loc:b.CAst.loc @@ Constrexpr.CLambdaN (rest,b')) (chop_n_arrow n t) in
+          d :: nal_tas, b'',t''
 	end
+    | Constrexpr.CLambdaN ([], b) -> [],b,t
     | _ -> [],b,t
 
 
 let make_graph (f_ref:global_reference) =
   let c,c_body =
     match f_ref with
-      | ConstRef c ->
-	  begin try c,Global.lookup_constant c
-	  with Not_found ->
-	    raise (UserError (None,str "Cannot find " ++ Printer.pr_leconstr (mkConst c)) )
-	  end
-      | _ -> raise (UserError (None, str "Not a function reference") )
+    | ConstRef c ->
+      begin try c,Global.lookup_constant c
+        with Not_found ->
+          let sigma, env = Pfedit.get_current_context () in
+          raise (UserError (None,str "Cannot find " ++ Printer.pr_leconstr_env env sigma (mkConst c)) )
+      end
+    | _ -> 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!"
@@ -869,7 +875,7 @@ let make_graph (f_ref:global_reference) =
 		 let l =
 		   List.map
 		     (fun (id,(n,recexp),bl,t,b) ->
-			let loc, rec_id = Option.get n in
+                        let { CAst.loc; v=rec_id } = Option.get n in
 			let new_args =
 			  List.flatten
 			    (List.map
@@ -877,7 +883,7 @@ let make_graph (f_ref:global_reference) =
 				  | Constrexpr.CLocalDef (na,_,_)-> []
 				  | Constrexpr.CLocalAssum (nal,_,_) ->
 				      List.map
-					(fun (loc,n) -> CAst.make ?loc @@ 
+                                        (fun {CAst.loc;v=n} -> CAst.make ?loc @@
 					   CRef(Libnames.Ident(loc, Nameops.Name.get_id n),None))
 					nal
                                   | Constrexpr.CLocalPattern _ -> assert false
@@ -885,21 +891,21 @@ let make_graph (f_ref:global_reference) =
 			       nal_tas
 			    )
 			in
-			let b' = add_args (snd id) new_args b in
-			((((id,None), ( Some (Loc.tag rec_id),CStructRec),nal_tas@bl,t,Some b'),[]):(Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list))
+                        let b' = add_args id.CAst.v new_args b in
+                        ((((id,None), ( Some CAst.(make rec_id),CStructRec),nal_tas@bl,t,Some b'),[]):(Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list))
 		     )
 		     fixexprl
 		 in
 		 l
 	     | _ ->
 		let id = Label.to_id (Constant.label c) in
-		 [(((Loc.tag id),None),(None,Constrexpr.CStructRec),nal_tas,t,Some b),[]]
+                 [((CAst.make id,None),(None,Constrexpr.CStructRec),nal_tas,t,Some b),[]]
 	 in
 	 let mp,dp,_ = Constant.repr3 c in
 	 do_generate_principle [c,Univ.Instance.empty] error_error  false false expr_list;
 	 (* We register the infos *)
 	 List.iter
-	   (fun ((((_,id),_),_,_,_,_),_) -> add_Function false (Constant.make3 mp dp (Label.of_id id)))
+           (fun ((({CAst.v=id},_),_,_,_,_),_) -> add_Function false (Constant.make3 mp dp (Label.of_id id)))
 	   expr_list)
 
 let do_generate_principle = do_generate_principle [] warning_error true
diff --git a/plugins/funind/indfun_common.ml b/plugins/funind/indfun_common.ml
index f4f9ba2bb..d6fd2f2a0 100644
--- a/plugins/funind/indfun_common.ml
+++ b/plugins/funind/indfun_common.ml
@@ -1,8 +1,10 @@
 open Names
 open Pp
+open Constr
 open Libnames
 open Globnames
 open Refiner
+
 let mk_prefix pre id = Id.of_string (pre^(Id.to_string id))
 let mk_rel_id = mk_prefix "R_"
 let mk_correct_id id = Nameops.add_suffix (mk_rel_id id) "_correct"
@@ -12,7 +14,7 @@ let mk_equation_id id = Nameops.add_suffix id "_equation"
 let msgnl m =
   ()
 
-let fresh_id avoid s = Namegen.next_ident_away_in_goal (Id.of_string s) avoid
+let fresh_id avoid s = Namegen.next_ident_away_in_goal (Id.of_string s) (Id.Set.of_list avoid)
 
 let fresh_name avoid s = Name (fresh_id avoid s)
 
@@ -66,7 +68,7 @@ let chop_rlambda_n  =
       if n == 0
       then List.rev acc,rt
       else
-	match rt.CAst.v with
+	match DAst.get rt with
 	  | Glob_term.GLambda(name,k,t,b) -> chop_lambda_n ((name,t,None)::acc) (n-1) b
 	  | Glob_term.GLetIn(name,v,t,b) -> chop_lambda_n ((name,v,t)::acc) (n-1) b
 	  | _ ->
@@ -80,7 +82,7 @@ let chop_rprod_n  =
       if n == 0
       then List.rev acc,rt
       else
-	match rt.CAst.v with
+	match DAst.get rt with
 	  | Glob_term.GProd(name,k,t,b) -> chop_prod_n ((name,t)::acc) (n-1) b
 	  | _ -> raise (CErrors.UserError(Some "chop_rprod_n",str "chop_rprod_n: Not enough products"))
   in
@@ -111,7 +113,7 @@ let const_of_id id =
       (str "cannot find " ++ Id.print id)
 
 let def_of_const t =
-   match (Term.kind_of_term t) with
+   match Constr.kind t with
     Term.Const sp ->
       (try (match Environ.constant_opt_value_in (Global.env()) sp with
              | Some c -> c
@@ -181,12 +183,13 @@ let with_full_print f a =
   and old_contextual_implicit_args = Impargs.is_contextual_implicit_args () in
   let old_rawprint = !Flags.raw_print in
   let old_printuniverses = !Constrextern.print_universes in
+  let old_printallowmatchdefaultclause = !Detyping.print_allow_match_default_clause in
   Constrextern.print_universes := true;
+  Detyping.print_allow_match_default_clause := false;
   Flags.raw_print := true;
   Impargs.make_implicit_args false;
   Impargs.make_strict_implicit_args false;
   Impargs.make_contextual_implicit_args false;
-  Impargs.make_contextual_implicit_args false;
   Dumpglob.pause ();
   try
     let res = f a in
@@ -195,6 +198,7 @@ let with_full_print f a =
     Impargs.make_contextual_implicit_args old_contextual_implicit_args;
     Flags.raw_print := old_rawprint;
     Constrextern.print_universes := old_printuniverses;
+    Detyping.print_allow_match_default_clause := old_printallowmatchdefaultclause;
     Dumpglob.continue ();
     res
   with
@@ -204,6 +208,7 @@ let with_full_print f a =
 	Impargs.make_contextual_implicit_args old_contextual_implicit_args;
 	Flags.raw_print := old_rawprint;
 	Constrextern.print_universes := old_printuniverses;
+        Detyping.print_allow_match_default_clause := old_printallowmatchdefaultclause;
 	Dumpglob.continue ();
 	raise reraise
 
@@ -330,18 +335,18 @@ let discharge_Function (_,finfos) =
 	   is_general = finfos.is_general
 	 }
 
-open Term
-
 let pr_ocst c =
-  Option.fold_right (fun v acc -> Printer.pr_lconstr (mkConst v)) c (mt ())
+  let sigma, env = Pfedit.get_current_context () in
+  Option.fold_right (fun v acc -> Printer.pr_lconstr_env env sigma (mkConst v)) c (mt ())
 
 let pr_info f_info =
+  let sigma, env = Pfedit.get_current_context () in
   str "function_constant := " ++
-  Printer.pr_lconstr (mkConst f_info.function_constant)++ fnl () ++
+  Printer.pr_lconstr_env env sigma (mkConst f_info.function_constant)++ fnl () ++
   str "function_constant_type := " ++
   (try
-     Printer.pr_lconstr
-       (fst (Global.type_of_global_in_context (Global.env ()) (ConstRef f_info.function_constant)))
+     Printer.pr_lconstr_env env sigma
+       (fst (Global.type_of_global_in_context env (ConstRef f_info.function_constant)))
    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 () ++
@@ -349,7 +354,7 @@ let pr_info f_info =
   str "rect_lemma := " ++ pr_ocst f_info.rect_lemma ++ fnl () ++
   str "rec_lemma := " ++ pr_ocst f_info.rec_lemma ++ fnl () ++
   str "prop_lemma := " ++ pr_ocst f_info.prop_lemma ++ fnl () ++
-  str "graph_ind := " ++ Printer.pr_lconstr (mkInd f_info.graph_ind) ++ fnl ()
+  str "graph_ind := " ++ Printer.pr_lconstr_env env sigma (mkInd f_info.graph_ind) ++ fnl ()
 
 let pr_table tb =
   let l = Cmap_env.fold (fun k v acc -> v::acc) tb [] in
@@ -545,7 +550,16 @@ let prodn n env b =
 (* compose_prod [xn:Tn;..;x1:T1] b = (x1:T1)..(xn:Tn)b *)
 let compose_prod l b = prodn (List.length l) l b
 
-type tcc_lemma_value = 
+type tcc_lemma_value =
   | Undefined
-  | Value of Term.constr
+  | Value of constr
   | Not_needed
+
+(* We only "purify" on exceptions. XXX: What is this doing here? *)
+let funind_purify f x =
+  let st = Vernacstate.freeze_interp_state `No in
+  try f x
+  with e ->
+    let e = CErrors.push e in
+    Vernacstate.unfreeze_interp_state st;
+    Exninfo.iraise e
diff --git a/plugins/funind/indfun_common.mli b/plugins/funind/indfun_common.mli
index 2e2ced790..5cc7163aa 100644
--- a/plugins/funind/indfun_common.mli
+++ b/plugins/funind/indfun_common.mli
@@ -38,7 +38,7 @@ val chop_rlambda_n : int -> Glob_term.glob_constr ->
 val chop_rprod_n : int -> Glob_term.glob_constr ->
   (Name.t*Glob_term.glob_constr) list * Glob_term.glob_constr
 
-val def_of_const : Term.constr -> Term.constr
+val def_of_const : Constr.t -> Constr.t
 val eq : EConstr.constr Lazy.t
 val refl_equal : EConstr.constr Lazy.t
 val const_of_id: Id.t ->  Globnames.global_reference(* constantyes *)
@@ -118,8 +118,10 @@ val decompose_lam_n : Evd.evar_map -> int -> EConstr.t ->
   (Names.Name.t * EConstr.t) list * EConstr.t
 val compose_lam : (Names.Name.t * EConstr.t) list -> EConstr.t -> EConstr.t
 val compose_prod : (Names.Name.t * EConstr.t) list -> EConstr.t -> EConstr.t
-                                                        
-type tcc_lemma_value = 
+
+type tcc_lemma_value =
   | Undefined
-  | Value of Term.constr
+  | Value of Constr.t
   | Not_needed
+
+val funind_purify : ('a -> 'b) -> ('a -> 'b)
diff --git a/plugins/funind/invfun.ml b/plugins/funind/invfun.ml
index 8dea6c90f..4acf82d00 100644
--- a/plugins/funind/invfun.ml
+++ b/plugins/funind/invfun.ml
@@ -12,6 +12,7 @@ open CErrors
 open Util
 open Names
 open Term
+open Constr
 open EConstr
 open Vars
 open Pp
@@ -55,12 +56,6 @@ let do_observe_tac s tac g =
 	     CErrors.iprint e ++ str " on goal" ++ fnl() ++ goal ));
     iraise reraise;;
 
-
-let observe_tac_strm s tac g =
-  if do_observe ()
-  then do_observe_tac s tac g
-  else tac g
-
 let observe_tac s tac g =
   if do_observe ()
   then do_observe_tac (str s) tac g
@@ -86,10 +81,6 @@ let make_eq () =
   try
     EConstr.of_constr (Universes.constr_of_global (Coqlib.build_coq_eq ()))
   with _ -> assert false 
-let make_eq_refl () =
-  try
-    EConstr.of_constr (Universes.constr_of_global (Coqlib.build_coq_eq_refl ()))
-  with _ -> assert false
 
 	  
 (* [generate_type g_to_f f graph i] build the completeness (resp. correctness) lemma type if [g_to_f = true]
@@ -131,9 +122,9 @@ let generate_type evd g_to_f f graph i =
 			   | Name id -> Some id
 			   | Anonymous -> None
   in
-  let named_ctxt = List.map_filter filter fun_ctxt in
+  let named_ctxt = Id.Set.of_list (List.map_filter filter fun_ctxt) in
   let res_id = Namegen.next_ident_away_in_goal (Id.of_string "_res") named_ctxt in
-  let fv_id = Namegen.next_ident_away_in_goal (Id.of_string "fv") (res_id :: named_ctxt) in
+  let fv_id = Namegen.next_ident_away_in_goal (Id.of_string "fv") (Id.Set.add res_id named_ctxt) in
   (*i we can then type the argument to be applied to the function [f] i*)
   let args_as_rels = Array.of_list (args_from_decl 1 [] fun_ctxt) in
   (*i
@@ -189,14 +180,13 @@ let rec generate_fresh_id x avoid i =
   if i == 0
   then []
   else
-    let id = Namegen.next_ident_away_in_goal x avoid in
+    let id = Namegen.next_ident_away_in_goal x (Id.Set.of_list avoid) in
     id::(generate_fresh_id x (id::avoid) (pred i))
 
 
-(* [prove_fun_correct functional_induction funs_constr graphs_constr schemes lemmas_types_infos i ]
+(* [prove_fun_correct funs_constr graphs_constr schemes lemmas_types_infos i ]
    is the tactic used to prove correctness lemma.
 
-   [functional_induction] is the tactic defined in [indfun] (dependency problem)
    [funs_constr], [graphs_constr] [schemes] [lemmas_types_infos] are the mutually recursive functions
    (resp. graphs of the functions and principles and correctness lemma types) to prove correct.
 
@@ -217,7 +207,7 @@ let rec generate_fresh_id x avoid i =
    \end{enumerate}
 
 *)
-let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes lemmas_types_infos i : Tacmach.tactic =
+let prove_fun_correct evd funs_constr graphs_constr schemes lemmas_types_infos i : Tacmach.tactic =
   fun g ->
     (* first of all we recreate the lemmas types to be used as predicates of the induction principle
        that is~:
@@ -239,7 +229,7 @@ let prove_fun_correct evd functional_induction funs_constr graphs_constr schemes
        environment and due to the bug #1174, we will need to pose the principle
        using a name
     *)
-    let principle_id = Namegen.next_ident_away_in_goal (Id.of_string "princ") ids in
+    let principle_id = Namegen.next_ident_away_in_goal (Id.of_string "princ") (Id.Set.of_list ids) in
     let ids = principle_id :: ids in
     (* We get the branches of the principle *)
     let branches = List.rev princ_infos.branches in
@@ -396,7 +386,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.Name.get_id (RelDecl.get_name decl)) avoid in
+	     let id = Namegen.next_ident_away (Nameops.Name.get_id (RelDecl.get_name decl)) (Id.Set.of_list avoid) in
 	     p::bindings,id::avoid
 	  )
 	  ([],pf_ids_of_hyps g)
@@ -406,7 +396,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.Name.get_id (RelDecl.get_name decl)) avoid in
+	     let id = Namegen.next_ident_away (Nameops.Name.get_id (RelDecl.get_name decl)) (Id.Set.of_list avoid) in
 	     (nf_zeta p)::bindings,id::avoid)
 	  ([],avoid)
 	  princ_infos.predicates
@@ -570,6 +560,11 @@ let rec reflexivity_with_destruct_cases g =
     with e when CErrors.noncritical e -> Proofview.V82.of_tactic reflexivity
   in
   let eq_ind = make_eq () in
+  let my_inj_flags = Some {
+    Equality.keep_proof_equalities = false;
+    injection_in_context = false; (* for compatibility, necessary *)
+    injection_pattern_l2r_order = false; (* probably does not matter; except maybe with dependent hyps *)
+  } in
   let discr_inject =
     Tacticals.onAllHypsAndConcl (
        fun sc g ->
@@ -580,8 +575,8 @@ let rec reflexivity_with_destruct_cases g =
 		 | App(eq,[|_;t1;t2|]) when EConstr.eq_constr (project g) eq eq_ind ->
 		     if Equality.discriminable (pf_env g) (project g) t1 t2
 		     then Proofview.V82.of_tactic (Equality.discrHyp id) g
-		     else if Equality.injectable (pf_env g) (project g) t1 t2
-		     then tclTHENLIST [Proofview.V82.of_tactic (Equality.injHyp None id);thin [id];intros_with_rewrite]  g
+		     else if Equality.injectable (pf_env g) (project g) ~keep_proofs:None t1 t2
+		     then tclTHENLIST [Proofview.V82.of_tactic (Equality.injHyp my_inj_flags None id);thin [id];intros_with_rewrite]  g
 		     else tclIDTAC g
 		 | _ -> tclIDTAC g
     )
@@ -746,20 +741,20 @@ let prove_fun_complete funcs graphs schemes lemmas_types_infos i : Tacmach.tacti
       g
 
 
-(* [derive_correctness make_scheme functional_induction funs graphs] create correctness and completeness
+(* [derive_correctness make_scheme funs graphs] create correctness and completeness
    lemmas for each function in [funs] w.r.t. [graphs]
 
    [make_scheme] is Functional_principle_types.make_scheme (dependency pb) and
-   [functional_induction] is Indfun.functional_induction (same pb)
 *)
 
-let derive_correctness make_scheme functional_induction (funs: pconstant list) (graphs:inductive list) =
+let derive_correctness make_scheme (funs: pconstant list) (graphs:inductive list) =
   assert (funs <> []);
   assert (graphs <> []);
   let funs = Array.of_list funs and graphs = Array.of_list graphs in
   let map (c, u) = mkConstU (c, EInstance.make u) in
   let funs_constr = Array.map map funs  in
-  States.with_state_protection_on_exception
+  (* XXX STATE Why do we need this... why is the toplevel protection not enought *)
+  funind_purify
     (fun () ->
      let env = Global.env () in
      let evd = ref (Evd.from_env env) in 
@@ -797,12 +792,12 @@ let derive_correctness make_scheme functional_induction (funs: pconstant list) (
 	       (fun entry ->
 		  (EConstr.of_constr (fst (fst(Future.force entry.Entries.const_entry_body))), EConstr.of_constr (Option.get entry.Entries.const_entry_type ))
 	       )
-	       (make_scheme evd (Array.map_to_list (fun const -> const,GType []) funs))
+	       (make_scheme evd (Array.map_to_list (fun const -> const,Sorts.InType) funs))
 	    )
 	)
     in
     let proving_tac =
-      prove_fun_correct !evd functional_induction funs_constr graphs_constr schemes lemmas_types_infos
+      prove_fun_correct !evd funs_constr graphs_constr schemes lemmas_types_infos
     in
     Array.iteri
       (fun i f_as_constant ->
@@ -844,7 +839,7 @@ let derive_correctness make_scheme functional_induction (funs: pconstant list) (
 	   EConstr.it_mkProd_or_LetIn type_of_lemma_concl type_of_lemma_ctxt
 	 in
 	 let type_of_lemma = nf_zeta type_of_lemma in
-	 observe (str "type_of_lemma := " ++ Printer.pr_leconstr type_of_lemma);
+         observe (str "type_of_lemma := " ++ Printer.pr_leconstr_env env !evd type_of_lemma);
 	 type_of_lemma,type_info
 	)
 	funs_constr
diff --git a/plugins/funind/invfun.mli b/plugins/funind/invfun.mli
new file mode 100644
index 000000000..e07138596
--- /dev/null
+++ b/plugins/funind/invfun.mli
@@ -0,0 +1,17 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+val invfun :
+  Misctypes.quantified_hypothesis ->
+  Globnames.global_reference option ->
+  Evar.t Evd.sigma -> Evar.t list Evd.sigma
+val derive_correctness :
+  (Evd.evar_map ref ->
+   (Constr.pconstant * Sorts.family) list ->
+   'a Entries.definition_entry list) ->
+   Constr.pconstant list -> Names.inductive list -> unit
diff --git a/plugins/funind/merge.ml b/plugins/funind/merge.ml
deleted file mode 100644
index 3ae922190..000000000
--- a/plugins/funind/merge.ml
+++ /dev/null
@@ -1,1001 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(* Merging of induction principles. *)
-
-open Globnames
-open Tactics
-open Indfun_common
-open CErrors
-open Util
-open Constrexpr
-open Vernacexpr
-open Pp
-open Names
-open Term
-open Vars
-open Declarations
-open Glob_term
-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} *)
-
-let pop c = Vars.lift (-1) c
-let rec popn i c = if i<=0 then c else pop (popn (i-1) c)
-
-(** Substitutions in constr *)
-let compare_constr_nosub t1 t2 =
-  if compare_constr (fun _ _ -> false) t1 t2
-  then true
-  else false
-
-let rec compare_constr' t1 t2 =
-  if compare_constr_nosub t1 t2
-  then true
-  else (compare_constr (compare_constr') t1 t2)
-
-let rec substitterm prof t by_t in_u =
-  if (compare_constr' (lift prof t) in_u)
-  then (lift prof by_t)
-  else map_constr_with_binders succ
-    (fun i -> substitterm i t by_t) prof in_u
-
-let lift_ldecl n ldecl = List.map (fun (x,y) -> x,lift n y) ldecl
-
-let understand = Pretyping.understand (Global.env()) Evd.empty
-
-(** Operations on names and identifiers *)
-let id_of_name = function
-    Anonymous -> Id.of_string "H"
-  | Name id   -> id;;
-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 =
-    match x with
-      | { CAst.v = GVar x } -> Id.equal x f
-      | _ -> false
-
-(** [ident_global_exist id] returns true if identifier [id] is linked
-    in global environment. *)
-let ident_global_exist id =
-  try
-    let ans = CAst.make @@ CRef (Libnames.Ident (Loc.tag id), None) in
-    let _ = ignore (Constrintern.intern_constr (Global.env()) ans) in
-    true
-  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.increment_subscript !res done;
-    !res
-
-
-(** {2 Debugging} *)
-(* comment this line to see debug msgs *)
-let msg x = () ;; let pr_lconstr c = str ""
-(* uncomment this to see debugging *)
-let prconstr c =  msg (str"  " ++ Printer.pr_lconstr c)
-let prconstrnl c =  msg (str"  " ++ Printer.pr_lconstr c ++ str"\n")
-let prlistconstr lc = List.iter prconstr lc
-let prstr s = msg(str s)
-let prNamedConstr s c =
-  begin
-    msg(str "");
-    msg(str(s^" {§ ") ++ Printer.pr_lconstr c ++ str " §} ");
-    msg(str "");
-  end
-let prNamedRConstr s c =
-  begin
-    msg(str "");
-    msg(str(s^" {§ ") ++ Printer.pr_glob_constr c ++ str " §} ");
-    msg(str "");
-  end
-let prNamedLConstr_aux lc = List.iter (prNamedConstr "\n") lc
-let prNamedLConstr s lc =
-  begin
-    prstr "[§§§ ";
-    prstr s;
-    prNamedLConstr_aux lc;
-    prstr " §§§]\n";
-  end
-let prNamedLDecl s lc =
-  begin
-    prstr s; prstr "\n";
-    List.iter (fun (nm,_,tp) -> prNamedConstr (string_of_name nm) tp) lc;
-    prstr "\n";
-  end
-let prNamedRLDecl s lc =
-  begin
-    prstr s; prstr "\n"; prstr "{§§ ";
-    List.iter
-      (fun x ->
-        match x with
-          | (nm,None,Some tp) -> prNamedRConstr (string_of_name nm) tp
-          | (nm,Some bdy,None) -> prNamedRConstr ("(letin) "^string_of_name nm) bdy
-          | _ -> assert false
-        ) lc;
-    prstr " §§}\n";
-    prstr "\n";
-  end
-
-(** {2 Misc} *)
-
-exception Found of int
-
-(* Array scanning *)
-
-let array_prfx (arr: 'a array) (pred: int -> 'a -> bool): int =
-match Array.findi pred arr with
-| None -> Array.length arr (* all elt are positive *)
-| Some i -> i
-
-(* Like List.chop but except that [i] is the size of the suffix of [l]. *)
-let list_chop_end i l =
-  let size_prefix = List.length l -i in
-  if size_prefix < 0 then failwith "list_chop_end"
-  else List.chop size_prefix l
-
-let list_fold_lefti (f: int -> 'a -> 'b -> 'a) (acc:'a) (arr:'b list): 'a =
-  let i = ref 0 in
-  List.fold_left
-    (fun acc x ->
-      let res = f !i acc x in i := !i + 1; res)
-    acc arr
-
-let list_filteri (f: int -> 'a -> bool) (l:'a list):'a list =
-  let i = ref 0 in
-  List.filter (fun x -> let res = f !i x in i := !i + 1; res) l
-
-
-(** Iteration module *)
-module For =
-struct
-  let rec map i j (f: int -> 'a)  = if i>j then [] else f i :: (map (i+1) j f)
-  let rec foldup i j (f: 'a -> int -> 'a) acc =
-    if i>j then acc else let newacc = f acc i in foldup (i+1) j f newacc
-  let rec folddown i j (f: 'a -> int -> 'a) acc =
-    if i>j then acc else let newacc = f acc j in folddown i (j-1) f newacc
-  let fold i j = if i<j then foldup i j else folddown i j
-end
-
-
-(** {1 Parameters shifting and linking information} *)
-
-(** This type is used to deal with debruijn linked indices. When a
-    variable is linked to a previous one, we will ignore it and refer
-    to previous one. *)
-type linked_var =
-    | Linked of int
-    | Unlinked
-    | Funres
-
-(** When merging two graphs, parameters may become regular arguments,
-    and thus be shifted. This type describes the result of computing
-    the changes. *)
-type 'a shifted_params =
-    {
-      nprm1:'a;
-      nprm2:'a;
-      prm2_unlinked:'a list; (* ranks of unlinked params in nprms2 *)
-      nuprm1:'a;
-      nuprm2:'a;
-      nargs1:'a;
-      nargs2:'a;
-    }
-
-
-let prlinked x =
-  match x with
-    | Linked i -> Printf.sprintf "Linked %d" i
-    | Unlinked -> Printf.sprintf "Unlinked"
-    | Funres -> Printf.sprintf "Funres"
-
-let linkmonad f lnkvar =
-  match lnkvar with
-    | Linked i -> Linked (f i)
-    | Unlinked -> Unlinked
-    | Funres -> Funres
-
-let linklift lnkvar i = linkmonad (fun x -> x+i) lnkvar
-
-(* This map is used to deal with debruijn linked indices. *)
-module Link = Map.Make (Int)
-
-let pr_links l =
-  Printf.printf "links:\n";
-  Link.iter (fun k e -> Printf.printf "%d : %s\n" k (prlinked e)) l;
-  Printf.printf "_____________\n"
-
-type 'a merged_arg =
-    | Prm_stable of 'a
-    | Prm_linked of 'a
-    | Prm_arg of 'a
-    | Arg_stable of 'a
-    | Arg_linked of 'a
-    | Arg_funres
-
-(** Information about graph merging of two inductives.
-   All rel_decl list are IN REVERSE ORDER (ie well suited for compose) *)
-
-type merge_infos =
-    {
-      ident:Id.t; (** new inductive name *)
-      mib1: mutual_inductive_body;
-      oib1: one_inductive_body;
-      mib2: mutual_inductive_body;
-      oib2: one_inductive_body;
-
-      (** Array of links of the first inductive (should be all stable) *)
-      lnk1: int merged_arg array;
-
-      (** Array of links of the second inductive (point to the first ind param/args) *)
-      lnk2: int merged_arg array;
-
-      (** rec params which remain rec param (ie not linked) *)
-      recprms1: Context.Rel.Declaration.t list;
-      recprms2: Context.Rel.Declaration.t list;
-      nrecprms1: int;
-      nrecprms2: int;
-
-      (** rec parms which became non parm (either linked to something
-         or because after a rec parm that became non parm) *)
-      otherprms1: Context.Rel.Declaration.t list;
-      otherprms2: Context.Rel.Declaration.t list;
-      notherprms1:int;
-      notherprms2:int;
-
-      (** args which remain args in merge *)
-      args1:Context.Rel.Declaration.t list;
-      args2:Context.Rel.Declaration.t list;
-      nargs1:int;
-      nargs2:int;
-
-      (** functional result args *)
-      funresprms1: Context.Rel.Declaration.t list;
-      funresprms2: Context.Rel.Declaration.t list;
-      nfunresprms1:int;
-      nfunresprms2:int;
-    }
-
-
-let pr_merginfo x =
-  let i,s=
-    match x with
-      | Prm_linked i -> Some i,"Prm_linked"
-      | Arg_linked i -> Some i,"Arg_linked"
-      | Prm_stable i -> Some i,"Prm_stable"
-      | Prm_arg i -> Some i,"Prm_arg"
-      | Arg_stable i -> Some i,"Arg_stable"
-      | Arg_funres -> None , "Arg_funres" in
-  match i with
-    | Some i -> Printf.sprintf "%s(%d)" s i
-    | None -> Printf.sprintf "%s" s
-
-let isPrm_stable x = match x with Prm_stable _ -> true | _ -> false
-
-(* ?? prm_linked?? *)
-let isArg_stable x = match x with Arg_stable _ | Prm_arg _ -> true | _ -> false
-
-let is_stable x =
-  match x with Arg_stable _ | Prm_stable _ | Prm_arg _ -> true | _ -> false
-
-let isArg_funres x = match x with Arg_funres -> true | _ -> false
-
-let filter_shift_stable (lnk:int merged_arg array) (l:'a list): 'a list =
-  let prms = list_filteri (fun i _ -> isPrm_stable lnk.(i)) l in
-  let args = list_filteri (fun i _ -> isArg_stable lnk.(i)) l in
-  let fres = list_filteri (fun i _ -> isArg_funres lnk.(i)) l in
-  prms@args@fres
-
-(** Reverse the link map, keeping only linked vars, elements are list
-    of int as several vars may be linked to the same var. *)
-let revlinked lnk =
-  For.fold 0 (Array.length lnk - 1)
-    (fun acc k ->
-      match lnk.(k) with
-        | Unlinked | Funres -> acc
-        | Linked i ->
-            let old = try Link.find i acc with Not_found -> [] in
-            Link.add i (k::old) acc)
-    Link.empty
-
-let array_switch arr i j =
-  let aux = arr.(j) in arr.(j) <- arr.(i); arr.(i) <- aux
-
-let filter_shift_stable_right (lnk:int merged_arg array) (l:'a list): 'a list =
-  let larr = Array.of_list l in
-  let _ =
-    Array.iteri
-      (fun j x ->
-        match x with
-          | Prm_linked i -> array_switch larr i j
-          | Arg_linked i -> array_switch larr i j
-          | Prm_stable i -> ()
-          | Prm_arg i -> ()
-          | Arg_stable i -> ()
-          | Arg_funres -> ()
-      ) lnk in
-  filter_shift_stable lnk (Array.to_list larr)
-
-
-let error msg = user_err Pp.(str msg)
-
-(** {1 Utilities for merging} *)
-
-let ind1name = Id.of_string "__ind1"
-let ind2name = Id.of_string "__ind2"
-
-(** Performs verifications on two graphs before merging: they must not
-    be co-inductive, and for the moment they must not be mutual
-    either. *)
-let verify_inds mib1 mib2 =
-  if mib1.mind_finite == Decl_kinds.CoFinite then error "First argument is coinductive";
-  if mib2.mind_finite == Decl_kinds.CoFinite then error "Second argument is coinductive";
-  if not (Int.equal mib1.mind_ntypes 1) then error "First argument is mutual";
-  if not (Int.equal mib2.mind_ntypes 1) then error "Second argument is mutual";
-  ()
-
-(*
-(** [build_raw_params prms_decl avoid] returns a list of variables
-    attributed to the list of decl [prms_decl], avoiding names in
-    [avoid]. *)
-let build_raw_params prms_decl avoid =
-  let dummy_constr = compose_prod (List.map (fun (x,_,z) -> x,z) prms_decl) (mkRel 1) in
-  let _ = prNamedConstr "DUMMY" dummy_constr in
-  let dummy_glob_constr = Detyping.detype false avoid [] dummy_constr in
-  let _ = prNamedRConstr "RAWDUMMY" dummy_glob_constr in
-  let res,_ = glob_decompose_prod dummy_glob_constr in
-  let comblist = List.combine prms_decl res in
-  comblist, res , (avoid @ (Id.Set.elements (ids_of_glob_constr dummy_glob_constr)))
-*)
-
-let ids_of_rawlist avoid rawl =
-    List.fold_left Id.Set.union avoid (List.map ids_of_glob_constr rawl)
-
-
-
-(** {1 Merging function graphs} *)
-
-(** [shift_linked_params mib1 mib2 lnk] Computes which parameters (rec
-    uniform and ordinary ones) of mutual inductives [mib1] and [mib2]
-    remain uniform when linked by [lnk]. All parameters are
-    considered, ie we take parameters of the first inductive body of
-    [mib1] and [mib2].
-
-    Explanation: The two inductives have parameters, some of the first
-    are recursively uniform, some of the last are functional result of
-    the functional graph.
-
-   (I x1 x2 ... xk ... xk' ... xn)
-   (J y1 y2 ... xl ... yl' ... ym)
-
-   Problem is, if some rec unif params are linked to non rec unif
-   ones, they become non rec (and the following too). And functinal
-   argument have to be shifted at the end *)
-let shift_linked_params mib1 mib2 (lnk1:linked_var array) (lnk2:linked_var array) id =
-  let _ = prstr "\nYOUHOU shift\n" in
-  let linked_targets = revlinked lnk2 in
-  let is_param_of_mib1 x = x < mib1.mind_nparams_rec in
-  let is_param_of_mib2 x = x < mib2.mind_nparams_rec in
-  let is_targetted_by_non_recparam_lnk1 i =
-    try
-      let targets = Link.find i linked_targets in
-      List.exists (fun x -> not (is_param_of_mib2 x)) targets
-    with Not_found -> false in
-  let mlnk1 =
-    Array.mapi
-      (fun i lkv ->
-        let isprm = is_param_of_mib1 i in
-        let prmlost = is_targetted_by_non_recparam_lnk1 i in
-        match isprm , prmlost, lnk1.(i) with
-          | true , true , _ -> Prm_arg i (* recparam becoming ordinary *)
-          | true , false , _-> Prm_stable i (* recparam remains recparam*)
-          | false , false , Funres -> Arg_funres
-          | _ , _ , Funres -> assert false (* fun res cannot be a rec param or lost *)
-          | false , _ , _ -> Arg_stable i) (* Args of lnk1 are not linked *)
-      lnk1 in
-  let mlnk2 =
-    Array.mapi
-      (fun i lkv ->
-        (* Is this correct if some param of ind2 is lost? *)
-        let isprm = is_param_of_mib2 i in
-        match isprm , lnk2.(i) with
-          | true , Linked j when not (is_param_of_mib1 j) ->
-              Prm_arg j (* recparam becoming ordinary *)
-          | true , Linked j -> Prm_linked j (*recparam linked to recparam*)
-          | true , Unlinked -> Prm_stable i (* recparam remains recparam*)
-          | false , Linked j -> Arg_linked j (* Args of lnk2 lost *)
-          | false , Unlinked -> Arg_stable i (* Args of lnk2 remains *)
-          | false , Funres -> Arg_funres
-          | true , Funres -> assert false (* fun res cannot be a rec param *)
-      )
-      lnk2 in
-  let oib1 = mib1.mind_packets.(0) in
-  let oib2 = mib2.mind_packets.(0) in
-  (* count params remaining params *)
-  let n_params1 = array_prfx mlnk1 (fun i x -> not (isPrm_stable x)) in
-  let n_params2 = array_prfx mlnk2 (fun i x -> not (isPrm_stable x)) in
-  let bldprms arity_ctxt mlnk =
-    list_fold_lefti
-      (fun i (acc1,acc2,acc3,acc4) x ->
-        prstr (pr_merginfo mlnk.(i));prstr "\n";
-        match mlnk.(i) with
-          | Prm_stable _ -> x::acc1 , acc2 , acc3, acc4
-          | Prm_arg _ -> acc1 , x::acc2 , acc3, acc4
-          | Arg_stable _ -> acc1 , acc2 , x::acc3, acc4
-          | Arg_funres -> acc1 , acc2 , acc3, x::acc4
-          | _ -> acc1 , acc2 , acc3, acc4)
-      ([],[],[],[]) arity_ctxt in
-(*  let arity_ctxt2 =
-    build_raw_params oib2.mind_arity_ctxt
-      (Id.Set.elements (ids_of_glob_constr oib1.mind_arity_ctxt)) in*)
-  let recprms1,otherprms1,args1,funresprms1 = bldprms (List.rev oib1.mind_arity_ctxt) mlnk1 in
-  let _ = prstr "\n\n\n" in
-  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 (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 (RelDecl.get_name decl) ^ " : "); prconstr (RelDecl.get_type decl); prstr "\n")
-    otherprms2 in
-  {
-    ident=id;
-    mib1=mib1;
-    oib1 = oib1;
-    mib2=mib2;
-    oib2 = oib2;
-    lnk1 = mlnk1;
-    lnk2 = mlnk2;
-    nrecprms1 = n_params1;
-    recprms1 = recprms1;
-    otherprms1 = otherprms1;
-    args1 = args1;
-    funresprms1 = funresprms1;
-    notherprms1 = Array.length mlnk1 - n_params1;
-    nfunresprms1 = List.length funresprms1;
-    nargs1 = List.length args1;
-    nrecprms2 = n_params2;
-    recprms2 = recprms2;
-    otherprms2 = otherprms2;
-    args2 = args2;
-    funresprms2 = funresprms2;
-    notherprms2 = Array.length mlnk2 - n_params2;
-    nargs2 = List.length args2;
-    nfunresprms2 = List.length funresprms2;
-  }
-
-
-
-
-(** {1 Merging functions} *)
-
-exception NoMerge
-
-let rec merge_app c1 c2 id1 id2 shift filter_shift_stable =
-  let lnk = Array.append shift.lnk1 shift.lnk2 in
-  match CAst.(c1.v, c2.v) with
-    | GApp(f1, arr1), GApp(f2,arr2) when isVarf id1 f1 && isVarf id2 f2 ->
-        let _ = prstr "\nICI1!\n" in
-        let args = filter_shift_stable lnk (arr1 @ arr2) in
-        CAst.make @@ GApp ((CAst.make @@ GVar shift.ident) , args)
-    | GApp(f1, arr1), GApp(f2,arr2)  -> raise NoMerge
-    | GLetIn(nme,bdy,typ,trm) , _ ->
-        let _ = prstr "\nICI2!\n" in
-        let newtrm = merge_app trm c2 id1 id2 shift filter_shift_stable in
-        CAst.make @@ GLetIn(nme,bdy,typ,newtrm)
-    | _, GLetIn(nme,bdy,typ,trm) ->
-        let _ = prstr "\nICI3!\n" in
-        let newtrm = merge_app c1 trm id1 id2 shift filter_shift_stable in
-        CAst.make @@ GLetIn(nme,bdy,typ,newtrm)
-    | _ -> let _ = prstr "\nICI4!\n" in
-           raise NoMerge
-
-let rec merge_app_unsafe c1 c2 shift filter_shift_stable =
-  let lnk = Array.append shift.lnk1 shift.lnk2 in
-  match CAst.(c1.v, c2.v) with
-    | GApp(f1, arr1), GApp(f2,arr2) ->
-        let args = filter_shift_stable lnk (arr1 @ arr2) in
-        CAst.make @@ GApp (CAst.make @@ GVar shift.ident, args)
-          (* FIXME: what if the function appears in the body of the let? *)
-    | GLetIn(nme,bdy,typ,trm) , _ ->
-      let _ = prstr "\nICI2 '!\n" in
-        let newtrm = merge_app_unsafe trm c2 shift filter_shift_stable in
-        CAst.make @@ GLetIn(nme,bdy,typ,newtrm)
-    | _, GLetIn(nme,bdy,typ,trm) ->
-        let _ = prstr "\nICI3 '!\n" in
-        let newtrm = merge_app_unsafe c1 trm shift filter_shift_stable in
-        CAst.make @@ GLetIn(nme,bdy,typ,newtrm)
-    | _ -> let _ = prstr "\nICI4 '!\n" in raise NoMerge
-
-
-
-(* Heuristic when merging two lists of hypothesis: merge every rec
-   calls of branch 1 with all rec calls of branch 2. *)
-(* TODO: reecrire cette heuristique (jusqu'a merge_types) *)
-let rec merge_rec_hyps shift accrec
-    (ltyp:(Name.t * glob_constr option * glob_constr option) list)
-    filter_shift_stable : (Name.t * glob_constr option * glob_constr option) list =
-  let mergeonehyp t reldecl =
-    match reldecl with
-      | (nme,x,Some ({ CAst.v = GApp(i,args)} as ind))
-        -> nme,x, Some (merge_app_unsafe ind t shift filter_shift_stable)
-      | (nme,Some _,None) -> error "letins with recursive calls not treated yet"
-      | (nme,None,Some _) -> assert false
-      | (nme,None,None) | (nme,Some _,Some _) -> assert false in
-  match ltyp with
-    | [] -> []
-    | (nme,None,Some ({ CAst. v = GApp(f, largs) } as t)) :: lt when isVarf ind2name f ->
-        let rechyps = List.map (mergeonehyp t) accrec in
-        rechyps @ merge_rec_hyps shift accrec lt filter_shift_stable
-    | e::lt -> e :: merge_rec_hyps shift accrec lt filter_shift_stable
-
-
-let build_suppl_reccall (accrec:(Name.t * glob_constr) list) concl2 shift =
-  List.map (fun (nm,tp) -> (nm,merge_app_unsafe tp concl2 shift)) accrec
-
-
-let find_app (nme:Id.t) ltyp =
-  try
-    ignore
-      (List.map
-          (fun x ->
-            match x with
-              | _,None,Some { CAst.v = GApp(f,_)} when isVarf nme f -> raise (Found 0)
-              | _ -> ())
-          ltyp);
-    false
-  with Found _ -> true
-
-let prnt_prod_or_letin nm letbdy typ =
-  match letbdy , typ with
-    | Some lbdy , None -> prNamedRConstr ("(letin) " ^ string_of_name nm) lbdy
-    | None , Some tp -> prNamedRConstr (string_of_name nm) tp
-    | _ , _ -> assert false
-
-
-let rec merge_types shift accrec1
-    (ltyp1:(Name.t * glob_constr option * glob_constr option) list)
-    (concl1:glob_constr) (ltyp2:(Name.t * glob_constr option * glob_constr option) list) concl2
-    : (Name.t * glob_constr option * glob_constr option) list * glob_constr =
-  let _ = prstr "MERGE_TYPES\n" in
-  let _ = prstr "ltyp 1 : " in
-  let _ = List.iter (fun (nm,lbdy,tp) -> prnt_prod_or_letin nm lbdy tp) ltyp1 in
-  let _ = prstr "\nltyp 2 : " in
-  let _ = List.iter (fun (nm,lbdy,tp) -> prnt_prod_or_letin nm lbdy tp) ltyp2 in
-  let _ = prstr "\n" in
-  let res =
-    match ltyp1 with
-      | [] ->
-          let isrec1 = not (List.is_empty accrec1) in
-          let isrec2 = find_app ind2name ltyp2 in
-          let rechyps =
-            if isrec1 && isrec2
-            then (* merge_rec_hyps shift accrec1 ltyp2 filter_shift_stable *)
-              merge_rec_hyps shift [name_of_string "concl1",None,Some concl1] ltyp2
-                filter_shift_stable_right
-              @ merge_rec_hyps shift accrec1 [name_of_string "concl2",None, Some concl2]
-                filter_shift_stable
-            else if isrec1
-                (* if rec calls in accrec1 and not in ltyp2, add one to ltyp2 *)
-            then
-              merge_rec_hyps shift accrec1
-                (ltyp2@[name_of_string "concl2",None,Some concl2]) filter_shift_stable
-            else if isrec2
-            then merge_rec_hyps shift [name_of_string "concl1",None,Some concl1] ltyp2
-              filter_shift_stable_right
-            else ltyp2 in
-          let _ = prstr"\nrechyps : " in
-          let _ = List.iter(fun (nm,lbdy,tp)-> prnt_prod_or_letin nm lbdy tp) rechyps in
-          let _ = prstr "MERGE CONCL :  " in
-          let _ = prNamedRConstr "concl1" concl1 in
-          let _ = prstr " with " in
-          let _ = prNamedRConstr "concl2" concl2 in
-          let _ = prstr "\n" in
-          let concl =
-            merge_app concl1 concl2 ind1name ind2name shift filter_shift_stable in
-          let _ = prstr "FIN " in
-          let _ = prNamedRConstr "concl" concl in
-          let _ = prstr "\n" in
-
-          rechyps , concl
-      | (nme,None, Some t1)as e ::lt1 ->
-          (match t1.CAst.v with
-            | GApp(f,carr) when isVarf ind1name f ->
-                merge_types shift (e::accrec1) lt1 concl1 ltyp2 concl2
-            | _ ->
-                let recres, recconcl2 =
-                  merge_types shift accrec1 lt1 concl1 ltyp2 concl2 in
-                ((nme,None,Some t1) :: recres) , recconcl2)
-      | (nme,Some bd, None) ::lt1 ->
-          (* FIXME: what if ind1name appears in bd? *)
-          let recres, recconcl2 =
-            merge_types shift accrec1 lt1 concl1 ltyp2 concl2 in
-          ((nme,Some bd,None) :: recres) , recconcl2
-      | (_,None,None)::_ | (_,Some _,Some _)::_ -> assert false
-  in
-  res
-
-
-(** [build_link_map_aux allargs1 allargs2 shift] returns the mapping of
-    linked args [allargs2] to target args of [allargs1] as specified
-    in [shift]. [allargs1] and [allargs2] are in reverse order.  Also
-    returns the list of unlinked vars of [allargs2]. *)
-let build_link_map_aux (allargs1:Id.t array) (allargs2:Id.t array)
-    (lnk:int merged_arg array) =
-  Array.fold_left_i
-    (fun i acc e ->
-      if Int.equal i (Array.length lnk - 1) then acc (* functional arg, not in allargs *)
-      else
-        match e with
-          | Prm_linked j | Arg_linked j -> Id.Map.add allargs2.(i) allargs1.(j) acc
-          | _ -> acc)
-    Id.Map.empty lnk
-
-let build_link_map allargs1 allargs2 lnk =
-  let allargs1 =
-    Array.of_list (List.rev_map (fun (x,_,_) -> id_of_name x) allargs1) in
-  let allargs2 =
-    Array.of_list (List.rev_map (fun (x,_,_) -> id_of_name x) allargs2) in
-  build_link_map_aux allargs1 allargs2 lnk
-
-
-(** [merge_one_constructor lnk shift typcstr1 typcstr2] merges the two
-    constructor rawtypes [typcstr1] and [typcstr2].  [typcstr1] and
-    [typcstr2] contain all parameters (including rec. unif. ones) of
-    their inductive.
-
-    if  [typcstr1] and [typcstr2] are of the form:
-
-    forall recparams1, forall ordparams1, H1a -> H2a... (I1 x1 y1 ... z1)
-    forall recparams2, forall ordparams2, H2b -> H2b... (I2 x2 y2 ... z2)
-
-    we build:
-
-    forall recparams1 (recparams2 without linked params),
-     forall ordparams1 (ordparams2 without linked params),
-      H1a' -> H2a' -> ...  -> H2a' -> H2b'(shifted) -> ...
-        -> (newI x1 ... z1 x2 y2 ...z2 without linked params)
-
-    where Hix' have been adapted, ie:
-      - linked vars have been changed,
-      - rec calls to I1 and I2 have been replaced by rec calls to
-        newI. More precisely calls to I1 and I2 have been merge by an
-        experimental heuristic (in particular if n o rec calls for I1
-        or I2 is found, we use the conclusion as a rec call). See
-        [merge_types] above.
-
-    Precond: vars sets of [typcstr1] and [typcstr2] must be disjoint.
-
-    TODO: return nothing if equalities (after linking) are contradictory. *)
-let merge_one_constructor (shift:merge_infos) (typcstr1:glob_constr)
-    (typcstr2:glob_constr) : glob_constr =
-  (* FIXME: les noms des parametres corerspondent en principe au
-     parametres du niveau mib, mais il faudrait s'en assurer *)
-  (* shift.nfunresprmsx last args are functional result *)
-  let nargs1 =
-    shift.mib1.mind_nparams + shift.oib1.mind_nrealargs - shift.nfunresprms1 in
-  let nargs2 =
-    shift.mib2.mind_nparams + shift.oib2.mind_nrealargs - shift.nfunresprms2 in
-  let allargs1,rest1 = glob_decompose_prod_or_letin_n nargs1 typcstr1 in
-  let allargs2,rest2 = glob_decompose_prod_or_letin_n nargs2 typcstr2 in
-  (* Build map of linked args of [typcstr2], and apply it to [typcstr2]. *)
-  let linked_map = build_link_map allargs1 allargs2 shift.lnk2 in
-  let rest2 = change_vars linked_map rest2 in
-  let hyps1,concl1 = glob_decompose_prod_or_letin rest1 in
-  let hyps2,concl2' = glob_decompose_prod_or_letin rest2 in
-  let ltyp,concl2 =
-    merge_types shift [] (List.rev hyps1) concl1 (List.rev hyps2) concl2' in
-  let _ = prNamedRLDecl "ltyp result:" ltyp in
-  let typ = glob_compose_prod_or_letin concl2 (List.rev ltyp) in
-  let revargs1 =
-    list_filteri (fun i _ -> isArg_stable shift.lnk1.(i)) (List.rev allargs1) in
-  let _ = prNamedRLDecl "ltyp allargs1" allargs1 in
-  let _ = prNamedRLDecl "ltyp revargs1" revargs1 in
-  let revargs2 =
-    list_filteri (fun i _ -> isArg_stable shift.lnk2.(i)) (List.rev allargs2) in
-  let _ = prNamedRLDecl "ltyp allargs2" allargs2 in
-  let _ = prNamedRLDecl "ltyp revargs2" revargs2 in
-  let typwithprms =
-    glob_compose_prod_or_letin typ (List.rev revargs2 @ List.rev revargs1) in
-  typwithprms
-
-
-(** constructor numbering *)
-let fresh_cstror_suffix , cstror_suffix_init =
-  let cstror_num = ref 0 in
-  (fun () ->
-    let res = string_of_int !cstror_num in
-    cstror_num := !cstror_num + 1;
-    res) ,
-  (fun () -> cstror_num := 0)
-
-(** [merge_constructor_id id1 id2 shift] returns the identifier of the
-    new constructor from the id of the two merged constructor and
-    the merging info. *)
-let merge_constructor_id id1 id2 shift:Id.t =
-  let id = Id.to_string shift.ident ^ "_" ^ fresh_cstror_suffix () in
-  next_ident_fresh (Id.of_string id)
-
-
-
-(** [merge_constructors lnk shift avoid] merges the two list of
-    constructor [(name*type)]. These are translated to glob_constr
-    first, each of them having distinct var names. *)
-let merge_constructors (shift:merge_infos) (avoid:Id.Set.t)
-    (typcstr1:(Id.t * glob_constr) list)
-    (typcstr2:(Id.t * glob_constr) list) : (Id.t * glob_constr) list =
-  List.flatten
-    (List.map
-        (fun (id1,rawtyp1) ->
-          List.map
-            (fun (id2,rawtyp2) ->
-              let typ = merge_one_constructor shift rawtyp1 rawtyp2 in
-              let newcstror_id = merge_constructor_id id1 id2 shift in
-              let _ = prstr "\n**************\n" in
-              newcstror_id , typ)
-            typcstr2)
-        typcstr1)
-
-(** [merge_inductive_body lnk shift avoid oib1 oib2] merges two
-    inductive bodies [oib1] and [oib2], linking with [lnk], params
-    info in [shift], avoiding identifiers in [avoid]. *)
-let merge_inductive_body (shift:merge_infos) avoid (oib1:one_inductive_body)
-    (oib2:one_inductive_body) =
-  (* building glob_constr type of constructors *)
-  let mkrawcor nme avoid typ =
-    (* first replace rel 1 by a varname *)
-    let substindtyp = substitterm 0 (mkRel 1) (mkVar nme) typ in
-    let substindtyp = EConstr.of_constr substindtyp in
-    Detyping.detype false (Id.Set.elements avoid) (Global.env()) Evd.empty substindtyp in
-  let lcstr1: glob_constr list =
-    Array.to_list (Array.map (mkrawcor ind1name avoid) oib1.mind_user_lc) in
-  (* add  to avoid all indentifiers of lcstr1 *)
-  let avoid2 = Id.Set.union avoid (ids_of_rawlist avoid lcstr1) in
-  let lcstr2 =
-    Array.to_list (Array.map (mkrawcor ind2name avoid2) oib2.mind_user_lc) in
-  let avoid3 = Id.Set.union avoid (ids_of_rawlist avoid lcstr2) in
-
-  let params1 =
-    try fst (glob_decompose_prod_n shift.nrecprms1 (List.hd lcstr1))
-    with e when CErrors.noncritical e -> [] in
-  let params2 =
-    try fst (glob_decompose_prod_n shift.nrecprms2 (List.hd lcstr2))
-    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
-
-  cstror_suffix_init();
-  params1,params2,merge_constructors shift avoid3 lcstr1 lcstr2
-
-
-(** [merge_mutual_inductive_body lnk mib1 mib2 shift] merge mutual
-    inductive bodies [mib1] and [mib2] linking vars with
-    [lnk]. [shift] information on parameters of the new inductive.
-    For the moment, inductives are supposed to be non mutual.
-*)
-let merge_mutual_inductive_body
-    (mib1:mutual_inductive_body) (mib2:mutual_inductive_body) (shift:merge_infos) =
-  (* Mutual not treated, we take first ind body of each. *)
-  merge_inductive_body shift Id.Set.empty mib1.mind_packets.(0) mib2.mind_packets.(0)
-
-
-let glob_constr_to_constr_expr x = (* build a constr_expr from a glob_constr *)
-  Flags.with_option Flags.raw_print (Constrextern.extern_glob_type Id.Set.empty) x
-
-let merge_rec_params_and_arity prms1 prms2 shift (concl:constr) =
-  let params = prms2 @ prms1 in
-  let resparams =
-    List.fold_left
-      (fun acc (nme,tp) ->
-        let _ = prstr "param :" in
-        let _ = prNamedRConstr (string_of_name nme) tp in
-        let _ = prstr "  ;  " in
-        let typ = glob_constr_to_constr_expr tp in
-        CLocalAssum ([(Loc.tag nme)], Constrexpr_ops.default_binder_kind, typ) :: acc)
-      [] params in
-  let concl = Constrextern.extern_constr false (Global.env()) Evd.empty (EConstr.of_constr concl) in
-  let arity,_ =
-    List.fold_left
-      (fun (acc,env) decl ->
-        let nm = Context.Rel.Declaration.get_name decl in
-        let c = RelDecl.get_type decl in
-        let typ = Constrextern.extern_constr false env Evd.empty (EConstr.of_constr c) in
-        let newenv = Environ.push_rel (LocalAssum (nm,c)) env in
-        CAst.make @@ CProdN ([[(Loc.tag nm)],Constrexpr_ops.default_binder_kind,typ] , acc) , newenv)
-      (concl,Global.env())
-      (shift.funresprms2 @ shift.funresprms1
-        @ shift.args2 @ shift.args1 @ shift.otherprms2 @ shift.otherprms1) in
-  resparams,arity
-
-
-
-(** [glob_constr_list_to_inductive_expr ident rawlist] returns the
-    induct_expr corresponding to the the list of constructor types
-    [rawlist], named ident.
-    FIXME: params et cstr_expr (arity) *)
-let glob_constr_list_to_inductive_expr prms1 prms2 mib1 mib2 shift
-    (rawlist:(Id.t * glob_constr) list) =
-  let lident = (Loc.tag shift.ident), None in
-  let bindlist , cstr_expr = (* params , arities *)
-    merge_rec_params_and_arity prms1 prms2 shift mkSet in
-  let lcstor_expr : (bool * (lident * constr_expr)) list  =
-    List.map (* zeta_normalize t ? *)
-      (fun (id,t) -> false, ((Loc.tag id),glob_constr_to_constr_expr t))
-      rawlist in
-  lident , bindlist , Some cstr_expr , lcstor_expr
-
-
-let mkProd_reldecl (rdecl:Context.Rel.Declaration.t) (t2:glob_constr) =
-  match rdecl with
-    | LocalAssum (nme,t) ->
-        let t = EConstr.of_constr t in
-        let traw = Detyping.detype false [] (Global.env()) Evd.empty t in
-        CAst.make @@ GProd (nme,Explicit,traw,t2)
-    | LocalDef _ -> assert false
-
-
-(** [merge_inductive ind1 ind2 lnk] merges two graphs, linking
-    variables specified in [lnk]. Graphs are not supposed to be mutual
-    inductives for the moment. *)
-let merge_inductive (ind1: inductive) (ind2: inductive)
-    (lnk1: linked_var array) (lnk2: linked_var array) id =
-  let env = Global.env() in
-  let mib1,_ = Inductive.lookup_mind_specif env ind1 in
-  let mib2,_ = Inductive.lookup_mind_specif env ind2 in
-  let _ = verify_inds mib1 mib2 in (* raises an exception if something wrong *)
-  (* compute params that become ordinary args (because linked to ord. args) *)
-  let shift_prm = shift_linked_params mib1 mib2 lnk1 lnk2 id in
-  let prms1,prms2, rawlist = merge_mutual_inductive_body mib1 mib2 shift_prm in
-  let _ = prstr "\nrawlist : " in
-  let _ =
-    List.iter (fun (nm,tp) -> prNamedRConstr (Id.to_string nm) tp;prstr "\n") rawlist in
-  let _ = prstr "\nend rawlist\n" in
-(* FIX: retransformer en constr ici
-   let shift_prm =
-    { shift_prm with
-      recprms1=prms1;
-      recprms1=prms1;
-    } in *)
-  let indexpr = glob_constr_list_to_inductive_expr prms1 prms2 mib1 mib2 shift_prm rawlist in
-  (* Declare inductive *)
-  let indl,_,_ = Command.extract_mutual_inductive_declaration_components [(indexpr,[])] in
-  let mie,pl,impls = Command.interp_mutual_inductive indl []
-          false (* non-cumulative *) false (*FIXMEnon-poly *) false (* means not private *) Decl_kinds.Finite (* means: not coinductive *) in
-  (* Declare the mutual inductive block with its associated schemes *)
-  ignore (Command.declare_mutual_inductive_with_eliminations mie pl impls)
-
-
-(* Find infos on identifier id. *)
-let find_Function_infos_safe (id:Id.t): Indfun_common.function_info =
-  let kn_of_id x =
-    let f_ref = Libnames.Ident (Loc.tag x) in
-    locate_with_msg (str "Don't know what to do with " ++ Libnames.pr_reference f_ref)
-      locate_constant f_ref in
-    try find_Function_infos (kn_of_id id)
-    with Not_found ->
-      user_err ~hdr:"indfun" (Id.print 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
-    [ind1] and [ind2]. identifiers occurring in both arrays [args1] and
-    [args2] are considered linked (i.e. are the same variable) in the
-    new graph.
-
-    Warning: For the moment, repetitions of an id in [args1] or
-    [args2] are not supported. *)
-let merge (id1:Id.t) (id2:Id.t) (args1:Id.t array)
-    (args2:Id.t array) id : unit =
-  let finfo1 = find_Function_infos_safe id1 in
-  let finfo2 = find_Function_infos_safe id2 in
-  (* FIXME? args1 are supposed unlinked. mergescheme (G x x) ?? *)
-  (* We add one arg (functional arg of the graph) *)
-  let lnk1 = Array.make (Array.length args1 + 1) Unlinked in
-  let lnk2' = (* args2 may be linked to args1 members. FIXME: same
-                 as above: vars may be linked inside args2?? *)
-    Array.mapi
-      (fun i c ->
-        match Array.findi (fun i x -> Id.equal x c) args1 with
-          | Some j -> Linked j
-          | None -> Unlinked)
-      args2 in
-  (* We add one arg (functional arg of the graph) *)
-  let lnk2 = Array.append lnk2' (Array.make 1 Unlinked) in
-  (* setting functional results *)
-  let _ = lnk1.(Array.length lnk1 - 1) <- Funres in
-  let _ = lnk2.(Array.length lnk2 - 1) <- Funres in
-  merge_inductive finfo1.graph_ind finfo2.graph_ind lnk1 lnk2 id
-
-
-let remove_last_arg c =
-  let (x,y) = decompose_prod c in
-  let xnolast = List.rev (List.tl (List.rev x)) in
-  compose_prod xnolast y
-
-let rec remove_n_fst_list n l = if Int.equal n 0 then l else remove_n_fst_list (n-1) (List.tl l)
-let remove_n_last_list n l = List.rev (remove_n_fst_list n (List.rev l))
-
-let remove_last_n_arg n c =
-  let (x,y) = decompose_prod c in
-  let xnolast = remove_n_last_list n x in
-  compose_prod xnolast y
-
-(* [funify_branches relinfo nfuns branch] returns the branch [branch]
-   of the relinfo [relinfo] modified to fit in a functional principle.
-   Things to do:
-    - remove indargs from rel applications
-    - replace *variables only* corresponding to function (recursive)
-      results by the actual function application. *)
-let funify_branches relinfo nfuns branch =
-  let mut_induct, induct =
-    match relinfo.indref with
-      | None -> assert false
-      | Some (IndRef ((mutual_ind,i) as ind)) -> mutual_ind,ind
-      | _ -> assert false in
-  let is_dom c =
-    match kind_of_term c with
-      | Ind(((u,_),_)) | Construct(((u,_),_),_) -> MutInd.equal u mut_induct
-      | _ -> false in
-  let _dom_i c =
-    assert (is_dom c);
-    match kind_of_term c with
-      | Ind((u,i)) | Construct((u,_),i) -> i
-      | _ -> assert false in
-  let _is_pred c shift =
-    match kind_of_term c with
-      | Rel i -> let reali = i-shift in (reali>=0 && reali<relinfo.nbranches)
-      | _ -> false in
-  (* FIXME: *)
-  LocalDef (Anonymous,EConstr.mkProp,EConstr.mkProp)
-
-
-let relprinctype_to_funprinctype relprinctype nfuns =
-  let relprinctype = EConstr.of_constr relprinctype in
-  let relinfo = compute_elim_sig Evd.empty (** FIXME*) relprinctype in
-  assert (not relinfo.farg_in_concl);
-  assert (relinfo.indarg_in_concl);
-  (* first remove indarg and indarg_in_concl *)
-  let relinfo_noindarg = { relinfo with
-    indarg_in_concl = false; indarg = None;
-    concl = EConstr.of_constr (remove_last_arg (pop (EConstr.Unsafe.to_constr relinfo.concl))); } in
-  (* the nfuns last induction arguments are functional ones: remove them *)
-  let relinfo_argsok = { relinfo_noindarg with
-    nargs = relinfo_noindarg.nargs - nfuns;
-    (* args is in reverse order, so remove fst *)
-    args = remove_n_fst_list nfuns relinfo_noindarg.args;
-    concl = EConstr.of_constr (popn nfuns (EConstr.Unsafe.to_constr relinfo_noindarg.concl));
-  } in
-  let new_branches =
-    List.map (funify_branches relinfo_argsok nfuns) relinfo_argsok.branches in
-  let relinfo_branches = { relinfo_argsok with branches = new_branches } in
-  relinfo_branches
-
-(* @article{ bundy93rippling,
-    author = "Alan Bundy and Andrew Stevens and Frank van Harmelen and Andrew Ireland and Alan Smaill",
-    title = "Rippling: A Heuristic for Guiding Inductive Proofs",
-    journal = "Artificial Intelligence",
-    volume = "62",
-    number = "2",
-    pages = "185-253",
-    year = "1993",
-    url = "citeseer.ist.psu.edu/bundy93rippling.html" }
-
- *)
diff --git a/plugins/funind/recdef.ml b/plugins/funind/recdef.ml
index d3eccb58d..8fe05b497 100644
--- a/plugins/funind/recdef.ml
+++ b/plugins/funind/recdef.ml
@@ -9,7 +9,7 @@
 
 module CVars = Vars
 
-open Term
+open Constr
 open EConstr
 open Vars
 open Namegen
@@ -53,6 +53,10 @@ let coq_constant m s = EConstr.of_constr @@ Universes.constr_of_global @@
 let arith_Nat = ["Arith";"PeanoNat";"Nat"]
 let arith_Lt = ["Arith";"Lt"]
 
+let pr_leconstr_rd =
+  let sigma, env = Pfedit.get_current_context () in
+  Printer.pr_leconstr_env env sigma
+
 let coq_init_constant s =
   EConstr.of_constr (
     Universes.constr_of_global @@
@@ -62,14 +66,14 @@ let find_reference sl s =
   let dp = Names.DirPath.make (List.rev_map Id.of_string sl) in
   locate (make_qualid dp (Id.of_string s))
 
-let declare_fun f_id kind ?(ctx=Univ.UContext.empty) value =
-  let ce = definition_entry ~univs:ctx value (*FIXME *) in
+let declare_fun f_id kind ?univs value =
+  let ce = definition_entry ?univs value (*FIXME *) in
     ConstRef(declare_constant f_id (DefinitionEntry ce, kind));;
 
 let defined () = Lemmas.save_proof (Vernacexpr.(Proved (Transparent,None)))
 
 let def_of_const t =
-   match (kind_of_term t) with
+   match (Constr.kind t) with
     Const sp ->
       (try (match constant_opt_value_in (Global.env ()) sp with
              | Some c -> c
@@ -115,13 +119,17 @@ let nf_betaiotazeta = (* Reductionops.local_strong Reductionops.whd_betaiotazeta
 (* Generic values *)
 let pf_get_new_ids idl g =
   let ids = pf_ids_of_hyps g in
+  let ids = Id.Set.of_list ids in
   List.fold_right
-    (fun id acc -> next_global_ident_away id (acc@ids)::acc)
+    (fun id acc -> next_global_ident_away id (Id.Set.union (Id.Set.of_list acc) ids)::acc)
     idl
     []
 
+let next_ident_away_in_goal ids avoid =
+  next_ident_away_in_goal ids (Id.Set.of_list avoid)
+
 let compute_renamed_type gls c =
-  rename_bound_vars_as_displayed (project gls) (*no avoid*) [] (*no rels*) []
+  rename_bound_vars_as_displayed (project gls) (*no avoid*) Id.Set.empty (*no rels*) []
     (pf_unsafe_type_of gls c)
 let h'_id = Id.of_string "h'"
 let teq_id = Id.of_string "teq"
@@ -133,13 +141,13 @@ let def_id = Id.of_string "def"
 let p_id = Id.of_string "p"
 let rec_res_id = Id.of_string "rec_res";;
 let lt = function () -> (coq_init_constant "lt")
-let le = function () -> (coq_init_constant "le")
+let le = function () -> (Coqlib.gen_reference_in_modules "RecursiveDefinition" Coqlib.init_modules "le")
 let ex = function () -> (coq_init_constant "ex")
 let nat = function () -> (coq_init_constant "nat")
 let iter_ref () =  
   try find_reference ["Recdef"] "iter" 
   with Not_found -> user_err Pp.(str "module Recdef not loaded")
-let iter = function () -> (constr_of_global (delayed_force iter_ref))
+let iter_rd = function () -> (constr_of_global (delayed_force iter_ref))
 let eq = function () -> (coq_init_constant "eq")
 let le_lt_SS = function () -> (constant ["Recdef"] "le_lt_SS")
 let le_lt_n_Sm = function () -> (coq_constant arith_Lt "le_lt_n_Sm")
@@ -171,8 +179,9 @@ let simpl_iter clause =
     clause
 
 (* Others ugly things ... *)
-let (value_f:Term.constr list -> global_reference -> Term.constr) =
+let (value_f: Constr.t list -> global_reference -> Constr.t) =
   let open Term in
+  let open Constr in
   fun al fterm ->
     let rev_x_id_l =
       (
@@ -190,20 +199,20 @@ let (value_f:Term.constr list -> global_reference -> Term.constr) =
     in
     let env = Environ.push_rel_context context (Global.env ()) in
     let glob_body =
-      CAst.make @@
+      DAst.make @@
        GCases
 	(RegularStyle,None,
-	 [CAst.make @@ GApp(CAst.make @@ GRef(fterm,None), List.rev_map (fun x_id -> CAst.make @@ GVar x_id) rev_x_id_l),
+	 [DAst.make @@ GApp(DAst.make @@ GRef(fterm,None), List.rev_map (fun x_id -> DAst.make @@ GVar x_id) rev_x_id_l),
 	  (Anonymous,None)],
-	 [Loc.tag ([v_id], [CAst.make @@ PatCstr ((destIndRef (delayed_force coq_sig_ref),1),
-			   [CAst.make @@ PatVar(Name v_id); CAst.make @@ PatVar Anonymous],
+	 [Loc.tag ([v_id], [DAst.make @@ PatCstr ((destIndRef (delayed_force coq_sig_ref),1),
+			   [DAst.make @@ PatVar(Name v_id); DAst.make @@ PatVar Anonymous],
                            Anonymous)],
-	    CAst.make @@ GVar v_id)])
+	    DAst.make @@ GVar v_id)])
     in
     let body = fst (understand env (Evd.from_env env) glob_body)(*FIXME*) in
     it_mkLambda_or_LetIn body context
 
-let (declare_f : Id.t -> logical_kind -> Term.constr list -> global_reference -> global_reference) =
+let (declare_f : Id.t -> logical_kind -> Constr.t list -> global_reference -> global_reference) =
   fun f_id kind input_type fterm_ref ->
     declare_fun f_id kind (value_f input_type fterm_ref);;
 
@@ -331,7 +340,8 @@ let check_not_nested sigma forbidden e =
   try 
     check_not_nested e 
   with UserError(_,p) -> 
-    user_err ~hdr:"_" (str "on expr : " ++ Printer.pr_leconstr e ++ str " " ++ p)
+    let _, env = Pfedit.get_current_context () in
+    user_err ~hdr:"_" (str "on expr : " ++ Printer.pr_leconstr_env env sigma e ++ str " " ++ p)
 
 (* ['a info] contains the local information for traveling *)
 type 'a infos = 
@@ -449,7 +459,7 @@ let rec travel_aux jinfo continuation_tac (expr_info:constr infos) g =
 	  check_not_nested sigma (expr_info.f_id::expr_info.forbidden_ids) expr_info.info;
 	  jinfo.otherS () expr_info continuation_tac expr_info g
 	with e when CErrors.noncritical e ->
-	  user_err ~hdr:"Recdef.travel" (str "the term " ++ Printer.pr_leconstr expr_info.info ++ str " can not contain a recursive call to " ++ Id.print expr_info.f_id)
+          user_err ~hdr:"Recdef.travel" (str "the term " ++ Printer.pr_leconstr_env (pf_env g) sigma expr_info.info ++ str " can not contain a recursive call to " ++ Id.print expr_info.f_id)
       end
     | Lambda(n,t,b) -> 
       begin
@@ -457,7 +467,7 @@ let rec travel_aux jinfo continuation_tac (expr_info:constr infos) g =
 	  check_not_nested sigma (expr_info.f_id::expr_info.forbidden_ids) expr_info.info;
 	  jinfo.otherS () expr_info continuation_tac expr_info g
 	with e when CErrors.noncritical e ->
-	  user_err ~hdr:"Recdef.travel" (str "the term " ++ Printer.pr_leconstr expr_info.info ++ str " can not contain a recursive call to " ++ Id.print expr_info.f_id)
+          user_err ~hdr:"Recdef.travel" (str "the term " ++ Printer.pr_leconstr_env (pf_env g) sigma expr_info.info ++ str " can not contain a recursive call to " ++ Id.print expr_info.f_id)
       end
     | Case(ci,t,a,l) -> 
       begin
@@ -485,8 +495,8 @@ let rec travel_aux jinfo continuation_tac (expr_info:constr infos) g =
 	      jinfo.apP (f,args) expr_info continuation_tac in 
 	    travel_args jinfo
 	      expr_info.is_main_branch new_continuation_tac new_infos g
-	  | Case _ ->  user_err ~hdr:"Recdef.travel" (str "the term " ++ Printer.pr_leconstr 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_leconstr expr_info.info ++ Pp.str ".")
+          | Case _ ->  user_err ~hdr:"Recdef.travel" (str "the term " ++ Printer.pr_leconstr_env (pf_env g) sigma 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_leconstr_env (pf_env g) sigma expr_info.info ++ Pp.str ".")
       end
     | Cast(t,_,_) -> travel jinfo continuation_tac {expr_info with info=t} g
     | Const _ | Var _ | Meta _ | Evar _ | Sort _ | Construct _ | Ind _ ->
@@ -509,7 +519,7 @@ and travel_args jinfo is_final continuation_tac infos =
 	{infos with info=arg;is_final=false} 
 and travel jinfo continuation_tac expr_info = 
   observe_tac 
-    (str jinfo.message ++ Printer.pr_leconstr expr_info.info) 
+    (str jinfo.message ++ pr_leconstr_rd expr_info.info)
     (travel_aux jinfo continuation_tac expr_info)
 
 (* Termination proof *) 
@@ -725,7 +735,7 @@ let terminate_case next_step (ci,a,t,l) expr_info continuation_tac infos g =
   let destruct_tac,rev_to_thin_intro = 
     mkDestructEq [expr_info.rec_arg_id] a' g in 
   let to_thin_intro = List.rev rev_to_thin_intro in 
-  observe_tac (str "treating cases (" ++ int (Array.length l) ++ str")" ++ spc () ++ Printer.pr_leconstr a') 
+  observe_tac (str "treating cases (" ++ int (Array.length l) ++ str")" ++ spc () ++ Printer.pr_leconstr_env (pf_env g) sigma a')
     (try
       (tclTHENS
 	 destruct_tac
@@ -734,7 +744,7 @@ let terminate_case next_step (ci,a,t,l) expr_info continuation_tac infos g =
     with 
       | UserError(Some "Refiner.thensn_tac3",_) 
       | UserError(Some "Refiner.tclFAIL_s",_) ->
-	(observe_tac (str "is computable " ++ Printer.pr_leconstr new_info.info) (next_step continuation_tac {new_info with info = nf_betaiotazeta new_info.info} )
+        (observe_tac (str "is computable " ++ Printer.pr_leconstr_env (pf_env g) sigma new_info.info) (next_step continuation_tac {new_info with info = nf_betaiotazeta new_info.info} )
 	))
     g
     
@@ -847,9 +857,13 @@ let rec prove_le g =
     Proofview.V82.of_tactic (apply (delayed_force le_n));
     begin
       try
-	let matching_fun = 
-	  pf_is_matching g
-	    (Pattern.PApp(Pattern.PRef (Globnames.global_of_constr (EConstr.Unsafe.to_constr (le ()))),[|Pattern.PVar (destVar sigma x);Pattern.PMeta None|])) in
+        let matching_fun c = match EConstr.kind sigma c with
+        | App (c, [| x0 ; _ |]) ->
+          EConstr.isVar sigma x0 &&
+          Id.equal (destVar sigma x0) (destVar sigma x) &&
+          EConstr.is_global sigma (le ()) c
+        | _ -> false
+        in
 	let (h,t) = List.find (fun (_,t) -> matching_fun t) (pf_hyps_types g)
 	in 
 	let y = 
@@ -985,11 +999,11 @@ let rec intros_values_eq expr_info acc =
 let equation_others _ expr_info continuation_tac infos = 
   if expr_info.is_final && expr_info.is_main_branch 
   then 
-    observe_tac (str "equation_others (cont_tac +intros) " ++ Printer.pr_leconstr expr_info.info)
+    observe_tac (str "equation_others (cont_tac +intros) " ++ pr_leconstr_rd expr_info.info)
 		(tclTHEN 
       (continuation_tac infos) 
-      (observe_tac (str "intros_values_eq equation_others "  ++ Printer.pr_leconstr expr_info.info) (intros_values_eq expr_info [])))
-  else observe_tac (str "equation_others (cont_tac) " ++ Printer.pr_leconstr expr_info.info) (continuation_tac infos)
+      (observe_tac (str "intros_values_eq equation_others "  ++ pr_leconstr_rd expr_info.info) (intros_values_eq expr_info [])))
+  else observe_tac (str "equation_others (cont_tac) " ++ pr_leconstr_rd expr_info.info) (continuation_tac infos)
 
 let equation_app f_and_args expr_info continuation_tac infos = 
     if expr_info.is_final && expr_info.is_main_branch 
@@ -1035,11 +1049,12 @@ let prove_eq = travel equation_info
 *)
 let compute_terminate_type nb_args func =
   let open Term in
+  let open Constr in
   let open CVars in
   let _,a_arrow_b,_ = destLambda(def_of_const (constr_of_global func)) in
   let rev_args,b = decompose_prod_n nb_args a_arrow_b in
   let left =
-    mkApp(delayed_force iter,
+    mkApp(delayed_force iter_rd,
 	  Array.of_list
 	    (lift 5 a_arrow_b:: mkRel 3::
 	       constr_of_global func::mkRel 1::
@@ -1218,8 +1233,8 @@ let whole_start (concl_tac:tactic) nb_args is_mes func input_type relation rec_a
 
 let get_current_subgoals_types () =
   let p = Proof_global.give_me_the_proof () in
-  let { Evd.it=sgs ; sigma=sigma } = Proof.V82.subgoals p in
-    sigma, List.map (Goal.V82.abstract_type sigma) sgs
+  let sgs,_,_,_,sigma = Proof.proof p in
+  sigma, List.map (Goal.V82.abstract_type sigma) sgs
 
 exception EmptySubgoals
 let build_and_l sigma l =
@@ -1288,8 +1303,8 @@ let build_new_goal_type () =
 let is_opaque_constant c =
   let cb = Global.lookup_constant c in
   match cb.Declarations.const_body with
-    | Declarations.OpaqueDef _ -> Vernacexpr.Opaque None
-    | Declarations.Undef _ -> Vernacexpr.Opaque None
+    | Declarations.OpaqueDef _ -> Vernacexpr.Opaque
+    | Declarations.Undef _ -> Vernacexpr.Opaque
     | Declarations.Def _ -> Vernacexpr.Transparent
 
 let open_new_goal build_proof sigma using_lemmas ref_ goal_name (gls_type,decompose_and_tac,nb_goal)   =
@@ -1302,7 +1317,7 @@ let open_new_goal build_proof sigma using_lemmas ref_ goal_name (gls_type,decomp
 	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
+  let na = next_global_ident_away name Id.Set.empty in
   if Termops.occur_existential sigma gls_type then
     CErrors.user_err Pp.(str "\"abstract\" cannot handle existentials");
   let hook _ _ =
@@ -1412,7 +1427,7 @@ let com_terminate
     nb_args ctx
     hook =
   let start_proof ctx (tac_start:tactic) (tac_end:tactic) =
-    let (evmap, env) = Lemmas.get_current_context() in
+    let evd, env = Pfedit.get_current_context () in
     Lemmas.start_proof thm_name
       (Global, false (* FIXME *), Proof Lemma) ~sign:(Environ.named_context_val env)
       ctx (EConstr.of_constr (compute_terminate_type nb_args fonctional_ref)) hook;
@@ -1456,7 +1471,7 @@ let start_equation (f:global_reference) (term_f:global_reference)
 
 let (com_eqn : int -> Id.t ->
        global_reference -> global_reference -> global_reference
-	 -> Term.constr -> unit) =
+	 -> Constr.t -> unit) =
   fun nb_arg eq_name functional_ref f_ref terminate_ref equation_lemma_type ->
     let open CVars in
     let opacity =
@@ -1464,13 +1479,13 @@ let (com_eqn : int -> Id.t ->
 	| ConstRef c -> is_opaque_constant c
 	| _ -> anomaly ~label:"terminate_lemma" (Pp.str "not a constant.")
     in
-    let (evmap, env) = Lemmas.get_current_context() in
-    let evmap = Evd.from_ctx (Evd.evar_universe_context evmap) in
+    let evd, env = Pfedit.get_current_context () in
+    let evd = Evd.from_ctx (Evd.evar_universe_context evd) in
     let f_constr = constr_of_global f_ref in
     let equation_lemma_type = subst1 f_constr equation_lemma_type in
     (Lemmas.start_proof eq_name (Global, false, Proof Lemma)
        ~sign:(Environ.named_context_val env)
-       evmap
+       evd
        (EConstr.of_constr equation_lemma_type)
        (Lemmas.mk_hook (fun _ _ -> ()));
      ignore (by
@@ -1510,16 +1525,17 @@ let (com_eqn : int -> Id.t ->
 let recursive_definition is_mes function_name rec_impls type_of_f r rec_arg_num eq
     generate_induction_principle using_lemmas : unit =
   let open Term in
+  let open Constr in
   let open CVars in
   let env = Global.env() in
-  let evd = ref (Evd.from_env env) in
-  let function_type = interp_type_evars env evd type_of_f in
+  let evd = Evd.from_env env in
+  let evd, function_type = interp_type_evars env evd type_of_f in
   let function_type = EConstr.Unsafe.to_constr function_type in
   let env = push_named (Context.Named.Declaration.LocalAssum (function_name,function_type)) env in
   (* Pp.msgnl (str "function type := " ++ Printer.pr_lconstr function_type);  *)
-  let ty = interp_type_evars env evd ~impls:rec_impls eq in
+  let evd, ty = interp_type_evars env evd ~impls:rec_impls eq in
   let ty = EConstr.Unsafe.to_constr ty in
-  let evm, nf = Evarutil.nf_evars_and_universes !evd in
+  let evd, nf = Evarutil.nf_evars_and_universes evd in
   let equation_lemma_type = nf_betaiotazeta (EConstr.of_constr (nf ty)) in
   let function_type = nf function_type in
   let equation_lemma_type = EConstr.Unsafe.to_constr equation_lemma_type in
@@ -1532,7 +1548,7 @@ let recursive_definition is_mes function_name rec_impls type_of_f r rec_arg_num
 (*     Pp.msgnl (str "res_var :=" ++ Printer.pr_lconstr_env (push_rel_context (List.map (function (x,t) -> (x,None,t)) res_vars) env) eq'); *)
 (*     Pp.msgnl (str "rec_arg_num := " ++ str (string_of_int rec_arg_num)); *)
 (*     Pp.msgnl (str "eq' := " ++ str (string_of_int rec_arg_num)); *)
-    match kind_of_term eq' with
+    match Constr.kind eq' with
       | App(e,[|_;_;eq_fix|]) ->
 	  mkLambda (Name function_name,function_type,subst_var function_name (compose_lam res_vars  eq_fix))
       | _ -> failwith "Recursive Definition (res not eq)"
@@ -1543,14 +1559,17 @@ let recursive_definition is_mes function_name rec_impls type_of_f r rec_arg_num
   let equation_id = add_suffix function_name "_equation" in
   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
+  let functional_ref =
+    let univs = Entries.Monomorphic_const_entry (Evd.universe_context_set evd) in
+    declare_fun functional_id (IsDefinition Decl_kinds.Definition) ~univs res
+  in
   (* Refresh the global universes, now including those of _F *)
-  let evm = Evd.from_env (Global.env ()) in
+  let evd = 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, evuctx =
-    interp_constr env_with_pre_rec_args evm r
+    interp_constr env_with_pre_rec_args evd r
   in
-  let evm = Evd.from_ctx evuctx in
+  let evd = Evd.from_ctx evuctx in
   let tcc_lemma_name = add_suffix function_name "_tcc" in
   let tcc_lemma_constr = ref Undefined in
   (* let _ = Pp.msgnl (str "relation := " ++ Printer.pr_lconstr_env env_with_pre_rec_args relation) in *)
@@ -1580,7 +1599,7 @@ let recursive_definition is_mes function_name rec_impls type_of_f r rec_arg_num
       and functional_ref = destConst (constr_of_global functional_ref)
       and eq_ref = destConst (constr_of_global eq_ref) in
       generate_induction_principle f_ref tcc_lemma_constr
-	functional_ref eq_ref rec_arg_num (EConstr.of_constr rec_arg_type) (nb_prod evm (EConstr.of_constr res)) (EConstr.of_constr relation);
+        functional_ref eq_ref rec_arg_num (EConstr.of_constr rec_arg_type) (nb_prod evd (EConstr.of_constr res)) (EConstr.of_constr relation);
       Flags.if_verbose
         msgnl (h 1 (Ppconstr.pr_id function_name ++
 			 spc () ++ str"is defined" )++ fnl () ++
@@ -1588,7 +1607,8 @@ let recursive_definition is_mes function_name rec_impls type_of_f r rec_arg_num
 			   spc () ++ str"is defined" )
       )
   in
-  States.with_state_protection_on_exception (fun () ->
+  (* XXX STATE Why do we need this... why is the toplevel protection not enought *)
+  funind_purify (fun () ->
     com_terminate
       tcc_lemma_name
       tcc_lemma_constr
@@ -1598,5 +1618,5 @@ let recursive_definition is_mes function_name rec_impls type_of_f r rec_arg_num
       term_id
       using_lemmas
       (List.length res_vars)
-      evm (Lemmas.mk_hook hook))
+      evd (Lemmas.mk_hook hook))
     ()
diff --git a/plugins/funind/recdef.mli b/plugins/funind/recdef.mli
index 63bbdbe7e..b95d64ce9 100644
--- a/plugins/funind/recdef.mli
+++ b/plugins/funind/recdef.mli
@@ -1,5 +1,5 @@
+open Constr
 
-(* val evaluable_of_global_reference : Libnames.global_reference -> Names.evaluable_global_reference *)
 val tclUSER_if_not_mes : 
   Tacmach.tactic ->
   bool -> 
@@ -11,9 +11,9 @@ bool ->
            Constrintern.internalization_env ->
            Constrexpr.constr_expr ->
            Constrexpr.constr_expr ->
-           int -> Constrexpr.constr_expr -> (Term.pconstant ->
+           int -> Constrexpr.constr_expr -> (pconstant ->
             Indfun_common.tcc_lemma_value ref ->
-            Term.pconstant ->
-            Term.pconstant -> int -> EConstr.types -> int -> EConstr.constr -> 'a) -> Constrexpr.constr_expr list -> unit
+            pconstant ->
+            pconstant -> int -> EConstr.types -> int -> EConstr.constr -> 'a) -> Constrexpr.constr_expr list -> unit
 
 
diff --git a/plugins/funind/recdef_plugin.mlpack b/plugins/funind/recdef_plugin.mlpack
index 2b443f2a1..755fa4f87 100644
--- a/plugins/funind/recdef_plugin.mlpack
+++ b/plugins/funind/recdef_plugin.mlpack
@@ -6,5 +6,4 @@ Functional_principles_proofs
 Functional_principles_types
 Invfun
 Indfun
-Merge
 G_indfun
diff --git a/plugins/ltac/coretactics.ml4 b/plugins/ltac/coretactics.ml4
index 2769802cf..794a28dd4 100644
--- a/plugins/ltac/coretactics.ml4
+++ b/plugins/ltac/coretactics.ml4
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Util
 open Locus
 open Misctypes
@@ -348,7 +346,7 @@ let () = register_list_tactical "solve" Tacticals.New.tclSOLVE
 
 let initial_tacticals () =
   let idn n = Id.of_string (Printf.sprintf "_%i" n) in
-  let varn n = Reference (ArgVar (None, idn n)) in
+  let varn n = Reference (ArgVar (CAst.make (idn n))) in
   let iter (s, t) = Tacenv.register_ltac false false (Id.of_string s) t in
   List.iter iter [
     "first", TacFun ([Name (idn 0)], TacML (None, (initial_entry "first", [varn 0])));
diff --git a/plugins/ltac/evar_tactics.ml b/plugins/ltac/evar_tactics.ml
index 4cab6ef33..1f628803a 100644
--- a/plugins/ltac/evar_tactics.ml
+++ b/plugins/ltac/evar_tactics.ml
@@ -17,6 +17,7 @@ open Refiner
 open Evd
 open Locus
 open Context.Named.Declaration
+open Ltac_pretype
 
 module NamedDecl = Context.Named.Declaration
 
@@ -27,7 +28,7 @@ let instantiate_evar evk (ist,rawc) sigma =
   let filtered = Evd.evar_filtered_env evi in
   let constrvars = Tacinterp.extract_ltac_constr_values ist filtered in
   let lvar = {
-    Glob_term.ltac_constrs = constrvars;
+    ltac_constrs = constrvars;
     ltac_uconstrs = Names.Id.Map.empty;
     ltac_idents = Names.Id.Map.empty;
     ltac_genargs = ist.Geninterp.lfun;
@@ -88,7 +89,7 @@ let let_evar name typ =
     let id = match name with
     | Name.Anonymous ->
       let id = Namegen.id_of_name_using_hdchar env sigma typ name in
-      Namegen.next_ident_away_in_goal id (Termops.ids_of_named_context (Environ.named_context env))
+      Namegen.next_ident_away_in_goal id (Termops.vars_of_env env)
     | Name.Name id -> id
     in
     let (sigma, evar) = Evarutil.new_evar env sigma ~src ~naming:(Misctypes.IntroFresh id) typ in
diff --git a/plugins/ltac/extraargs.ml4 b/plugins/ltac/extraargs.ml4
index 89feea8dc..2eb1ef315 100644
--- a/plugins/ltac/extraargs.ml4
+++ b/plugins/ltac/extraargs.ml4
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Pp
 open Genarg
 open Stdarg
@@ -83,7 +81,7 @@ let pr_int_list_full _prc _prlc _prt l = pr_int_list l
 let pr_occurrences _prc _prlc _prt l =
   match l with
     | ArgArg x -> pr_int_list x
-    | ArgVar (loc, id) -> Id.print id
+    | ArgVar { CAst.loc = loc; v=id } -> Id.print id
 
 let occurrences_of = function
   | [] -> NoOccurrences
@@ -104,7 +102,7 @@ let int_list_of_VList v = match Value.to_list v with
 let interp_occs ist gl l =
   match l with
     | ArgArg x -> x
-    | ArgVar (_,id as locid) ->
+    | ArgVar ({ CAst.v = id } as locid) ->
 	(try int_list_of_VList (Id.Map.find id ist.lfun)
 	  with Not_found | CannotCoerceTo _ -> [interp_int ist locid])
 let interp_occs ist gl l =
@@ -133,7 +131,9 @@ let pr_occurrences = pr_occurrences () () ()
 
 let pr_gen prc _prlc _prtac c = prc c
 
-let pr_globc _prc _prlc _prtac (_,glob) = Printer.pr_glob_constr glob
+let pr_globc _prc _prlc _prtac (_,glob) =
+  let _, env = Pfedit.get_current_context () in
+  Printer.pr_glob_constr_env env glob
 
 let interp_glob ist gl (t,_) = Tacmach.project gl , (ist,t)
 
@@ -188,7 +188,7 @@ END
 
 type 'id gen_place= ('id * hyp_location_flag,unit) location
 
-type loc_place = Id.t Loc.located gen_place
+type loc_place = lident gen_place
 type place = Id.t gen_place
 
 let pr_gen_place pr_id = function
@@ -199,7 +199,7 @@ let pr_gen_place pr_id = function
   | HypLocation (id,InHypValueOnly) ->
       str "in (Value of " ++ pr_id id ++ str ")"
 
-let pr_loc_place _ _ _ = pr_gen_place (fun (_,id) -> Id.print id)
+let pr_loc_place _ _ _ = pr_gen_place (fun { CAst.v = id } -> Id.print id)
 let pr_place _ _ _ = pr_gen_place Id.print
 let pr_hloc = pr_loc_place () () ()
 
@@ -228,11 +228,11 @@ ARGUMENT EXTEND hloc
   |  [ "in" "|-" "*" ] ->
     [ ConclLocation () ]
 | [ "in" ident(id) ] ->
-    [ HypLocation ((Loc.tag id),InHyp) ]
+    [ HypLocation ((CAst.make id),InHyp) ]
 | [ "in" "(" "Type" "of" ident(id) ")" ] ->
-    [ HypLocation ((Loc.tag id),InHypTypeOnly) ]
+    [ HypLocation ((CAst.make id),InHypTypeOnly) ]
 | [ "in" "(" "Value" "of" ident(id) ")" ] ->
-    [ HypLocation ((Loc.tag id),InHypValueOnly) ]
+    [ HypLocation ((CAst.make id),InHypValueOnly) ]
 
  END
 
diff --git a/plugins/ltac/extraargs.mli b/plugins/ltac/extraargs.mli
index 00668ddc7..000c3d2fb 100644
--- a/plugins/ltac/extraargs.mli
+++ b/plugins/ltac/extraargs.mli
@@ -50,7 +50,7 @@ val lglob : constr_expr Pcoq.Gram.entry
 
 type 'id gen_place= ('id * Locus.hyp_location_flag,unit) location
 
-type loc_place = Id.t Loc.located gen_place
+type loc_place = lident gen_place
 type place = Id.t gen_place
 
 val wit_hloc : (loc_place, loc_place, place) Genarg.genarg_type
@@ -77,6 +77,6 @@ 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
+  (lident Locus.clause_expr,
+   lident Locus.clause_expr,
+   Id.t   Locus.clause_expr) Genarg.genarg_type
diff --git a/plugins/ltac/extratactics.ml4 b/plugins/ltac/extratactics.ml4
index b847aadf2..10be8a842 100644
--- a/plugins/ltac/extratactics.ml4
+++ b/plugins/ltac/extratactics.ml4
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Pp
 open Genarg
 open Stdarg
@@ -25,6 +23,7 @@ open Termops
 open Equality
 open Misctypes
 open Proofview.Notations
+open Vernacinterp
 
 DECLARE PLUGIN "ltac_plugin"
 
@@ -72,7 +71,7 @@ END
 
 let induction_arg_of_quantified_hyp = function
   | AnonHyp n -> None,ElimOnAnonHyp n
-  | NamedHyp id -> None,ElimOnIdent (Loc.tag id)
+  | NamedHyp id -> None,ElimOnIdent (CAst.make id)
 
 (* Versions *_main must come first!! so that "1" is interpreted as a
    ElimOnAnonHyp and not as a "constr", and "id" is interpreted as a
@@ -91,12 +90,12 @@ let elimOnConstrWithHoles tac with_evars c =
     (fun c -> tac with_evars (Some (None,ElimOnConstr c)))
 
 TACTIC EXTEND simplify_eq
-  [ "simplify_eq" ] -> [ dEq false None ]
-| [ "simplify_eq" destruction_arg(c) ] -> [ mytclWithHoles dEq false c ]
+  [ "simplify_eq" ] -> [ dEq ~keep_proofs:None false None ]
+| [ "simplify_eq" destruction_arg(c) ] -> [ mytclWithHoles (dEq ~keep_proofs:None) false c ]
 END
 TACTIC EXTEND esimplify_eq
-| [ "esimplify_eq" ] -> [ dEq true None ]
-| [ "esimplify_eq" destruction_arg(c) ] -> [ mytclWithHoles dEq true c ]
+| [ "esimplify_eq" ] -> [ dEq ~keep_proofs:None true None ]
+| [ "esimplify_eq" destruction_arg(c) ] -> [ mytclWithHoles (dEq ~keep_proofs:None) true c ]
 END
 
 let discr_main c = elimOnConstrWithHoles discr_tac false c
@@ -117,31 +116,31 @@ let discrHyp id =
   discr_main (fun env sigma -> (sigma, (EConstr.mkVar id, NoBindings)))
 
 let injection_main with_evars c =
- elimOnConstrWithHoles (injClause None) with_evars c
+ elimOnConstrWithHoles (injClause None None) with_evars c
 
 TACTIC EXTEND injection
-| [ "injection" ] -> [ injClause None false None ]
-| [ "injection" destruction_arg(c) ] -> [ mytclWithHoles (injClause None) false c ]
+| [ "injection" ] -> [ injClause None None false None ]
+| [ "injection" destruction_arg(c) ] -> [ mytclWithHoles (injClause None None) false c ]
 END
 TACTIC EXTEND einjection
-| [ "einjection" ] -> [ injClause None true None ]
-| [ "einjection" destruction_arg(c) ] -> [ mytclWithHoles (injClause None) true c ]
+| [ "einjection" ] -> [ injClause None None true None ]
+| [ "einjection" destruction_arg(c) ] -> [ mytclWithHoles (injClause None None) true c ]
 END
 TACTIC EXTEND injection_as
 | [ "injection" "as" intropattern_list(ipat)] ->
-    [ injClause (Some ipat) false None ]
+    [ injClause None (Some ipat) false None ]
 | [ "injection" destruction_arg(c) "as" intropattern_list(ipat)] ->
-    [ mytclWithHoles (injClause (Some ipat)) false c ]
+    [ mytclWithHoles (injClause None (Some ipat)) false c ]
 END
 TACTIC EXTEND einjection_as
 | [ "einjection" "as" intropattern_list(ipat)] ->
-    [ injClause (Some ipat) true None ]
+    [ injClause None (Some ipat) true None ]
 | [ "einjection" destruction_arg(c) "as" intropattern_list(ipat)] ->
-    [ mytclWithHoles (injClause (Some ipat)) true c ]
+    [ mytclWithHoles (injClause None (Some ipat)) true c ]
 END
 TACTIC EXTEND simple_injection
-| [ "simple" "injection" ] -> [ simpleInjClause false None ]
-| [ "simple" "injection" destruction_arg(c) ] -> [ mytclWithHoles simpleInjClause false c ]
+| [ "simple" "injection" ] -> [ simpleInjClause None false None ]
+| [ "simple" "injection" destruction_arg(c) ] -> [ mytclWithHoles (simpleInjClause None) false c ]
 END
 
 let injHyp id =
@@ -249,11 +248,10 @@ TACTIC EXTEND rewrite_star
 (**********************************************************************)
 (* Hint Rewrite                                                       *)
 
-let add_rewrite_hint bases ort t lcsr =
+let add_rewrite_hint ~poly bases ort t lcsr =
   let env = Global.env() in
   let sigma = Evd.from_env env in
-  let poly = Flags.use_polymorphic_flag () in
-  let f ce = 
+  let f ce =
     let c, ctx = Constrintern.interp_constr env sigma ce in
     let ctx =
       let ctx = UState.context_set ctx in
@@ -270,16 +268,16 @@ let add_rewrite_hint bases ort t lcsr =
 
 let classify_hint _ = Vernacexpr.VtSideff [], Vernacexpr.VtLater
 
-VERNAC COMMAND EXTEND HintRewrite CLASSIFIED BY classify_hint
+VERNAC COMMAND FUNCTIONAL EXTEND HintRewrite CLASSIFIED BY classify_hint
   [ "Hint" "Rewrite" orient(o) ne_constr_list(l) ":" preident_list(bl) ] ->
-  [ add_rewrite_hint bl o None l ]
+  [ fun ~atts ~st -> add_rewrite_hint ~poly:atts.polymorphic bl o None l; st ]
 | [ "Hint" "Rewrite" orient(o) ne_constr_list(l) "using" tactic(t)
     ":" preident_list(bl) ] ->
-  [ add_rewrite_hint bl o (Some t) l ]
+  [ fun ~atts ~st -> add_rewrite_hint ~poly:atts.polymorphic bl o (Some t) l; st ]
 | [ "Hint" "Rewrite" orient(o) ne_constr_list(l) ] ->
-  [ add_rewrite_hint ["core"] o None l ]
+  [ fun ~atts ~st -> add_rewrite_hint ~poly:atts.polymorphic ["core"] o None l; st ]
 | [ "Hint" "Rewrite" orient(o) ne_constr_list(l) "using" tactic(t) ] ->
-  [ add_rewrite_hint ["core"] o (Some t) l ]
+  [ fun ~atts ~st -> add_rewrite_hint ~poly:atts.polymorphic ["core"] o (Some t) l; st ]
 END
 
 (**********************************************************************)
@@ -290,7 +288,7 @@ open EConstr
 open Vars
 open Coqlib
 
-let project_hint pri l2r r =
+let project_hint ~poly pri l2r r =
   let gr = Smartlocate.global_with_alias r in
   let env = Global.env() in
   let sigma = Evd.from_env env in
@@ -313,30 +311,47 @@ let project_hint pri l2r r =
   let id =
     Nameops.add_suffix (Nametab.basename_of_global gr) ("_proj_" ^ (if l2r then "l2r" else "r2l"))
   in
-  let ctx = Evd.universe_context_set sigma in
+  let ctx = Evd.const_univ_entry ~poly sigma in
   let c = EConstr.to_constr sigma c in
   let c = Declare.declare_definition ~internal:Declare.InternalTacticRequest id (c,ctx) in
   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 =
-  let l = Locality.LocalityFixme.consume () in
-  Hints.add_hints (Locality.make_module_locality l) bl
-    (Hints.HintsResolveEntry (List.map (project_hint n l2r) lc))
+let add_hints_iff ~atts l2r lc n bl =
+  let open Vernacinterp in
+  Hints.add_hints (Locality.make_module_locality atts.locality) bl
+    (Hints.HintsResolveEntry (List.map (project_hint ~poly:atts.polymorphic n l2r) lc))
 
-VERNAC COMMAND EXTEND HintResolveIffLR CLASSIFIED AS SIDEFF
+VERNAC COMMAND FUNCTIONAL EXTEND HintResolveIffLR CLASSIFIED AS SIDEFF
   [ "Hint" "Resolve" "->" ne_global_list(lc) natural_opt(n)
     ":" preident_list(bl) ] ->
-  [ add_hints_iff true lc n bl ]
+  [ fun ~atts ~st -> begin
+        add_hints_iff ~atts true lc n bl;
+        st
+      end
+  ]
 | [ "Hint" "Resolve" "->" ne_global_list(lc) natural_opt(n) ] ->
-  [ add_hints_iff true lc n ["core"] ]
+  [ fun ~atts ~st -> begin
+        add_hints_iff ~atts true lc n ["core"];
+        st
+      end
+  ]
 END
-VERNAC COMMAND EXTEND HintResolveIffRL CLASSIFIED AS SIDEFF
+
+VERNAC COMMAND FUNCTIONAL EXTEND HintResolveIffRL CLASSIFIED AS SIDEFF
   [ "Hint" "Resolve" "<-" ne_global_list(lc) natural_opt(n)
     ":" preident_list(bl) ] ->
-  [ add_hints_iff false lc n bl ]
+  [ fun ~atts ~st -> begin
+        add_hints_iff ~atts false lc n bl;
+        st
+      end
+  ]
 | [ "Hint" "Resolve" "<-" ne_global_list(lc) natural_opt(n) ] ->
-  [ add_hints_iff false lc n ["core"] ]
+  [ fun ~atts ~st -> begin
+        add_hints_iff ~atts false lc n ["core"];
+        st
+      end
+  ]
 END
 
 (**********************************************************************)
@@ -403,40 +418,52 @@ open Leminv
 
 let seff id = Vernacexpr.VtSideff [id], Vernacexpr.VtLater
 
-VERNAC ARGUMENT EXTEND sort
-| [ "Set" ] -> [ GSet ]
-| [ "Prop" ] -> [ GProp ]
-| [ "Type" ] -> [ GType [] ]
-END
+(*VERNAC ARGUMENT EXTEND sort_family
+| [ "Set" ] -> [ InSet ]
+| [ "Prop" ] -> [ InProp ]
+| [ "Type" ] -> [ InType ]
+END*)
 
-VERNAC COMMAND EXTEND DeriveInversionClear
-| [ "Derive" "Inversion_clear" ident(na) "with" constr(c) "Sort" sort(s) ]
+VERNAC COMMAND FUNCTIONAL EXTEND DeriveInversionClear
+| [ "Derive" "Inversion_clear" ident(na) "with" constr(c) "Sort" sort_family(s) ]
   => [ seff na ]
-  -> [ add_inversion_lemma_exn na c s false inv_clear_tac ]
+  -> [ fun ~atts ~st ->
+      let open Vernacinterp in
+      add_inversion_lemma_exn ~poly:atts.polymorphic na c s false inv_clear_tac; st ]
 
 | [ "Derive" "Inversion_clear" ident(na) "with" constr(c) ] => [ seff na ]
-  -> [ add_inversion_lemma_exn na c GProp false inv_clear_tac ]
+  -> [ fun ~atts ~st ->
+      let open Vernacinterp in
+      add_inversion_lemma_exn ~poly:atts.polymorphic na c Sorts.InProp false inv_clear_tac; st ]
 END
 
-VERNAC COMMAND EXTEND DeriveInversion
-| [ "Derive" "Inversion" ident(na) "with" constr(c) "Sort" sort(s) ]
+VERNAC COMMAND FUNCTIONAL EXTEND DeriveInversion
+| [ "Derive" "Inversion" ident(na) "with" constr(c) "Sort" sort_family(s) ]
   => [ seff na ]
-  -> [ add_inversion_lemma_exn na c s false inv_tac ]
+  -> [ fun ~atts ~st ->
+      let open Vernacinterp in
+      add_inversion_lemma_exn ~poly:atts.polymorphic na c s false inv_tac; st ]
 
 | [ "Derive" "Inversion" ident(na) "with" constr(c) ] => [ seff na ]
-  -> [ add_inversion_lemma_exn na c GProp false inv_tac ]
+  -> [ fun ~atts ~st ->
+      let open Vernacinterp in
+      add_inversion_lemma_exn ~poly:atts.polymorphic na c Sorts.InProp false inv_tac; st ]
 END
 
-VERNAC COMMAND EXTEND DeriveDependentInversion
-| [ "Derive" "Dependent" "Inversion" ident(na) "with" constr(c) "Sort" sort(s) ]
+VERNAC COMMAND FUNCTIONAL EXTEND DeriveDependentInversion
+| [ "Derive" "Dependent" "Inversion" ident(na) "with" constr(c) "Sort" sort_family(s) ]
   => [ seff na ]
-  -> [ add_inversion_lemma_exn na c s true dinv_tac ]
+  -> [  fun ~atts ~st ->
+      let open Vernacinterp in
+      add_inversion_lemma_exn ~poly:atts.polymorphic na c s true dinv_tac; st ]
 END
 
-VERNAC COMMAND EXTEND DeriveDependentInversionClear
-| [ "Derive" "Dependent" "Inversion_clear" ident(na) "with" constr(c) "Sort" sort(s) ]
+VERNAC COMMAND FUNCTIONAL EXTEND DeriveDependentInversionClear
+| [ "Derive" "Dependent" "Inversion_clear" ident(na) "with" constr(c) "Sort" sort_family(s) ]
   => [ seff na ]
-  -> [ add_inversion_lemma_exn na c s true dinv_clear_tac ]
+  -> [  fun ~atts ~st ->
+      let open Vernacinterp in
+      add_inversion_lemma_exn ~poly:atts.polymorphic na c s true dinv_clear_tac; st ]
 END
 
 (**********************************************************************)
@@ -514,7 +541,7 @@ let cache_transitivity_lemma (_,(left,lem)) =
 
 let subst_transitivity_lemma (subst,(b,ref)) = (b,subst_mps subst ref)
 
-let inTransitivity : bool * Term.constr -> obj =
+let inTransitivity : bool * Constr.t -> obj =
   declare_object {(default_object "TRANSITIVITY-STEPS") with
     cache_function = cache_transitivity_lemma;
     open_function = (fun i o -> if Int.equal i 1 then cache_transitivity_lemma o);
@@ -626,19 +653,19 @@ END
 let subst_var_with_hole occ tid t = 
   let occref = if occ > 0 then ref occ else Find_subterm.error_invalid_occurrence [occ] in
   let locref = ref 0 in
-  let rec substrec = function
-    | { CAst.v = GVar id } as x -> 
+  let rec substrec x = match DAst.get x with
+    | GVar id ->
         if Id.equal id tid 
         then
 	  (decr occref;
 	   if Int.equal !occref 0 then x
            else
 	     (incr locref;
-              CAst.make ~loc:(Loc.make_loc (!locref,0)) @@
+              DAst.make ~loc:(Loc.make_loc (!locref,0)) @@
 	      GHole (Evar_kinds.QuestionMark(Evar_kinds.Define true,Anonymous),
                      Misctypes.IntroAnonymous, None)))
         else x
-    | c -> map_glob_constr_left_to_right substrec c in
+    | _ -> map_glob_constr_left_to_right substrec x in
   let t' = substrec t
   in
   if !occref > 0 then Find_subterm.error_invalid_occurrence [occ] else t'
@@ -646,15 +673,15 @@ let subst_var_with_hole occ tid t =
 let subst_hole_with_term occ tc t =
   let locref = ref 0 in
   let occref = ref occ in
-  let rec substrec = function
-    | { CAst.v = GHole (Evar_kinds.QuestionMark(Evar_kinds.Define true,Anonymous),Misctypes.IntroAnonymous,s) } ->
+  let rec substrec c = match DAst.get c with
+    | GHole (Evar_kinds.QuestionMark(Evar_kinds.Define true,Anonymous),Misctypes.IntroAnonymous,s) ->
         decr occref;
         if Int.equal !occref 0 then tc
         else
 	  (incr locref;
-           CAst.make ~loc:(Loc.make_loc (!locref,0)) @@
+           DAst.make ~loc:(Loc.make_loc (!locref,0)) @@
 	   GHole (Evar_kinds.QuestionMark(Evar_kinds.Define true,Anonymous),Misctypes.IntroAnonymous,s))
-    | c -> map_glob_constr_left_to_right substrec c
+    | _ -> map_glob_constr_left_to_right substrec c
   in
   substrec t
 
@@ -665,9 +692,9 @@ let hResolve id c occ t =
   let sigma = Proofview.Goal.sigma gl in
   let env = Termops.clear_named_body id (Proofview.Goal.env gl) in
   let concl = Proofview.Goal.concl gl in
-  let env_ids = Termops.ids_of_context env in
-  let c_raw = Detyping.detype true env_ids env sigma c in
-  let t_raw = Detyping.detype true env_ids env sigma t in
+  let env_ids = Termops.vars_of_env env in
+  let c_raw = Detyping.detype Detyping.Now true env_ids env sigma c in
+  let t_raw = Detyping.detype Detyping.Now true env_ids env sigma t in
   let rec resolve_hole t_hole =
     try 
       Pretyping.understand env sigma t_hole
@@ -764,7 +791,7 @@ let case_eq_intros_rewrite x =
       mkCaseEq x;
     Proofview.Goal.enter begin fun gl ->
       let concl = Proofview.Goal.concl gl in
-      let hyps = Tacmach.New.pf_ids_of_hyps gl in
+      let hyps = Tacmach.New.pf_ids_set_of_hyps gl in
       let n' = nb_prod (Tacmach.New.project gl) concl in
       let h = fresh_id_in_env hyps (Id.of_string "heq") (Proofview.Goal.env gl)  in
       Tacticals.New.tclTHENLIST [
@@ -852,34 +879,12 @@ TACTIC EXTEND is_evar
     ]
 END
 
-let has_evar sigma c =
-let rec has_evar x =
-  match EConstr.kind sigma x with
-    | Evar _ -> true
-    | Rel _ | Var _ | Meta _ | Sort _ | Const _ | Ind _ | Construct _ ->
-      false
-    | Cast (t1, _, t2) | Prod (_, t1, t2) | Lambda (_, t1, t2) ->
-      has_evar t1 || has_evar t2
-    | LetIn (_, t1, t2, t3) ->
-      has_evar t1 || has_evar t2 || has_evar t3
-    | App (t1, ts) ->
-      has_evar t1 || has_evar_array ts
-    | Case (_, t1, t2, ts) ->
-      has_evar t1 || has_evar t2 || has_evar_array ts
-    | Fix ((_, tr)) | CoFix ((_, tr)) ->
-      has_evar_prec tr
-    | Proj (p, c) -> has_evar c
-and has_evar_array x =
-  Array.exists has_evar x
-and has_evar_prec (_, ts1, ts2) =
-  Array.exists has_evar ts1 || Array.exists has_evar ts2
-in
-has_evar c
-
 TACTIC EXTEND has_evar
 | [ "has_evar" constr(x) ] -> [
   Proofview.tclEVARMAP >>= fun sigma ->
-  if has_evar sigma x then Proofview.tclUNIT () else Tacticals.New.tclFAIL 0 (str "No evars")
+  if Evarutil.has_undefined_evars sigma x
+  then Proofview.tclUNIT ()
+  else Tacticals.New.tclFAIL 0 (str "No evars")
 ]
 END
 
@@ -1118,3 +1123,12 @@ VERNAC COMMAND EXTEND OptimizeProof
 | [ "Optimize" "Heap" ] => [ Vernac_classifier.classify_as_proofstep ] ->
   [ Gc.compact () ]
 END
+
+(** tactic analogous to "OPTIMIZE HEAP" *)
+
+let tclOPTIMIZE_HEAP =
+  Proofview.tclLIFT (Proofview.NonLogical.make (fun () -> Gc.compact ()))
+
+TACTIC EXTEND optimize_heap
+| [ "optimize_heap" ] -> [ tclOPTIMIZE_HEAP ]
+END
diff --git a/plugins/ltac/g_auto.ml4 b/plugins/ltac/g_auto.ml4
index 5baa0d5c1..f74d24db0 100644
--- a/plugins/ltac/g_auto.ml4
+++ b/plugins/ltac/g_auto.ml4
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Pp
 open Genarg
 open Stdarg
@@ -51,8 +49,12 @@ let eval_uconstrs ist cs =
   List.map (fun c -> map (Tacinterp.type_uconstr ~flags ist c)) cs
 
 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
+let pr_auto_using_glob _ _ _ = Pptactic.pr_auto_using (fun (c,_) ->
+    let _, env = Pfedit.get_current_context () in
+    Printer.pr_glob_constr_env env c)
+let pr_auto_using _ _ _ = Pptactic.pr_auto_using
+    (let sigma, env = Pfedit.get_current_context () in
+     Printer.pr_closed_glob_env env sigma)
 
 ARGUMENT EXTEND auto_using
   TYPED AS uconstr_list
@@ -186,7 +188,7 @@ 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
 
@@ -210,10 +212,15 @@ ARGUMENT EXTEND opthints
 | [ ] -> [ None ]
 END
 
-VERNAC COMMAND EXTEND HintCut CLASSIFIED AS SIDEFF
+VERNAC COMMAND FUNCTIONAL EXTEND HintCut CLASSIFIED AS SIDEFF
 | [ "Hint" "Cut" "[" hints_path(p) "]" opthints(dbnames) ] -> [
-  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 ]
+    fun ~atts ~st -> begin
+        let open Vernacinterp in
+        let entry = Hints.HintsCutEntry (Hints.glob_hints_path p) in
+        Hints.add_hints (Locality.make_section_locality atts.locality)
+          (match dbnames with None -> ["core"] | Some l -> l) entry;
+        st
+      end
+ ]
 END
 
diff --git a/plugins/ltac/g_class.ml4 b/plugins/ltac/g_class.ml4
index 104977aef..014433ac4 100644
--- a/plugins/ltac/g_class.ml4
+++ b/plugins/ltac/g_class.ml4
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Class_tactics
 open Stdarg
 open Tacarg
@@ -91,7 +89,7 @@ END
 
 (** TODO: DEPRECATE *)
 (* A progress test that allows to see if the evars have changed *)
-open Term
+open Constr
 open Proofview.Notations
 
 let rec eq_constr_mod_evars sigma x y =
diff --git a/plugins/ltac/g_eqdecide.ml4 b/plugins/ltac/g_eqdecide.ml4
index 549436902..f705778fc 100644
--- a/plugins/ltac/g_eqdecide.ml4
+++ b/plugins/ltac/g_eqdecide.ml4
@@ -12,8 +12,6 @@
 (*                           by Eduardo Gimenez                        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Eqdecide
 
 DECLARE PLUGIN "ltac_plugin"
diff --git a/plugins/ltac/g_ltac.ml4 b/plugins/ltac/g_ltac.ml4
index 2ea0f60eb..85c9fc5fd 100644
--- a/plugins/ltac/g_ltac.ml4
+++ b/plugins/ltac/g_ltac.ml4
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 DECLARE PLUGIN "ltac_plugin"
 
 open Util
@@ -17,7 +15,7 @@ open Tacexpr
 open Misctypes
 open Genarg
 open Genredexpr
-open Tok (* necessary for camlp4 *)
+open Tok (* necessary for camlp5 *)
 open Names
 
 open Pcoq
@@ -39,10 +37,10 @@ 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.Ident (loc, id) -> CAst.make ?loc id
   | Libnames.Qualid (loc,_) ->
-      CErrors.user_err ?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"
 
@@ -78,11 +76,6 @@ let test_bracket_ident =
 
 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 command hint
           tactic_mode constr_may_eval constr_eval toplevel_selector
@@ -203,7 +196,7 @@ GEXTEND Gram
      verbose most of the time. *)
   fresh_id:
     [ [ s = STRING -> ArgArg s (*| id = ident -> ArgVar (!@loc,id)*)
-	| qid = qualid -> let (_pth,id) = Libnames.repr_qualid (snd qid) in ArgVar (Loc.tag ~loc:!@loc id) ] ]
+        | qid = qualid -> let (_pth,id) = Libnames.repr_qualid (snd qid) in ArgVar (CAst.make ~loc:!@loc id) ] ]
   ;
   constr_eval:
     [ [ IDENT "eval"; rtc = red_expr; "in"; c = Constr.constr ->
@@ -232,20 +225,17 @@ GEXTEND Gram
       | l = ident -> Name.Name l ] ]
   ;
   let_clause:
-    [ [ id = identref; ":="; te = tactic_expr ->
-         (id, arg_of_expr te)
-      | id = identref; args = LIST1 input_fun; ":="; te = tactic_expr ->
-         (id, arg_of_expr (TacFun(args,te))) ] ]
+    [ [ idr = identref; ":="; te = tactic_expr ->
+         (CAst.map (fun id -> Name id) idr, arg_of_expr te)
+      | na = ["_" -> CAst.make ~loc:!@loc Anonymous]; ":="; te = tactic_expr ->
+         (na, arg_of_expr te)
+      | idr = identref; args = LIST1 input_fun; ":="; te = tactic_expr ->
+         (CAst.map (fun id -> Name id) idr, arg_of_expr (TacFun(args,te))) ] ]
   ;
   match_pattern:
     [ [ IDENT "context";  oid = OPT Constr.ident;
           "["; pc = Constr.lconstr_pattern; "]" ->
-        let mode = not (!Flags.tactic_context_compat) in
-        Subterm (mode, oid, pc)
-      | IDENT "appcontext";  oid = OPT Constr.ident;
-          "["; pc = Constr.lconstr_pattern; "]" ->
-        warn_deprecated_appcontext ~loc:!@loc ();
-        Subterm (true,oid, pc)
+        Subterm (oid, pc)
       | pc = Constr.lconstr_pattern -> Term pc ] ]
   ;
   match_hyps:
@@ -335,12 +325,13 @@ GEXTEND Gram
     |   IDENT "all"; ":" -> SelectAll ] ]
   ;
   tactic_mode:
-    [ [ g = OPT toplevel_selector; tac = G_vernac.query_command -> tac g ] ]
+    [ [ g = OPT toplevel_selector; tac = G_vernac.query_command -> tac g
+      | g = OPT toplevel_selector; "{" -> Vernacexpr.VernacSubproof 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)
+          Vernacexpr.VernacProof (Some (in_tac ta), l)
       | IDENT "Proof"; "using"; l = G_vernac.section_subset_expr;
         ta = OPT [ "with"; ta = Pltac.tactic -> in_tac ta ] ->
           Vernacexpr.VernacProof (ta,Some l) ] ]
@@ -388,16 +379,7 @@ 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 "[" ++ Id.print id ++ str "]" ++ str ":"
-| SelectAll -> str "all" ++ str ":"
+let pr_ltac_selector s = Pptactic.pr_goal_selector ~toplevel:true s
 
 VERNAC ARGUMENT EXTEND ltac_selector PRINTED BY pr_ltac_selector
 | [ toplevel_selector(s) ] -> [ s ]
@@ -476,13 +458,13 @@ VERNAC ARGUMENT EXTEND ltac_production_item PRINTED BY pr_ltac_production_item
   [ Tacentries.TacNonTerm (Loc.tag ~loc ((Id.to_string nt, None), None)) ]
 END
 
-VERNAC COMMAND EXTEND VernacTacticNotation
+VERNAC COMMAND FUNCTIONAL EXTEND VernacTacticNotation
 | [ "Tactic" "Notation" ltac_tactic_level_opt(n) ne_ltac_production_item_list(r) ":=" tactic(e) ] =>
-  [ VtUnknown, VtNow ] ->
-  [
-    let l = Locality.LocalityFixme.consume () in
-    let n = Option.default 0 n in
-    Tacentries.add_tactic_notation (Locality.make_module_locality l) n r e
+  [ VtSideff [], VtNow ] ->
+  [ fun ~atts ~st -> let open Vernacinterp in
+      let n = Option.default 0 n in
+      Tacentries.add_tactic_notation (Locality.make_module_locality atts.locality) n r e;
+      st
   ]
 END
 
@@ -491,12 +473,17 @@ VERNAC COMMAND EXTEND VernacPrintLtac CLASSIFIED AS QUERY
   [ Feedback.msg_notice (Tacintern.print_ltac (snd (Libnames.qualid_of_reference r))) ]
 END
 
+VERNAC COMMAND EXTEND VernacLocateLtac CLASSIFIED AS QUERY
+| [ "Locate" "Ltac" reference(r) ] ->
+  [ Tacentries.print_located_tactic r ]
+END
+
 let pr_ltac_ref = Libnames.pr_reference
 
 let pr_tacdef_body tacdef_body =
   let id, redef, body =
     match tacdef_body with
-    | TacticDefinition ((_,id), body) -> Id.print id, false, body
+    | TacticDefinition ({CAst.v=id}, body) -> Id.print id, false, body
     | TacticRedefinition (id, body) -> pr_ltac_ref id, true, body
   in
   let idl, body =
@@ -514,15 +501,15 @@ PRINTED BY pr_tacdef_body
 | [ tacdef_body(t) ] -> [ t ]
 END
 
-VERNAC COMMAND EXTEND VernacDeclareTacticDefinition
+VERNAC COMMAND FUNCTIONAL EXTEND VernacDeclareTacticDefinition
 | [ "Ltac" ne_ltac_tacdef_body_list_sep(l, "with") ] => [
     VtSideff (List.map (function
-      | TacticDefinition ((_,r),_) -> r
+      | TacticDefinition ({CAst.v=r},_) -> r
       | TacticRedefinition (Ident (_,r),_) -> r
       | TacticRedefinition (Qualid (_,q),_) -> snd(repr_qualid q)) l), VtLater
-  ] -> [
-    let lc = Locality.LocalityFixme.consume () in
-    Tacentries.register_ltac (Locality.make_module_locality lc) l
+  ] -> [ fun ~atts ~st -> let open Vernacinterp in
+           Tacentries.register_ltac (Locality.make_module_locality atts.locality) l;
+           st
   ]
 END
 
diff --git a/plugins/ltac/g_obligations.ml4 b/plugins/ltac/g_obligations.ml4
index 1a2d89586..e251b1049 100644
--- a/plugins/ltac/g_obligations.ml4
+++ b/plugins/ltac/g_obligations.ml4
@@ -6,11 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 (*
   Syntax for the subtac terms and types.
-  Elaborated from correctness/psyntax.ml4 by Jean-Christophe Filliâtre *)
+  Elaborated from correctness/psyntax.ml4 by Jean-Christophe Filliâtre *)
 
 open Libnames
 open Constrexpr
@@ -123,11 +121,15 @@ VERNAC COMMAND EXTEND Admit_Obligations CLASSIFIED AS SIDEFF
 | [ "Admit" "Obligations" ] -> [ admit_obligations None ]
 END
 
-VERNAC COMMAND EXTEND Set_Solver CLASSIFIED AS SIDEFF
+VERNAC COMMAND FUNCTIONAL EXTEND Set_Solver CLASSIFIED AS SIDEFF
 | [ "Obligation" "Tactic" ":=" tactic(t) ] -> [
-    set_default_tactic
-      (Locality.make_section_locality (Locality.LocalityFixme.consume ()))
-      (Tacintern.glob_tactic t) ]
+    fun ~atts ~st -> begin
+        let open Vernacinterp in
+        set_default_tactic
+          (Locality.make_section_locality atts.locality)
+          (Tacintern.glob_tactic t);
+        st
+      end]
 END
 
 open Pp
@@ -155,6 +157,4 @@ let () =
   | None -> mt ()
   | Some tac -> str "with" ++ spc () ++ Pptactic.pr_raw_tactic tac
   in
-  (* should not happen *)
-  let dummy _ _ _ expr = assert false in
-  Pptactic.declare_extra_genarg_pprule wit_withtac printer dummy dummy
+  Pptactic.declare_extra_vernac_genarg_pprule wit_withtac printer
diff --git a/plugins/ltac/g_rewrite.ml4 b/plugins/ltac/g_rewrite.ml4
index c874f8d5a..2459a09bc 100644
--- a/plugins/ltac/g_rewrite.ml4
+++ b/plugins/ltac/g_rewrite.ml4
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 (* Syntax for rewriting with strategies *)
 
 open Names
@@ -31,8 +29,12 @@ type constr_expr_with_bindings = constr_expr with_bindings
 type glob_constr_with_bindings = Tacexpr.glob_constr_and_expr with_bindings
 type glob_constr_with_bindings_sign = interp_sign * Tacexpr.glob_constr_and_expr with_bindings
 
-let pr_glob_constr_with_bindings_sign _ _ _ (ge : glob_constr_with_bindings_sign) = Printer.pr_glob_constr (fst (fst (snd ge)))
-let pr_glob_constr_with_bindings _ _ _ (ge : glob_constr_with_bindings) = Printer.pr_glob_constr (fst (fst ge))
+let pr_glob_constr_with_bindings_sign _ _ _ (ge : glob_constr_with_bindings_sign) =
+  let _, env = Pfedit.get_current_context () in
+  Printer.pr_glob_constr_env env (fst (fst (snd ge)))
+let pr_glob_constr_with_bindings _ _ _ (ge : glob_constr_with_bindings) =
+  let _, env = Pfedit.get_current_context () in
+  Printer.pr_glob_constr_env env (fst (fst ge))
 let pr_constr_expr_with_bindings prc _ _ (ge : constr_expr_with_bindings) = prc (fst ge)
 let interp_glob_constr_with_bindings ist gl c = Tacmach.project gl , (ist, c)
 let glob_glob_constr_with_bindings ist l = Tacintern.intern_constr_with_bindings ist l
@@ -123,7 +125,7 @@ END
 
 let clsubstitute o c =
   Proofview.Goal.enter begin fun gl ->
-  let is_tac id = match fst (fst (snd c)) with { CAst.v = GVar id' } when Id.equal id' id -> true | _ -> false in
+  let is_tac id = match DAst.get (fst (fst (snd c))) with GVar id' when Id.equal id' id -> true | _ -> false in
   let hyps = Tacmach.New.pf_ids_of_hyps gl in
     Tacticals.New.tclMAP
       (fun cl ->
@@ -195,8 +197,7 @@ let binders = Pcoq.create_generic_entry Pcoq.utactic "binders" (Genarg.rawwit wi
 
 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
+  Pptactic.declare_extra_vernac_genarg_pprule wit_binders raw_printer
 
 open Pcoq
 
@@ -240,22 +241,37 @@ VERNAC COMMAND EXTEND AddParametricRelation3 CLASSIFIED AS SIDEFF
       [ declare_relation ~binders:b a aeq n None None (Some lemma3) ]
 END
 
-VERNAC COMMAND EXTEND AddSetoid1 CLASSIFIED AS SIDEFF
+VERNAC COMMAND FUNCTIONAL EXTEND AddSetoid1 CLASSIFIED AS SIDEFF
    [ "Add" "Setoid" constr(a) constr(aeq) constr(t) "as" ident(n) ] ->
-     [ add_setoid (not (Locality.make_section_locality (Locality.LocalityFixme.consume ()))) [] a aeq t n ]
+     [ fun ~atts ~st -> let open Vernacinterp in
+         add_setoid (not (Locality.make_section_locality atts.locality)) [] a aeq t n;
+         st
+     ]
   | [ "Add" "Parametric" "Setoid" binders(binders) ":" constr(a) constr(aeq) constr(t) "as" ident(n) ] ->
-     [  add_setoid (not (Locality.make_section_locality (Locality.LocalityFixme.consume ()))) binders a aeq t n ]
+     [ fun ~atts ~st -> let open Vernacinterp in
+         add_setoid (not (Locality.make_section_locality atts.locality)) binders a aeq t n;
+         st
+     ]
   | [ "Add" "Morphism" constr(m) ":" ident(n) ]
     (* This command may or may not open a goal *)
     => [ Vernacexpr.VtUnknown, Vernacexpr.VtNow ]
-    -> [ add_morphism_infer (not (Locality.make_section_locality (Locality.LocalityFixme.consume ()))) m n ]
+    -> [ fun ~atts ~st -> let open Vernacinterp in
+           add_morphism_infer (not (Locality.make_section_locality atts.locality)) m n;
+           st
+       ]
   | [ "Add" "Morphism" constr(m) "with" "signature" lconstr(s) "as" ident(n) ]
     => [ Vernacexpr.(VtStartProof("Classic",GuaranteesOpacity,[n]), VtLater) ]
-    -> [ add_morphism (not (Locality.make_section_locality (Locality.LocalityFixme.consume ()))) [] m s n ]
+    -> [ fun ~atts ~st -> let open Vernacinterp in
+           add_morphism (not (Locality.make_section_locality atts.locality)) [] m s n;
+           st
+       ]
   | [ "Add" "Parametric" "Morphism" binders(binders) ":" constr(m)
         "with" "signature" lconstr(s) "as" ident(n) ]
     => [ Vernacexpr.(VtStartProof("Classic",GuaranteesOpacity,[n]), VtLater) ]
-    -> [ add_morphism (not (Locality.make_section_locality (Locality.LocalityFixme.consume ()))) binders m s n ]
+    -> [ fun ~atts ~st -> let open Vernacinterp in
+           add_morphism (not (Locality.make_section_locality atts.locality)) binders m s n;
+           st
+       ]
 END
 
 TACTIC EXTEND setoid_symmetry
@@ -273,5 +289,7 @@ TACTIC EXTEND setoid_transitivity
 END
 
 VERNAC COMMAND EXTEND PrintRewriteHintDb CLASSIFIED AS QUERY
-  [ "Print" "Rewrite" "HintDb" preident(s) ] -> [ Feedback.msg_notice (Autorewrite.print_rewrite_hintdb s) ]
+  [ "Print" "Rewrite" "HintDb" preident(s) ] ->
+  [ let sigma, env = Pfedit.get_current_context () in
+    Feedback.msg_notice (Autorewrite.print_rewrite_hintdb env sigma s) ]
 END
diff --git a/plugins/ltac/g_tactic.ml4 b/plugins/ltac/g_tactic.ml4
index d792d4ff7..338d61e6f 100644
--- a/plugins/ltac/g_tactic.ml4
+++ b/plugins/ltac/g_tactic.ml4
@@ -115,24 +115,26 @@ let mk_fix_tac (loc,id,bl,ann,ty) =
     match bl,ann with
         [([_],_,_)], None -> 1
       | _, Some x ->
-          let ids = List.map snd (List.flatten (List.map pi1 bl)) in
-          (try List.index Names.Name.equal (snd x) ids
+          let ids = List.map (fun x -> x.CAst.v) (List.flatten (List.map (fun (nal,_,_) -> nal) bl)) in
+          (try List.index Names.Name.equal x.CAst.v ids
           with Not_found -> user_err Pp.(str "No such fix variable."))
       | _ -> user_err Pp.(str "Cannot guess decreasing argument of fix.") in
+  let bl = List.map (fun (nal,bk,t) -> CLocalAssum (nal,bk,t)) bl in
   (id,n, CAst.make ~loc @@ CProdN(bl,ty))
 
 let mk_cofix_tac (loc,id,bl,ann,ty) =
-  let _ = Option.map (fun (aloc,_) ->
-    user_err ~loc:aloc
+  let _ = Option.map (fun { CAst.loc = aloc } ->
+    user_err ?loc:aloc
       ~hdr:"Constr:mk_cofix_tac"
       (Pp.str"Annotation forbidden in cofix expression.")) ann in
+  let bl = List.map (fun (nal,bk,t) -> CLocalAssum (nal,bk,t)) bl in
   (id,CAst.make ~loc @@ CProdN(bl,ty))
 
 (* Functions overloaded by quotifier *)
 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))
+      try ElimOnIdent (CAst.make ?loc:(Constrexpr_ops.constr_loc c) (Constrexpr_ops.coerce_to_id c).CAst.v)
       with e when CErrors.noncritical e -> ElimOnConstr clbind
     end
   | _ -> ElimOnConstr clbind
@@ -150,6 +152,7 @@ let mkTacCase with_evar = function
   (* Reinterpret ident as notations for variables in the context *)
   (* because we don't know if they are quantified or not *)
   | [(clear,ElimOnIdent id),(None,None),None],None ->
+    let id = CAst.(id.loc, id.v) in
       TacCase (with_evar,(clear,(CAst.make @@ CRef (Ident id,None),NoBindings)))
   | ic ->
       if List.exists (function ((_, ElimOnAnonHyp _),_,_) -> true | _ -> false) (fst ic)
@@ -159,15 +162,15 @@ let mkTacCase with_evar = function
 
 let rec mkCLambdaN_simple_loc ?loc bll c =
   match bll with
-  | ((loc1,_)::_ as idl,bk,t) :: bll ->
-      CAst.make ?loc @@ CLambdaN ([idl,bk,t],mkCLambdaN_simple_loc ?loc:(Loc.merge_opt loc1 loc) bll c)
+  | ({CAst.loc = loc1}::_ as idl,bk,t) :: bll ->
+      CAst.make ?loc @@ CLambdaN ([CLocalAssum (idl,bk,t)],mkCLambdaN_simple_loc ?loc:(Loc.merge_opt loc1 loc) bll c)
   | ([],_,_) :: bll -> mkCLambdaN_simple_loc ?loc bll c
   | [] -> c
 
 let mkCLambdaN_simple bl c = match bl with
   | [] -> c
   | h :: _ ->
-    let loc = Loc.merge_opt (fst (List.hd (pi1 h))) (Constrexpr_ops.constr_loc c) in
+    let loc = Loc.merge_opt (List.hd (pi1 h)).CAst.loc (Constrexpr_ops.constr_loc c) in
     mkCLambdaN_simple_loc ?loc bl c
 
 let loc_of_ne_list l = Loc.merge_opt (fst (List.hd l)) (fst (List.last l))
@@ -379,15 +382,20 @@ GEXTEND Gram
   ;
   hypident:
     [ [ id = id_or_meta ->
-          id,InHyp
+        let id : Misctypes.lident = id in
+        id,InHyp
       | "("; IDENT "type"; IDENT "of"; id = id_or_meta; ")" ->
-	  id,InHypTypeOnly
+        let id : Misctypes.lident = id in
+        id,InHypTypeOnly
       | "("; IDENT "value"; IDENT "of"; id = id_or_meta; ")" ->
-	  id,InHypValueOnly
+        let id : Misctypes.lident = id in
+        id,InHypValueOnly
     ] ]
   ;
   hypident_occ:
-    [ [ (id,l)=hypident; occs=occs -> ((occs,id),l) ] ]
+    [ [ (id,l)=hypident; occs=occs ->
+        let id : Misctypes.lident = id in
+        ((occs,id),l) ] ]
   ;
   in_clause:
     [ [ "*"; occs=occs ->
@@ -431,7 +439,8 @@ GEXTEND Gram
       | -> true ]]
   ;
   simple_binder:
-    [ [ na=name -> ([na],Default Explicit, CAst.make ~loc:!@loc @@ CHole (Some (Evar_kinds.BinderType (snd na)), IntroAnonymous, None))
+    [ [ na=name -> ([na],Default Explicit, CAst.make ~loc:!@loc @@
+                    CHole (Some (Evar_kinds.BinderType na.CAst.v), IntroAnonymous, None))
       | "("; nal=LIST1 name; ":"; c=lconstr; ")" -> (nal,Default Explicit,c)
     ] ]
   ;
@@ -563,28 +572,34 @@ GEXTEND Gram
           TacAtom (Loc.tag ~loc:!@loc @@ TacLetTac (true,na,c,p,false,e))
 
       (* Alternative syntax for "pose proof c as id" *)
-      | IDENT "assert"; test_lpar_id_coloneq; "("; (loc,id) = identref; ":=";
+      | IDENT "assert"; test_lpar_id_coloneq; "("; lid = identref; ":=";
 	  c = lconstr; ")" ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (false,true,None,Some (Loc.tag ~loc:!@loc @@ IntroNaming (IntroIdentifier id)),c))
-      | IDENT "eassert"; test_lpar_id_coloneq; "("; (loc,id) = identref; ":=";
+          let { CAst.loc = loc; v = id } = lid in
+          TacAtom (Loc.tag ?loc @@ TacAssert (false,true,None,Some (Loc.tag ?loc @@ IntroNaming (IntroIdentifier id)),c))
+      | IDENT "eassert"; test_lpar_id_coloneq; "("; lid = identref; ":=";
 	  c = lconstr; ")" ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (true,true,None,Some (Loc.tag ~loc:!@loc @@ IntroNaming (IntroIdentifier id)),c))
+          let { CAst.loc = loc; v = id } = lid in
+          TacAtom (Loc.tag ?loc @@ TacAssert (true,true,None,Some (Loc.tag ?loc @@ IntroNaming (IntroIdentifier id)),c))
 
       (* Alternative syntax for "assert c as id by tac" *)
-      | IDENT "assert"; test_lpar_id_colon; "("; (loc,id) = identref; ":";
+      | IDENT "assert"; test_lpar_id_colon; "("; lid = identref; ":";
 	  c = lconstr; ")"; tac=by_tactic ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (false,true,Some tac,Some (Loc.tag ~loc:!@loc @@ IntroNaming (IntroIdentifier id)),c))
-      | IDENT "eassert"; test_lpar_id_colon; "("; (loc,id) = identref; ":";
+          let { CAst.loc = loc; v = id } = lid in
+          TacAtom (Loc.tag ?loc @@ TacAssert (false,true,Some tac,Some (Loc.tag ?loc @@ IntroNaming (IntroIdentifier id)),c))
+      | IDENT "eassert"; test_lpar_id_colon; "("; lid = identref; ":";
 	  c = lconstr; ")"; tac=by_tactic ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (true,true,Some tac,Some (Loc.tag ~loc:!@loc @@ IntroNaming (IntroIdentifier id)),c))
+          let { CAst.loc = loc; v = id } = lid in
+          TacAtom (Loc.tag ?loc @@ TacAssert (true,true,Some tac,Some (Loc.tag ?loc @@ IntroNaming (IntroIdentifier id)),c))
 
       (* Alternative syntax for "enough c as id by tac" *)
-      | IDENT "enough"; test_lpar_id_colon; "("; (loc,id) = identref; ":";
+      | IDENT "enough"; test_lpar_id_colon; "("; lid = identref; ":";
 	  c = lconstr; ")"; tac=by_tactic ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (false,false,Some tac,Some (Loc.tag ~loc:!@loc @@ IntroNaming (IntroIdentifier id)),c))
-      | IDENT "eenough"; test_lpar_id_colon; "("; (loc,id) = identref; ":";
+          let { CAst.loc = loc; v = id } = lid in
+          TacAtom (Loc.tag ?loc @@ TacAssert (false,false,Some tac,Some (Loc.tag ?loc @@ IntroNaming (IntroIdentifier id)),c))
+      | IDENT "eenough"; test_lpar_id_colon; "("; lid = identref; ":";
 	  c = lconstr; ")"; tac=by_tactic ->
-	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (true,false,Some tac,Some (Loc.tag ~loc:!@loc @@ IntroNaming (IntroIdentifier id)),c))
+          let { CAst.loc = loc; v = id } = lid in
+          TacAtom (Loc.tag ?loc @@ TacAssert (true,false,Some tac,Some (Loc.tag ?loc @@ IntroNaming (IntroIdentifier id)),c))
 
       | IDENT "assert"; c = constr; ipat = as_ipat; tac = by_tactic ->
 	  TacAtom (Loc.tag ~loc:!@loc @@ TacAssert (false,true,Some tac,ipat,c))
diff --git a/plugins/ltac/ltac_plugin.mlpack b/plugins/ltac/ltac_plugin.mlpack
index 12b4c81fc..3972b7aac 100644
--- a/plugins/ltac/ltac_plugin.mlpack
+++ b/plugins/ltac/ltac_plugin.mlpack
@@ -1,9 +1,9 @@
 Tacarg
+Tacsubst
+Tacenv
 Pptactic
 Pltac
 Taccoerce
-Tacsubst
-Tacenv
 Tactic_debug
 Tacintern
 Tacentries
diff --git a/plugins/ltac/pltac.mli b/plugins/ltac/pltac.mli
index 048dcc8e9..ecb0b5796 100644
--- a/plugins/ltac/pltac.mli
+++ b/plugins/ltac/pltac.mli
@@ -9,7 +9,6 @@
 (** Ltac parsing entries *)
 
 open Loc
-open Names
 open Pcoq
 open Libnames
 open Constrexpr
@@ -20,7 +19,7 @@ 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 hypident : (lident * 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
@@ -29,8 +28,8 @@ 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 in_clause : lident Locus.clause_expr Gram.entry
+val clause_dft_concl : lident 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
diff --git a/plugins/ltac/pptactic.ml b/plugins/ltac/pptactic.ml
index cb7d9b9c0..3bc9f2aa0 100644
--- a/plugins/ltac/pptactic.ml
+++ b/plugins/ltac/pptactic.ml
@@ -84,6 +84,32 @@ type 'a extra_genarg_printer =
     (tolerability -> Val.t -> Pp.t) ->
     'a -> Pp.t
 
+type 'a raw_extra_genarg_printer_with_level =
+    (constr_expr -> Pp.t) ->
+    (constr_expr -> Pp.t) ->
+    (tolerability -> raw_tactic_expr -> Pp.t) ->
+    tolerability -> 'a -> Pp.t
+
+type 'a glob_extra_genarg_printer_with_level =
+    (glob_constr_and_expr -> Pp.t) ->
+    (glob_constr_and_expr -> Pp.t) ->
+    (tolerability -> glob_tactic_expr -> Pp.t) ->
+    tolerability -> 'a -> Pp.t
+
+type 'a extra_genarg_printer_with_level =
+    (EConstr.constr -> Pp.t) ->
+    (EConstr.constr -> Pp.t) ->
+    (tolerability -> Val.t -> Pp.t) ->
+    tolerability -> 'a -> Pp.t
+
+let string_of_genarg_arg (ArgumentType arg) =
+  let rec aux : type a b c. (a, b, c) genarg_type -> string = function
+  | ListArg t -> aux t ^ "_list"
+  | OptArg t -> aux t ^ "_opt"
+  | PairArg (t1, t2) -> assert false (* No parsing/printing rule for it *)
+  | ExtraArg s -> ArgT.repr s in
+  aux arg
+
   let keyword x = tag_keyword (str x)
   let primitive x = tag_primitive (str x)
 
@@ -116,7 +142,13 @@ type 'a extra_genarg_printer =
         | Val.Base t ->
           begin match Val.eq t tag with
           | None -> default
-          | Some Refl -> Genprint.generic_top_print (in_gen (Topwit wit) x)
+          | Some Refl ->
+             let open Genprint in
+             match generic_top_print (in_gen (Topwit wit) x) with
+             | TopPrinterBasic pr -> pr ()
+             | TopPrinterNeedsContext pr -> pr (Global.env()) Evd.empty
+             | TopPrinterNeedsContextAndLevel { default_ensure_surrounded; printer } ->
+                printer (Global.env()) Evd.empty default_ensure_surrounded
           end
         | _ -> default
 
@@ -129,7 +161,7 @@ type 'a extra_genarg_printer =
         (keyword "eval" ++ brk (1,1) ++
            pr_red_expr (prc,prlc,pr2,pr3) r ++ spc () ++
            keyword "in" ++ spc() ++ prc c)
-    | ConstrContext ((_,id),c) ->
+    | ConstrContext ({CAst.v=id},c) ->
       hov 0
         (keyword "context" ++ spc () ++ pr_id id ++ spc () ++
            str "[ " ++ prlc c ++ str " ]")
@@ -321,9 +353,10 @@ type 'a extra_genarg_printer =
     let rec strip_ty acc n ty =
       match ty.CAst.v with
           Constrexpr.CProdN(bll,a) ->
-            let nb =
-              List.fold_left (fun i (nal,_,_) -> i + List.length nal) 0 bll in
-            let bll = List.map (fun (x, _, y) -> x, y) bll in
+            let bll = List.map (function
+            | CLocalAssum (nal,_,t) -> nal,t
+            | _ -> user_err Pp.(str "Cannot translate fix tactic: not only products")) bll in
+            let nb = List.fold_left (fun i (nal,t) -> i + List.length nal) 0 bll in
             if nb >= n then (List.rev (bll@acc)), a
             else strip_ty (bll@acc) (n-nb) a
         | _ -> user_err Pp.(str "Cannot translate fix tactic: not enough products") in
@@ -331,12 +364,12 @@ type 'a extra_genarg_printer =
 
   let pr_ltac_or_var pr = function
     | ArgArg x -> pr x
-    | ArgVar (loc,id) -> pr_with_comments ?loc (pr_id id)
+    | ArgVar {CAst.loc;v=id} -> pr_with_comments ?loc (pr_id id)
 
   let pr_ltac_constant kn =
     if !Flags.in_debugger then KerName.print kn
     else try
-           pr_qualid (Nametab.shortest_qualid_of_tactic kn)
+           pr_qualid (Tacenv.shortest_qualid_of_tactic kn)
       with Not_found -> (* local tactic not accessible anymore *)
         str "<" ++ KerName.print kn ++ str ">"
 
@@ -371,7 +404,7 @@ type 'a extra_genarg_printer =
 
   let pr_as_name = function
     | Anonymous -> mt ()
-    | Name id -> spc () ++ keyword "as" ++ spc () ++ pr_lident (Loc.tag id)
+    | Name id -> spc () ++ keyword "as" ++ spc () ++ pr_lident (CAst.make id)
 
   let pr_pose_as_style prc na c =
     spc() ++ prc c ++ pr_as_name na
@@ -432,12 +465,13 @@ type 'a extra_genarg_printer =
       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
+  (* Some true = default is concl; Some false = default is all; None = no default *)
+  let pr_clauses has_default pr_id = function
     | { onhyps=Some []; concl_occs=occs }
-        when (match default_is_concl with Some true -> true | _ -> false) ->
+        when (match has_default with Some true -> true | _ -> false) ->
       pr_with_occurrences mt (occs,())
     | { onhyps=None; concl_occs=AllOccurrences }
-        when (match default_is_concl with Some false -> true | _ -> false) -> mt ()
+        when (match has_default with Some false -> true | _ -> false) -> mt ()
     | { onhyps=None; concl_occs=NoOccurrences } ->
       pr_in (str " * |-")
     | { onhyps=None; concl_occs=occs } ->
@@ -462,12 +496,12 @@ type 'a extra_genarg_printer =
 
   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)
+    | ElimOnIdent {CAst.loc;v=id} -> pr_with_comments ?loc (pr_id id)
     | ElimOnAnonHyp n -> int n
 
   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"
@@ -477,12 +511,14 @@ type 'a extra_genarg_printer =
     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 "[" ++ Id.print id ++ str "]" ++ str ":"
-    | SelectAll -> str "all" ++ str ":"
+let pr_goal_selector toplevel = function
+  | SelectNth i -> int i ++ str ":"
+  | SelectList l -> prlist_with_sep (fun () -> str ", ") pr_range_selector l ++ str ":"
+  | SelectId id -> str "[" ++ Id.print id ++ str "]:"
+  | SelectAll -> assert toplevel; str "all:"
+
+let pr_goal_selector ~toplevel s =
+  (if toplevel then mt () else str "only ") ++ pr_goal_selector toplevel s
 
   let pr_lazy = function
     | General -> keyword "multi"
@@ -491,11 +527,9 @@ type 'a extra_genarg_printer =
 
   let pr_match_pattern pr_pat = function
     | Term a -> pr_pat a
-    | Subterm (b,None,a) ->
-    (** ppedrot: we don't make difference between [appcontext] and [context]
-        anymore, and the interpretation is governed by a flag instead. *)
+    | Subterm (None,a) ->
       keyword "context" ++ str" [ " ++ pr_pat a ++ str " ]"
-    | Subterm (b,Some id,a) ->
+    | Subterm (Some id,a) ->
       keyword "context" ++ spc () ++ pr_id id ++ str "[ " ++ pr_pat a ++ str " ]"
 
   let pr_match_hyps pr_pat = function
@@ -527,15 +561,24 @@ type 'a extra_genarg_printer =
 
   let pr_funvar n = spc () ++ Name.print n
 
-  let pr_let_clause k pr (id,(bl,t)) =
-    hov 0 (keyword k ++ spc () ++ pr_lident id ++ prlist pr_funvar bl ++
-             str " :=" ++ brk (1,1) ++ pr (TacArg (Loc.tag t)))
-
-  let pr_let_clauses recflag pr = function
+  let pr_let_clause k pr_gen pr_arg (na,(bl,t)) =
+    let pr = function
+      | TacGeneric arg ->
+         let name = string_of_genarg_arg (genarg_tag arg) in
+         if name = "unit" || name = "int" then
+           (* Hard-wired parsing rules *)
+           pr_gen  arg
+         else
+           str name ++ str ":" ++ surround (pr_gen arg)
+      | _ -> pr_arg (TacArg (Loc.tag t)) in
+    hov 0 (keyword k ++ spc () ++ pr_lname na ++ prlist pr_funvar bl ++
+             str " :=" ++ brk (1,1) ++ pr t)
+
+  let pr_let_clauses recflag pr_gen pr = function
     | hd::tl ->
       hv 0
-        (pr_let_clause (if recflag then "let rec" else "let") pr hd ++
-           prlist (fun t -> spc () ++ pr_let_clause "with" pr t) tl)
+        (pr_let_clause (if recflag then "let rec" else "let") pr_gen pr hd ++
+           prlist (fun t -> spc () ++ pr_let_clause "with" pr_gen pr t) tl)
     | [] -> anomaly (Pp.str "LetIn must declare at least one binding.")
 
   let pr_seq_body pr tl =
@@ -641,7 +684,7 @@ type 'a extra_genarg_printer =
         (*  match t with
             | CHole _ -> spc() ++ prlist_with_sep spc (pr_lname) nal
             | _ ->*)
-        let s = prlist_with_sep spc pr_lname nal ++ str ":" ++ pr.pr_lconstr t in
+        let s = prlist_with_sep spc Ppconstr.pr_lname nal ++ str ":" ++ pr.pr_lconstr t in
         spc() ++ hov 1 (str"(" ++ s ++ str")") in
 
       let pr_fix_tac (id,n,c) =
@@ -649,10 +692,10 @@ type 'a extra_genarg_printer =
         (nal,ty)::bll ->
           if n <= List.length nal then
             match List.chop (n-1) nal with
-                _, (_,Name id) :: _ -> id, (nal,ty)::bll
-              | bef, (loc,Anonymous) :: aft ->
+                _, {CAst.v=Name id} :: _ -> id, (nal,ty)::bll
+              | bef, {CAst.loc;v=Anonymous} :: aft ->
                 let id = next_ident_away (Id.of_string"y") avoid in
-                id, ((bef@(loc,Name id)::aft, ty)::bll)
+                id, ((bef@(CAst.make ?loc @@ Name id)::aft, ty)::bll)
               | _ -> assert false
           else
             let (id,bll') = set_nth_name avoid (n-List.length nal) bll in
@@ -662,14 +705,14 @@ type 'a extra_genarg_printer =
         let names =
           List.fold_left
             (fun ln (nal,_) -> List.fold_left
-              (fun ln na -> match na with (_,Name id) -> id::ln | _ -> ln)
+              (fun ln na -> match na with { CAst.v=Name id } -> Id.Set.add id ln | _ -> ln)
               ln nal)
-            [] bll in
+            Id.Set.empty bll in
         let idarg,bll = set_nth_name names n bll in
-        let annot = match names with
-          | [_] ->
+        let annot =
+          if Int.equal (Id.Set.cardinal names) 1 then
             mt ()
-          | _ ->
+          else
             spc() ++ str"{"
             ++ keyword "struct" ++ spc ()
             ++ pr_id idarg ++ str"}"
@@ -697,8 +740,10 @@ type 'a extra_genarg_printer =
         | TacIntroPattern (ev,[]) as t ->
           pr_atom0 t
         | 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)
+           hov 1 (primitive (if ev then "eintros" else "intros") ++
+                    (match p with
+                    | [_,Misctypes.IntroForthcoming false] -> mt ()
+                    | _ -> spc () ++ prlist_with_sep spc (Miscprint.pr_intro_pattern pr.pr_dconstr) p))
         | TacApply (a,ev,cb,inhyp) ->
           hov 1 (
             (if a then mt() else primitive "simple ") ++
@@ -849,7 +894,7 @@ type 'a extra_genarg_printer =
               let llc = List.map (fun (id,t) -> (id,extract_binders t)) llc in
               v 0
                 (hv 0 (
-                  pr_let_clauses recflag (pr_tac ltop) llc
+                  pr_let_clauses recflag pr.pr_generic (pr_tac ltop) llc
                   ++ spc () ++ keyword "in"
                  ) ++ fnl () ++ pr_tac (llet,E) u),
               llet
@@ -988,13 +1033,13 @@ type 'a extra_genarg_printer =
               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
+            | TacSelect (s, tac) -> pr_goal_selector ~toplevel:false 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) ->
               pr_with_comments ?loc (hov 1 (pr_atom pr strip_prod_binders tag_atom t)), ltatom
             | TacArg(_,Tacexp e) ->
-              pr.pr_tactic (latom,E) e, latom
+              pr_tac inherited e, latom
             | TacArg(_,ConstrMayEval (ConstrTerm c)) ->
               keyword "constr:" ++ pr.pr_constr c, latom
             | TacArg(_,ConstrMayEval c) ->
@@ -1040,9 +1085,9 @@ type 'a extra_genarg_printer =
   let strip_prod_binders_glob_constr n (ty,_) =
     let rec strip_ty acc n ty =
       if Int.equal n 0 then (List.rev acc, (ty,None)) else
-        match ty.CAst.v with
+        match DAst.get ty with
             Glob_term.GProd(na,Explicit,a,b) ->
-              strip_ty (([Loc.tag na],(a,None))::acc) (n-1) b
+              strip_ty (([CAst.make na],(a,None))::acc) (n-1) b
           | _ -> user_err Pp.(str "Cannot translate fix tactic: not enough products") in
     strip_ty [] n ty
 
@@ -1111,10 +1156,10 @@ type 'a extra_genarg_printer =
     let ty = EConstr.Unsafe.to_constr ty in
     let rec strip_ty acc n ty =
       if n=0 then (List.rev acc, EConstr.of_constr ty) else
-        match Term.kind_of_term ty with
-            Term.Prod(na,a,b) ->
-              strip_ty (([Loc.tag na],EConstr.of_constr a)::acc) (n-1) b
-          | _ -> user_err Pp.(str "Cannot translate fix tactic: not enough products") in
+        match Constr.kind ty with
+        | Constr.Prod(na,a,b) ->
+          strip_ty (([CAst.make na],EConstr.of_constr a)::acc) (n-1) b
+        | _ -> user_err Pp.(str "Cannot translate fix tactic: not enough products") in
     strip_ty [] n ty
 
   let pr_atomic_tactic_level env sigma n t =
@@ -1166,95 +1211,183 @@ let declare_extra_genarg_pprule wit
     | ExtraArg s -> ()
     | _          -> user_err Pp.(str "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 f x =
+    Genprint.PrinterBasic (fun () ->
+        f pr_constr_expr pr_lconstr_expr pr_raw_tactic_level x) in
   let g x =
+    Genprint.PrinterBasic (fun () ->
     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
+    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 =
+    Genprint.TopPrinterNeedsContext (fun env sigma ->
+        h (pr_econstr_env env sigma) (pr_leconstr_env env sigma) (fun _ _ -> str "<tactic>") x)
+  in
+  Genprint.register_print0 wit f g h
+
+let declare_extra_genarg_pprule_with_level wit
+  (f : 'a raw_extra_genarg_printer_with_level)
+  (g : 'b glob_extra_genarg_printer_with_level)
+  (h : 'c extra_genarg_printer_with_level) default_surrounded default_non_surrounded =
+  begin match wit with
+    | ExtraArg s -> ()
+    | _          -> user_err Pp.(str "Can declare a pretty-printing rule only for extra argument types.")
+  end;
+  let open Genprint in
+  let f x =
+    PrinterNeedsLevel {
+        default_already_surrounded = default_surrounded;
+        default_ensure_surrounded = default_non_surrounded;
+        printer = (fun n ->
+          f pr_constr_expr pr_lconstr_expr pr_raw_tactic_level n x) } in
+  let g x =
     let env = Global.env () in
-    h (pr_econstr_env env Evd.empty) (pr_leconstr_env env Evd.empty) (fun _ _ -> str "<tactic>") x
+    PrinterNeedsLevel {
+        default_already_surrounded = default_surrounded;
+        default_ensure_surrounded = default_non_surrounded;
+        printer = (fun n ->
+          g (pr_and_constr_expr (pr_glob_constr_env env)) (pr_and_constr_expr (pr_lglob_constr_env env)) (pr_glob_tactic_level env) n x) }
+  in
+  let h x =
+    TopPrinterNeedsContextAndLevel {
+        default_already_surrounded = default_surrounded;
+        default_ensure_surrounded = default_non_surrounded;
+        printer = (fun env sigma n ->
+          h (pr_econstr_env env sigma) (pr_leconstr_env env sigma) (fun _ _ -> str "<tactic>") n x) }
   in
   Genprint.register_print0 wit f g h
 
+let declare_extra_vernac_genarg_pprule wit f =
+  let f x = Genprint.PrinterBasic (fun () -> f pr_constr_expr pr_lconstr_expr pr_raw_tactic_level x) in
+  Genprint.register_vernac_print0 wit f
+
 (** Registering *)
 
-let run_delayed c = c (Global.env ()) Evd.empty
+let pr_intro_pattern_env p = Genprint.TopPrinterNeedsContext (fun env sigma ->
+  let print_constr c = let (sigma, c) = c env sigma in pr_econstr_env env sigma c in
+  Miscprint.pr_intro_pattern print_constr p)
+
+let pr_red_expr_env r = Genprint.TopPrinterNeedsContext (fun env sigma ->
+  pr_red_expr (pr_econstr_env env sigma, pr_leconstr_env env sigma,
+               pr_evaluable_reference_env env, pr_constr_pattern_env env sigma) r)
+
+let pr_bindings_env bl = Genprint.TopPrinterNeedsContext (fun env sigma ->
+  let sigma, bl = bl env sigma in
+  Miscprint.pr_bindings
+    (pr_econstr_env env sigma) (pr_leconstr_env env sigma) bl)
+
+let pr_with_bindings_env bl = Genprint.TopPrinterNeedsContext (fun env sigma ->
+  let sigma, bl = bl env sigma in
+  pr_with_bindings
+    (pr_econstr_env env sigma) (pr_leconstr_env env sigma) bl)
+
+let pr_destruction_arg_env c = Genprint.TopPrinterNeedsContext (fun env sigma ->
+  let sigma, c = match c with
+  | clear_flag,ElimOnConstr g -> let sigma,c = g env sigma in sigma,(clear_flag,ElimOnConstr c)
+  | clear_flag,ElimOnAnonHyp n as x -> sigma, x
+  | clear_flag,ElimOnIdent id as x -> sigma, x in
+  pr_destruction_arg
+    (pr_econstr_env env sigma) (pr_leconstr_env env sigma) c)
+
+let make_constr_printer f c =
+  Genprint.TopPrinterNeedsContextAndLevel {
+      Genprint.default_already_surrounded = Ppconstr.ltop;
+      Genprint.default_ensure_surrounded = Ppconstr.lsimpleconstr;
+      Genprint.printer = (fun env sigma n -> f env sigma n c)}
 
-let run_delayed_destruction_arg = function (* HH: Using Evd.empty looks suspicious *)
-  | clear_flag,ElimOnConstr g -> clear_flag,ElimOnConstr (snd (run_delayed g))
-  | clear_flag,ElimOnAnonHyp n as x -> x
-  | clear_flag,ElimOnIdent id as x -> x
+let lift f a = Genprint.PrinterBasic (fun () -> f a)
+let lift_top f a = Genprint.TopPrinterBasic (fun () -> f a)
+
+let register_basic_print0 wit f g h =
+  Genprint.register_print0 wit (lift f) (lift g) (lift_top h)
+
+
+let pr_glob_constr_pptac c =
+  let _, env = Pfedit.get_current_context () in
+  pr_glob_constr_env env c
+
+let pr_lglob_constr_pptac c =
+  let _, env = Pfedit.get_current_context () in
+  pr_lglob_constr_env env c
 
 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 wit_int_or_var
-    (pr_or_var int) (pr_or_var int) int;
-  Genprint.register_print0 wit_ref
+  let open Genprint in
+  register_basic_print0 wit_int_or_var (pr_or_var int) (pr_or_var int) int;
+  register_basic_print0 wit_ref
     pr_reference (pr_or_var (pr_located pr_global)) pr_global;
-  Genprint.register_print0 wit_ident
-    pr_id pr_id pr_id;
-  Genprint.register_print0 wit_var
-    (pr_located pr_id) (pr_located pr_id) pr_id;
-  Genprint.register_print0
+  register_basic_print0 wit_ident pr_id pr_id pr_id;
+  register_basic_print0 wit_var pr_lident pr_lident pr_id;
+  register_print0
     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_econstr (snd (run_delayed c))));
+    (lift (Miscprint.pr_intro_pattern pr_constr_expr))
+    (lift (Miscprint.pr_intro_pattern (fun (c,_) -> pr_glob_constr_pptac c)))
+    pr_intro_pattern_env;
   Genprint.register_print0
     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.tag id)))
+    (lift (pr_clauses (Some true) pr_lident))
+    (lift (pr_clauses (Some true) pr_lident))
+    (fun c -> Genprint.TopPrinterBasic (fun () -> pr_clauses (Some true) (fun id -> pr_lident (CAst.make id)) c))
   ;
   Genprint.register_print0
     wit_constr
-    Ppconstr.pr_constr_expr
-    (fun (c, _) -> Printer.pr_glob_constr c)
-    Printer.pr_econstr
+    (lift Ppconstr.pr_lconstr_expr)
+    (lift (fun (c, _) -> pr_lglob_constr_pptac c))
+    (make_constr_printer Printer.pr_econstr_n_env)
   ;
   Genprint.register_print0
     wit_uconstr
-    Ppconstr.pr_constr_expr
-    (fun (c,_) -> Printer.pr_glob_constr c)
-    Printer.pr_closed_glob
+    (lift Ppconstr.pr_constr_expr)
+    (lift (fun (c,_) -> pr_glob_constr_pptac c))
+    (make_constr_printer Printer.pr_closed_glob_n_env)
   ;
   Genprint.register_print0
     wit_open_constr
-    Ppconstr.pr_constr_expr
-    (fun (c, _) -> Printer.pr_glob_constr c)
-    Printer.pr_econstr
+    (lift Ppconstr.pr_constr_expr)
+    (lift (fun (c, _) -> pr_glob_constr_pptac c))
+    (make_constr_printer Printer.pr_econstr_n_env)
+  ;
+  Genprint.register_print0
+    wit_red_expr
+    (lift (pr_red_expr (pr_constr_expr, pr_lconstr_expr, pr_or_by_notation pr_reference, pr_constr_pattern_expr)))
+    (lift (pr_red_expr (pr_and_constr_expr pr_glob_constr_pptac, pr_and_constr_expr pr_lglob_constr_pptac, pr_or_var (pr_and_short_name pr_evaluable_reference), pr_pat_and_constr_expr pr_glob_constr_pptac)))
+    pr_red_expr_env
+  ;
+  register_basic_print0 wit_quant_hyp pr_quantified_hypothesis pr_quantified_hypothesis pr_quantified_hypothesis;
+  register_print0 wit_bindings
+    (lift (Miscprint.pr_bindings_no_with pr_constr_expr pr_lconstr_expr))
+    (lift (Miscprint.pr_bindings_no_with (pr_and_constr_expr pr_glob_constr_pptac) (pr_and_constr_expr pr_lglob_constr_pptac)))
+    pr_bindings_env
+  ;
+  register_print0 wit_constr_with_bindings
+    (lift (pr_with_bindings pr_constr_expr pr_lconstr_expr))
+    (lift (pr_with_bindings (pr_and_constr_expr pr_glob_constr_pptac) (pr_and_constr_expr pr_lglob_constr_pptac)))
+    pr_with_bindings_env
+  ;
+  register_print0 wit_open_constr_with_bindings
+    (lift (pr_with_bindings pr_constr_expr pr_lconstr_expr))
+    (lift (pr_with_bindings (pr_and_constr_expr pr_glob_constr_pptac) (pr_and_constr_expr pr_lglob_constr_pptac)))
+    pr_with_bindings_env
+  ;
+  register_print0 Tacarg.wit_destruction_arg
+    (lift (pr_destruction_arg pr_constr_expr pr_lconstr_expr))
+    (lift (pr_destruction_arg (pr_and_constr_expr pr_glob_constr_pptac) (pr_and_constr_expr pr_lglob_constr_pptac)))
+    pr_destruction_arg_env
   ;
-  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_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_econstr, pr_leconstr, pr_evaluable_reference, pr_constr_pattern));
-  Genprint.register_print0 wit_quant_hyp pr_quantified_hypothesis pr_quantified_hypothesis pr_quantified_hypothesis;
-  Genprint.register_print0 wit_bindings
-    (Miscprint.pr_bindings_no_with pr_constr_expr pr_lconstr_expr)
-    (Miscprint.pr_bindings_no_with (pr_and_constr_expr pr_glob_constr) (pr_and_constr_expr pr_lglob_constr))
-    (fun it -> Miscprint.pr_bindings_no_with pr_econstr pr_leconstr (snd (run_delayed it)));
-  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_econstr pr_leconstr (snd (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_econstr pr_leconstr (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;
-  Genprint.register_print0 Stdarg.wit_pre_ident str str str;
-  Genprint.register_print0 Stdarg.wit_string pr_string pr_string pr_string
+  register_basic_print0 Stdarg.wit_int int int int;
+  register_basic_print0 Stdarg.wit_bool pr_bool pr_bool pr_bool;
+  register_basic_print0 Stdarg.wit_unit pr_unit pr_unit pr_unit;
+  register_basic_print0 Stdarg.wit_pre_ident str str str;
+  register_basic_print0 Stdarg.wit_string qstring qstring qstring
 
 let () =
-  let printer _ _ prtac = prtac (0, E) in
-  declare_extra_genarg_pprule wit_tactic printer printer printer
+  let printer _ _ prtac = prtac in
+  declare_extra_genarg_pprule_with_level wit_tactic printer printer printer
+  ltop (0,E)
 
 let () =
-  let pr_unit _ _ _ () = str "()" in
-  let printer _ _ prtac = prtac (0, E) in
-  declare_extra_genarg_pprule wit_ltac printer printer pr_unit
+  let pr_unit _ _ _ _ () = str "()" in
+  let printer _ _ prtac = prtac in
+  declare_extra_genarg_pprule_with_level wit_ltac printer printer pr_unit
+  ltop (0,E)
diff --git a/plugins/ltac/pptactic.mli b/plugins/ltac/pptactic.mli
index 1f6ebaf44..bda5774ab 100644
--- a/plugins/ltac/pptactic.mli
+++ b/plugins/ltac/pptactic.mli
@@ -40,12 +40,41 @@ type 'a extra_genarg_printer =
     (tolerability -> Val.t -> Pp.t) ->
     'a -> Pp.t
 
+type 'a raw_extra_genarg_printer_with_level =
+    (constr_expr -> Pp.t) ->
+    (constr_expr -> Pp.t) ->
+    (tolerability -> raw_tactic_expr -> Pp.t) ->
+    tolerability -> 'a -> Pp.t
+
+type 'a glob_extra_genarg_printer_with_level =
+    (glob_constr_and_expr -> Pp.t) ->
+    (glob_constr_and_expr -> Pp.t) ->
+    (tolerability -> glob_tactic_expr -> Pp.t) ->
+    tolerability -> 'a -> Pp.t
+
+type 'a extra_genarg_printer_with_level =
+    (EConstr.constr -> Pp.t) ->
+    (EConstr.constr -> Pp.t) ->
+    (tolerability -> Val.t -> Pp.t) ->
+    tolerability -> 'a -> Pp.t
+
 val declare_extra_genarg_pprule :
   ('a, 'b, 'c) genarg_type ->
   'a raw_extra_genarg_printer ->
   'b glob_extra_genarg_printer ->
   'c extra_genarg_printer -> unit
 
+val declare_extra_genarg_pprule_with_level :
+  ('a, 'b, 'c) genarg_type ->
+  'a raw_extra_genarg_printer_with_level ->
+  'b glob_extra_genarg_printer_with_level ->
+  'c extra_genarg_printer_with_level ->
+  (* surroounded *) tolerability -> (* non-surroounded *) tolerability -> unit
+
+val declare_extra_vernac_genarg_pprule :
+  ('a, 'b, 'c) genarg_type ->
+  'a raw_extra_genarg_printer -> unit
+
 type grammar_terminals = Genarg.ArgT.any Extend.user_symbol grammar_tactic_prod_item_expr list
 
 type pp_tactic = {
@@ -53,6 +82,8 @@ type pp_tactic = {
   pptac_prods : grammar_terminals;
 }
 
+val pr_goal_selector : toplevel:bool -> goal_selector -> Pp.t
+
 val declare_notation_tactic_pprule : KerName.t -> pp_tactic -> unit
 
 val pr_with_occurrences :
@@ -67,11 +98,16 @@ val pr_may_eval :
 val pr_and_short_name : ('a -> Pp.t) -> 'a and_short_name -> Pp.t
 val pr_or_by_notation : ('a -> Pp.t) -> 'a or_by_notation -> Pp.t
 
+val pr_evaluable_reference_env : env -> evaluable_global_reference -> Pp.t
+
+val pr_quantified_hypothesis : quantified_hypothesis -> Pp.t
+
 val pr_in_clause :
   ('a -> Pp.t) -> 'a Locus.clause_expr -> Pp.t
 
-val pr_clauses :  bool option ->
+val pr_clauses : (* default: *) bool option ->
   ('a -> Pp.t) -> 'a Locus.clause_expr -> Pp.t
+  (* Some true = default is concl; Some false = default is all; None = no default *)
 
 val pr_raw_generic : env -> rlevel generic_argument -> Pp.t
 
@@ -91,7 +127,7 @@ val pr_alias_key : Names.KerName.t -> Pp.t
 val pr_alias : (Val.t -> Pp.t) ->
   int -> Names.KerName.t -> Val.t list -> Pp.t
 
-val pr_ltac_constant : Nametab.ltac_constant -> Pp.t
+val pr_ltac_constant : ltac_constant -> Pp.t
 
 val pr_raw_tactic : raw_tactic_expr -> Pp.t
 
@@ -114,3 +150,6 @@ val pr_value : tolerability -> Val.t -> Pp.t
 
 
 val ltop : tolerability
+
+val make_constr_printer : (env -> Evd.evar_map -> Notation_term.tolerability -> 'a -> Pp.t) ->
+  'a Genprint.top_printer
diff --git a/plugins/ltac/profile_ltac.ml b/plugins/ltac/profile_ltac.ml
index 32494a879..161546528 100644
--- a/plugins/ltac/profile_ltac.ml
+++ b/plugins/ltac/profile_ltac.ml
@@ -289,7 +289,7 @@ let rec find_in_stack what acc = function
   | { 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 exit_tactic ~count_call start_time c =
   let diff = time () -. start_time in
   match Local.(!stack) with
   | [] | [_] ->
@@ -304,7 +304,7 @@ let exit_tactic start_time c =
     let node = { node with
       total = node.total +. diff;
       local = node.local +. diff;
-      ncalls = node.ncalls + 1;
+      ncalls = node.ncalls + (if count_call then 1 else 0);
       max_total = max node.max_total diff;
     } in
     (* updating the stack *)
@@ -341,7 +341,7 @@ let tclFINALLY tac (finally : unit Proofview.tactic) =
     (fun v -> finally <*> Proofview.tclUNIT v)
     (fun (exn, info) -> finally <*> Proofview.tclZERO ~info exn)
 
-let do_profile s call_trace tac =
+let do_profile s call_trace ?(count_call=true) tac =
   let open Proofview.Notations in
   Proofview.tclLIFT (Proofview.NonLogical.make (fun () ->
   if !is_profiling then
@@ -359,7 +359,7 @@ let do_profile s call_trace tac =
       tac
       (Proofview.tclLIFT (Proofview.NonLogical.make (fun () ->
         (match call_trace with
-        | (_, c) :: _ -> exit_tactic start_time c
+        | (_, c) :: _ -> exit_tactic ~count_call start_time c
         | [] -> ()))))
   | None -> tac
 
@@ -367,33 +367,69 @@ let do_profile s call_trace tac =
 
 let get_local_profiling_results () = List.hd Local.(!stack)
 
-module SM = Map.Make(Stateid.Self)
+(* We maintain our own cache of document data, given that the
+   semantics of the STM implies that synchronized state for opaque
+   proofs will be lost on QED. This provides some complications later
+   on as we will have to simulate going back on the document on our
+   own. *)
+module DData = struct
+    type t = Feedback.doc_id * Stateid.t
+    let compare x y = Pervasives.compare x y
+end
+
+module SM = Map.Make(DData)
 
 let data = ref SM.empty
 
 let _ =
   Feedback.(add_feeder (function
-    | { id = s; contents = Custom (_, "ltacprof_results", xml) } ->
+    | { doc_id = d;
+        span_id = 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
+          try SM.find (d,s) !data
           with Not_found -> empty_treenode root in
-        data := SM.add s (merge_roots results other_results) !data
+        data := SM.add (d,s) (merge_roots results other_results) !data
     | _ -> ()))
 
 let reset_profile () =
   reset_profile_tmp ();
   data := SM.empty
 
+(* ****************************** Named timers ****************************** *)
+
+let timer_data = ref M.empty
+
+let timer_name = function
+  | Some v -> v
+  | None -> ""
+
+let restart_timer name =
+  timer_data := M.add (timer_name name) (System.get_time ()) !timer_data
+
+let get_timer name =
+  try M.find (timer_name name) !timer_data
+  with Not_found -> System.get_time ()
+
+let finish_timing ~prefix name =
+  let tend = System.get_time () in
+  let tstart = get_timer name in
+  Feedback.msg_info(str prefix ++ pr_opt str name ++ str " ran for " ++
+                    System.fmt_time_difference tstart tend)
+
 (* ******************** *)
 
 let print_results_filter ~cutoff ~filter =
-  let valid id _ = Stm.state_of_id id <> `Expired in
+  (* The STM doesn't provide yet a proper document query and traversal
+     API, thus we need to re-check if some states are current anymore
+     (due to backtracking) using the `state_of_id` API. *)
+  let valid (did,id) _ = Stm.(state_of_id ~doc:(get_doc did) 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)
+  Feedback.msg_info (to_string ~cutoff ~filter results)
 ;;
 
 let print_results ~cutoff =
diff --git a/plugins/ltac/profile_ltac.mli b/plugins/ltac/profile_ltac.mli
index 52827cb36..adedf7ee9 100644
--- a/plugins/ltac/profile_ltac.mli
+++ b/plugins/ltac/profile_ltac.mli
@@ -9,9 +9,39 @@
 
 (** Ltac profiling primitives *)
 
+(* Note(JasonGross): Ltac semantics are a bit insane.  There isn't
+   really a good notion of how many times a tactic has been "called",
+   because tactics can be partially evaluated, and it's unclear
+   whether the number of "calls" should be the number of times the
+   body is fetched and unfolded, or the number of times the code is
+   executed to a value, etc.  The logic in [Tacinterp.eval_tactic]
+   gives a decent approximation, which I believe roughly corresponds
+   to the number of times that the engine runs the tactic value which
+   results from evaluating the tactic expression bound to the name
+   we're considering.  However, this is a poor approximation of the
+   time spent in the tactic; we want to consider time spent evaluating
+   a tactic expression to a tactic value to be time spent in the
+   expression, not just time spent in the caller of the expression.
+   So we need to wrap some nodes in additional profiling calls which
+   don't count towards to total call count.  Whether or not a call
+   "counts" is indicated by the [count_call] boolean argument.
+
+   Unfortunately, at present, we can get very strange call graphs when
+   a named tactic expression never runs as a tactic value: if we have
+   [Ltac t0 := t.] and [Ltac t1 := t0.], then [t1] is considered to
+   run 0(!) times.  It evaluates to [t] during tactic expression
+   evaluation, and although the call trace records the fact that it
+   was called by [t0] which was called by [t1], the tactic running
+   phase never sees this.  Thus we get one call tree (from expression
+   evaluation) that has [t1] calls [t0] calls [t], and another call
+   tree which says that the caller of [t1] calls [t] directly; the
+   expression evaluation time goes in the first tree, and the call
+   count and tactic running time goes in the second tree.  Alas, I
+   suspect that fixing this requires a redesign of how the profiler
+   hooks into the tactic engine. *)
 val do_profile :
   string -> ('a * Tacexpr.ltac_call_kind) list ->
-    'b Proofview.tactic -> 'b Proofview.tactic
+    ?count_call:bool -> 'b Proofview.tactic -> 'b Proofview.tactic
 
 val set_profiling : bool -> unit
 
@@ -22,6 +52,10 @@ val print_results_tactic : string -> unit
 
 val reset_profile : unit -> unit
 
+val restart_timer : string option -> unit
+
+val finish_timing : prefix:string -> string option -> unit
+
 val do_print_results_at_close : unit -> unit
 
 (* The collected statistics for a tactic. The timing data is collected over all
@@ -46,4 +80,3 @@ type treenode = {
 (* Returns the profiling results known by the current process *)
 val get_local_profiling_results : unit -> treenode
 val feedback_results : treenode -> unit
-
diff --git a/plugins/ltac/profile_ltac_tactics.ml4 b/plugins/ltac/profile_ltac_tactics.ml4
index 2b1106ee2..7a75662be 100644
--- a/plugins/ltac/profile_ltac_tactics.ml4
+++ b/plugins/ltac/profile_ltac_tactics.ml4
@@ -6,28 +6,60 @@
 (*         *       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"
+DECLARE PLUGIN "ltac_plugin"
 
 let tclSET_PROFILING b =
    Proofview.tclLIFT (Proofview.NonLogical.make (fun () -> set_profiling b))
 
+let tclRESET_PROFILE =
+   Proofview.tclLIFT (Proofview.NonLogical.make reset_profile)
+
+let tclSHOW_PROFILE ~cutoff =
+   Proofview.tclLIFT (Proofview.NonLogical.make (fun () -> print_results ~cutoff))
+
+let tclSHOW_PROFILE_TACTIC s =
+   Proofview.tclLIFT (Proofview.NonLogical.make (fun () -> print_results_tactic s))
+
+let tclRESTART_TIMER s =
+   Proofview.tclLIFT (Proofview.NonLogical.make (fun () -> restart_timer s))
+
+let tclFINISH_TIMING ?(prefix="Timer") (s : string option) =
+   Proofview.tclLIFT (Proofview.NonLogical.make (fun () -> finish_timing ~prefix s))
+
 TACTIC EXTEND start_ltac_profiling
 | [ "start" "ltac" "profiling" ] -> [ tclSET_PROFILING true ]
 END
 
-TACTIC EXTEND stop_profiling
+TACTIC EXTEND stop_ltac_profiling
 | [ "stop" "ltac" "profiling" ] -> [ tclSET_PROFILING false ]
 END
 
+TACTIC EXTEND reset_ltac_profile
+| [ "reset" "ltac" "profile" ] -> [ tclRESET_PROFILE ]
+END
+
+TACTIC EXTEND show_ltac_profile
+| [ "show" "ltac" "profile" ] -> [ tclSHOW_PROFILE ~cutoff:!Flags.profile_ltac_cutoff ]
+| [ "show" "ltac" "profile" "cutoff" int(n) ] -> [ tclSHOW_PROFILE ~cutoff:(float_of_int n) ]
+| [ "show" "ltac" "profile" string(s) ] -> [ tclSHOW_PROFILE_TACTIC s ]
+END
+
+TACTIC EXTEND restart_timer
+| [ "restart_timer" string_opt(s) ] -> [ tclRESTART_TIMER s ]
+END
+
+TACTIC EXTEND finish_timing
+| [ "finish_timing" string_opt(s) ] -> [ tclFINISH_TIMING ~prefix:"Timer" s ]
+| [ "finish_timing" "(" string(prefix) ")" string_opt(s) ] -> [ tclFINISH_TIMING ~prefix s ]
+END
+
 VERNAC COMMAND EXTEND ResetLtacProfiling CLASSIFIED AS SIDEFF
-  [ "Reset" "Ltac" "Profile" ] -> [ reset_profile() ]
+  [ "Reset" "Ltac" "Profile" ] -> [ reset_profile () ]
 END
 
 VERNAC COMMAND EXTEND ShowLtacProfile CLASSIFIED AS QUERY
diff --git a/plugins/ltac/rewrite.ml b/plugins/ltac/rewrite.ml
index 75b665aad..e73a18b79 100644
--- a/plugins/ltac/rewrite.ml
+++ b/plugins/ltac/rewrite.ml
@@ -6,13 +6,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Names
 open Pp
 open CErrors
 open Util
+open Names
 open Nameops
 open Namegen
-open Term
+open Constr
 open EConstr
 open Vars
 open Reduction
@@ -210,9 +210,9 @@ end) = struct
       let t = Reductionops.whd_all env (goalevars evars) ty in
 	match EConstr.kind (goalevars evars) t, l with
 	| Prod (na, ty, b), obj :: cstrs ->
-          let b = Reductionops.nf_betaiota (goalevars evars) b in
+          let b = Reductionops.nf_betaiota env (goalevars evars) b in
 	  if noccurn (goalevars evars) 1 b (* non-dependent product *) then
-	    let ty = Reductionops.nf_betaiota (goalevars evars) ty in
+            let ty = Reductionops.nf_betaiota env (goalevars evars) ty in
 	    let (evars, b', arg, cstrs) = aux env evars (subst1 mkProp b) cstrs in
 	    let evars, relty = mk_relty evars env ty obj in
 	    let evars, newarg = app_poly env evars respectful [| ty ; b' ; relty ; arg |] in
@@ -221,7 +221,7 @@ end) = struct
 	    let (evars, b, arg, cstrs) =
 	      aux (push_rel (LocalAssum (na, ty)) env) evars b cstrs
 	    in
-	    let ty = Reductionops.nf_betaiota (goalevars evars) ty in
+            let ty = Reductionops.nf_betaiota env (goalevars evars) ty in
 	    let pred = mkLambda (na, ty, b) in
 	    let liftarg = mkLambda (na, ty, arg) in
 	    let evars, arg' = app_poly env evars forall_relation [| ty ; pred ; liftarg |] in
@@ -231,7 +231,7 @@ end) = struct
 	| _, [] ->
 	  (match finalcstr with
 	  | None | Some (_, None) ->
-	    let t = Reductionops.nf_betaiota (fst evars) ty in
+            let t = Reductionops.nf_betaiota env (fst evars) ty in
 	    let evars, rel = mk_relty evars env t None in
 	      evars, t, rel, [t, Some rel]
 	  | Some (t, Some rel) -> evars, t, rel, [t, Some rel])
@@ -361,8 +361,8 @@ end) = struct
 end
 
 (* let my_type_of env evars c = Typing.e_type_of env evars c *)
-(* let mytypeofkey = Profile.declare_profile "my_type_of";; *)
-(* let my_type_of = Profile.profile3 mytypeofkey my_type_of *)
+(* let mytypeofkey = CProfile.declare_profile "my_type_of";; *)
+(* let my_type_of = CProfile.profile3 mytypeofkey my_type_of *)
 
 
 let type_app_poly env env evd f args =
@@ -426,7 +426,7 @@ let split_head = function
   | [] -> assert(false)
 
 let eq_pb (ty, env, x, y as pb) (ty', env', x', y' as pb') =
-  pb == pb' || (ty == ty' && Term.eq_constr x x' && Term.eq_constr y y')
+  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
@@ -664,7 +664,7 @@ type rewrite_result =
 
 type 'a strategy_input = { state : 'a ; (* a parameter: for instance, a state *)
 			   env : Environ.env ;
-			   unfresh : Id.t list ; (* Unfresh names *)
+			   unfresh : Id.Set.t; (* Unfresh names *)
 			   term1 : constr ;
 			   ty1 : types ; (* first term and its type (convertible to rew_from) *)
 			   cstr : (bool (* prop *) * constr option) ;
@@ -928,8 +928,8 @@ let fold_match ?(force=false) env sigma c =
 	it_mkProd_or_LetIn (subst1 mkProp body) (List.tl ctx)
     in
     let sk = 
-      if sortp == InProp then
-	if sortc == InProp then
+      if sortp == Sorts.InProp then
+	if sortc == Sorts.InProp then
 	  if dep then case_dep_scheme_kind_from_prop
 	  else case_scheme_kind_from_prop
 	else (
@@ -1143,7 +1143,7 @@ let subterm all flags (s : 'a pure_strategy) : 'a pure_strategy =
       (* 	    | _ -> b') *)
 
       | Lambda (n, t, b) when flags.under_lambdas ->
-        let n' = name_app (fun id -> Tactics.fresh_id_in_env unfresh id env) n in
+        let n' = Nameops.Name.map (fun id -> Tactics.fresh_id_in_env unfresh id env) n in
         let open Context.Rel.Declaration in
 	let env' = EConstr.push_rel (LocalAssum (n', t)) env in
 	let bty = Retyping.get_type_of env' (goalevars evars) b in
@@ -1557,9 +1557,8 @@ 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 beta = Tactics.reduct_in_concl (Reductionops.nf_betaiota, DEFAULTcast) in
+  let beta_hyp id = Tactics.reduct_in_hyp Reductionops.nf_betaiota (id, InHyp) in
   let treat sigma res = 
     match res with
     | None -> newfail 0 (str "Nothing to rewrite")
@@ -1614,7 +1613,7 @@ let cl_rewrite_clause_newtac ?abs ?origsigma ~progress strat clause =
     in
     try
       let res =
-        cl_rewrite_clause_aux ?abs strat env [] sigma ty clause
+        cl_rewrite_clause_aux ?abs strat env Id.Set.empty sigma ty clause
       in
       let sigma = match origsigma with None -> sigma | Some sigma -> sigma in
       treat sigma res <*>
@@ -1774,14 +1773,16 @@ let rec strategy_of_ast = function
 let mkappc s l = CAst.make @@ CAppExpl ((None,(Libnames.Ident (Loc.tag @@ Id.of_string s)),None),l)
 
 let declare_an_instance n s args =
-  (((Loc.tag @@ Name n),None), Explicit,
+  (((CAst.make @@ Name n),None), Explicit,
   CAst.make @@ CAppExpl ((None, Qualid (Loc.tag @@  qualid_of_string s),None),
 	   args))
 
 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 ()) 
+  let program_mode = Flags.is_program_mode () in
+  let poly = Flags.is_universe_polymorphism () in
+  new_instance ~program_mode poly
     binders instance (Some (true, CAst.make @@ CRecord (fields)))
     ~global ~generalize:false ~refine:false Hints.empty_hint_info
 
@@ -1800,9 +1801,9 @@ let declare_instance_trans global binders a aeq n lemma =
   in anew_instance global binders instance
        [(Ident (Loc.tag @@ Id.of_string "transitivity"),lemma)]
 
-let declare_relation ?(binders=[]) a aeq n refl symm trans =
+let declare_relation ?locality ?(binders=[]) a aeq n refl symm trans =
   init_setoid ();
-  let global = not (Locality.make_section_locality (Locality.LocalityFixme.consume ())) in
+  let global = not (Locality.make_section_locality locality) in
   let instance = declare_instance a aeq (add_suffix n "_relation") "Coq.Classes.RelationClasses.RewriteRelation"
   in ignore(anew_instance global binders instance []);
   match (refl,symm,trans) with
@@ -1884,11 +1885,11 @@ let declare_projection n instance_id r =
     in it_mkProd_or_LetIn ccl ctx
   in
   let typ = it_mkProd_or_LetIn typ ctx in
-  let pl, ctx = Evd.universe_context sigma in
+  let univs = Evd.const_univ_entry ~poly sigma in
   let typ = EConstr.to_constr sigma typ in
   let term = EConstr.to_constr sigma term in
   let cst = 
-    Declare.definition_entry ~types:typ ~poly ~univs:ctx term
+    Declare.definition_entry ~types:typ ~univs term
   in
     ignore(Declare.declare_constant n 
 	   (Entries.DefinitionEntry cst, Decl_kinds.IsDefinition Decl_kinds.Definition))
@@ -1935,7 +1936,12 @@ let default_morphism sign m =
   let evars, mor = resolve_one_typeclass env (goalevars evars) morph in
     mor, proper_projection sigma mor morph
 
+let warn_add_setoid_deprecated =
+  CWarnings.create ~name:"add-setoid" ~category:"deprecated" (fun () ->
+      Pp.(str "Add Setoid is deprecated, please use Add Parametric Relation."))
+
 let add_setoid global binders a aeq t n =
+  warn_add_setoid_deprecated ?loc:a.CAst.loc ();
   init_setoid ();
   let _lemma_refl = declare_instance_refl global binders a aeq n (mkappc "Seq_refl" [a;aeq;t]) in
   let _lemma_sym = declare_instance_sym global binders a aeq n (mkappc "Seq_sym" [a;aeq;t]) in
@@ -1954,7 +1960,12 @@ let make_tactic name =
   let tacname = Qualid (Loc.tag tacpath) in
   TacArg (Loc.tag @@ TacCall (Loc.tag (tacname, [])))
 
+let warn_add_morphism_deprecated =
+  CWarnings.create ~name:"add-morphism" ~category:"deprecated" (fun () ->
+      Pp.(str "Add Morphism f : id is deprecated, please use Add Morphism f with signature (...) as id"))
+
 let add_morphism_infer glob m n =
+  warn_add_morphism_deprecated ?loc:m.CAst.loc ();
   init_setoid ();
   let poly = Flags.is_universe_polymorphism () in
   let instance_id = add_suffix n "_Proper" in
@@ -1962,14 +1973,14 @@ let add_morphism_infer glob m n =
   let evd = Evd.from_env env in
   let uctx, instance = build_morphism_signature env evd m in
     if Lib.is_modtype () then
+      let uctx = UState.const_univ_entry ~poly uctx in
       let cst = Declare.declare_constant ~internal:Declare.InternalTacticRequest instance_id
 				(Entries.ParameterEntry 
-				 (None,poly,(instance,UState.context uctx),None),
+                                 (None,(instance,uctx),None),
 				 Decl_kinds.IsAssumption Decl_kinds.Logical)
       in
 	add_instance (Typeclasses.new_instance 
-			(Lazy.force PropGlobal.proper_class) Hints.empty_hint_info glob
-			poly (ConstRef cst));
+                        (Lazy.force PropGlobal.proper_class) Hints.empty_hint_info glob (ConstRef cst));
 	declare_projection n instance_id (ConstRef cst)
     else
       let kind = Decl_kinds.Global, poly, 
@@ -1980,7 +1991,7 @@ let add_morphism_infer glob m n =
 	| Globnames.ConstRef cst ->
 	  add_instance (Typeclasses.new_instance 
 			  (Lazy.force PropGlobal.proper_class) Hints.empty_hint_info
-			  glob poly (ConstRef cst));
+                          glob (ConstRef cst));
 	  declare_projection n instance_id (ConstRef cst)
 	| _ -> assert false
       in
@@ -1995,29 +2006,32 @@ let add_morphism glob binders m s n =
   let poly = Flags.is_universe_polymorphism () in
   let instance_id = add_suffix n "_Proper" in
   let instance =
-    (((Loc.tag @@ Name instance_id),None), Explicit,
+    (((CAst.make @@ Name instance_id),None), Explicit,
     CAst.make @@ CAppExpl (
 	     (None, Qualid (Loc.tag @@ Libnames.qualid_of_string "Coq.Classes.Morphisms.Proper"),None),
 	     [cHole; s; m]))
   in
   let tac = Tacinterp.interp (make_tactic "add_morphism_tactic") in
-    ignore(new_instance ~global:glob poly binders instance 
-	     (Some (true, CAst.make @@ CRecord []))
-	      ~generalize:false ~tac ~hook:(declare_projection n instance_id) Hints.empty_hint_info)
+  let program_mode = Flags.is_program_mode () in
+  ignore(new_instance ~program_mode ~global:glob poly binders instance
+           (Some (true, CAst.make @@ CRecord []))
+    ~generalize:false ~tac ~hook:(declare_projection n instance_id) Hints.empty_hint_info)
 
 (** Bind to "rewrite" too *)
 
 (** Taken from original setoid_replace, to emulate the old rewrite semantics where
     lemmas are first instantiated and then rewrite proceeds. *)
 
-let check_evar_map_of_evars_defs evd =
+let check_evar_map_of_evars_defs env evd =
  let metas = Evd.meta_list evd in
  let check_freemetas_is_empty rebus =
   Evd.Metaset.iter
    (fun m ->
-     if Evd.meta_defined evd m then () else
-      raise
-	(Logic.RefinerError (Logic.UnresolvedBindings [Evd.meta_name evd m])))
+     if Evd.meta_defined evd m then ()
+     else begin
+       raise
+         (Logic.RefinerError (env, evd, Logic.UnresolvedBindings [Evd.meta_name evd m]))
+     end)
  in
   List.iter
    (fun (_,binding) ->
@@ -2052,7 +2066,7 @@ let unification_rewrite l2r c1 c2 sigma prf car rel but env =
   let c1 = if l2r then nf c' else nf c1
   and c2 = if l2r then nf c2 else nf c'
   and car = nf car and rel = nf rel in
-  check_evar_map_of_evars_defs sigma;
+  check_evar_map_of_evars_defs env sigma;
   let prf = nf prf in
   let prfty = nf (Retyping.get_type_of env sigma prf) in
   let sort = sort_of_rel env sigma but in
@@ -2073,8 +2087,8 @@ let get_hyp gl (c,l) clause l2r =
 
 let general_rewrite_flags = { under_lambdas = false; on_morphisms = true }
 
-(* let rewriteclaustac_key = Profile.declare_profile "cl_rewrite_clause_tac";; *)
-(* let cl_rewrite_clause_tac = Profile.profile5 rewriteclaustac_key cl_rewrite_clause_tac *)
+(* let rewriteclaustac_key = CProfile.declare_profile "cl_rewrite_clause_tac";; *)
+(* let cl_rewrite_clause_tac = CProfile.profile5 rewriteclaustac_key cl_rewrite_clause_tac *)
 
 (** Setoid rewriting when called with "rewrite" *)
 let general_s_rewrite cl l2r occs (c,l) ~new_goals =
diff --git a/plugins/ltac/rewrite.mli b/plugins/ltac/rewrite.mli
index 23767c12f..17e7244b3 100644
--- a/plugins/ltac/rewrite.mli
+++ b/plugins/ltac/rewrite.mli
@@ -37,7 +37,7 @@ type ('constr,'redexpr) strategy_ast =
 
 type rewrite_proof = 
   | RewPrf of constr * constr
-  | RewCast of Term.cast_kind
+  | RewCast of Constr.cast_kind
 
 type evars = evar_map * Evar.Set.t (* goal evars, constraint evars *)
 
@@ -75,7 +75,7 @@ val cl_rewrite_clause :
 val is_applied_rewrite_relation :
   env -> evar_map -> rel_context -> constr -> types option
 
-val declare_relation :
+val declare_relation : ?locality:bool ->
   ?binders:local_binder_expr list -> constr_expr -> constr_expr -> Id.t ->
   constr_expr option -> constr_expr option -> constr_expr option -> unit
 
@@ -110,7 +110,7 @@ val setoid_transitivity : constr option -> unit Proofview.tactic
 val apply_strategy :
   strategy ->
   Environ.env ->
-  Names.Id.t list ->
+  Names.Id.Set.t ->
   constr ->
   bool * constr ->
   evars -> rewrite_result
diff --git a/plugins/ltac/taccoerce.ml b/plugins/ltac/taccoerce.ml
index 9e3a54cc8..e5933de2a 100644
--- a/plugins/ltac/taccoerce.ml
+++ b/plugins/ltac/taccoerce.ml
@@ -8,9 +8,8 @@
 
 open Util
 open Names
-open Term
+open Constr
 open EConstr
-open Pattern
 open Misctypes
 open Genarg
 open Stdarg
@@ -18,15 +17,23 @@ open Geninterp
 
 exception CannotCoerceTo of string
 
+let base_val_typ wit =
+  match val_tag (topwit wit) with Val.Base t -> t | _ -> CErrors.anomaly (Pp.str "Not a base val.")
+
 let (wit_constr_context : (Empty.t, Empty.t, EConstr.constr) Genarg.genarg_type) =
   let wit = Genarg.create_arg "constr_context" in
   let () = register_val0 wit None in
+  let () = Genprint.register_val_print0 (base_val_typ wit)
+    (Pptactic.make_constr_printer Printer.pr_econstr_n_env) in
   wit
 
 (* includes idents known to be bound and references *)
-let (wit_constr_under_binders : (Empty.t, Empty.t, constr_under_binders) Genarg.genarg_type) =
+let (wit_constr_under_binders : (Empty.t, Empty.t, Ltac_pretype.constr_under_binders) Genarg.genarg_type) =
   let wit = Genarg.create_arg "constr_under_binders" in
   let () = register_val0 wit None in
+  let () = Genprint.register_val_print0 (base_val_typ wit)
+             (fun c ->
+               Genprint.TopPrinterNeedsContext (fun env sigma -> Printer.pr_constr_under_binders_env env sigma c)) in
   wit
 
 (** All the types considered here are base types *)
@@ -54,12 +61,9 @@ struct
 
 type t = Val.t
 
-let normalize v = v
-
 let of_constr c = in_gen (topwit wit_constr) c
 
 let to_constr v =
-  let v = normalize v in
   if has_type v (topwit wit_constr) then
     let c = out_gen (topwit wit_constr) v in
     Some c
@@ -71,7 +75,6 @@ let to_constr v =
 let of_uconstr c = in_gen (topwit wit_uconstr) c
 
 let to_uconstr v =
-  let v = normalize v in
   if has_type v (topwit wit_uconstr) then
     Some (out_gen (topwit wit_uconstr) v)
   else None
@@ -79,7 +82,6 @@ let to_uconstr v =
 let of_int i = in_gen (topwit wit_int) i
 
 let to_int v =
-  let v = normalize v in
   if has_type v (topwit wit_int) then
     Some (out_gen (topwit wit_int) v)
   else None
@@ -101,14 +103,12 @@ let constr_of_id env id =
 
 (* Gives the constr corresponding to a Constr_context tactic_arg *)
 let coerce_to_constr_context v =
-  let v = Value.normalize v in
   if has_type v (topwit wit_constr_context) then
     out_gen (topwit wit_constr_context) v
   else raise (CannotCoerceTo "a term context")
 
 (* Interprets an identifier which must be fresh *)
 let coerce_var_to_ident fresh env sigma v =
-  let v = Value.normalize v in
   let fail () = raise (CannotCoerceTo "a fresh identifier") in
   if has_type v (topwit wit_intro_pattern) then
     match out_gen (topwit wit_intro_pattern) v with
@@ -133,7 +133,6 @@ let g = sigma in
 let id_of_name = function
   | Name.Anonymous -> Id.of_string "x"
   | Name.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
@@ -165,14 +164,13 @@ let id_of_name = function
        | Sort s ->
 	  begin
 	    match ESorts.kind sigma s with
-	    | Prop _ -> Label.to_id (Label.make "Prop")
-	    | Type _ -> Label.to_id (Label.make "Type")
+	    | Sorts.Prop _ -> Label.to_id (Label.make "Prop")
+	    | Sorts.Type _ -> Label.to_id (Label.make "Type")
 	  end
        | _ -> fail()
 
 
 let coerce_to_intro_pattern env sigma v =
-  let v = Value.normalize v in
   if has_type v (topwit wit_intro_pattern) then
     snd (out_gen (topwit wit_intro_pattern) v)
   else if has_type v (topwit wit_var) then
@@ -191,7 +189,6 @@ let coerce_to_intro_pattern_naming env sigma v =
   | _ -> raise (CannotCoerceTo "a naming introduction pattern")
 
 let coerce_to_hint_base v =
-  let v = Value.normalize v in
   if has_type v (topwit wit_intro_pattern) then
     match out_gen (topwit wit_intro_pattern) v with
     | _, IntroNaming (IntroIdentifier id) -> Id.to_string id
@@ -199,13 +196,11 @@ let coerce_to_hint_base v =
   else raise (CannotCoerceTo "a hint base name")
 
 let coerce_to_int v =
-  let v = Value.normalize v in
   if has_type v (topwit wit_int) then
     out_gen (topwit wit_int) v
   else raise (CannotCoerceTo "an integer")
 
 let coerce_to_constr env v =
-  let v = Value.normalize v in
   let fail () = raise (CannotCoerceTo "a term") in
   if has_type v (topwit wit_intro_pattern) then
     match out_gen (topwit wit_intro_pattern) v with
@@ -223,7 +218,6 @@ let coerce_to_constr env v =
   else fail ()
 
 let coerce_to_uconstr env v =
-  let v = Value.normalize v in
   if has_type v (topwit wit_uconstr) then
     out_gen (topwit wit_uconstr) v
   else
@@ -236,7 +230,6 @@ let coerce_to_closed_constr env v =
 
 let coerce_to_evaluable_ref env sigma 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
@@ -277,7 +270,6 @@ let coerce_to_intro_pattern_list ?loc env sigma v =
 
 let coerce_to_hyp env sigma v =
   let fail () = raise (CannotCoerceTo "a variable") in
-  let v = Value.normalize v in
   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 -> id
@@ -299,7 +291,6 @@ let coerce_to_hyp_list env sigma v =
 
 (* Interprets a qualified name *)
 let coerce_to_reference env sigma v =
-  let v = Value.normalize v in
   match Value.to_constr v with
   | Some c ->
     begin
@@ -311,7 +302,6 @@ let coerce_to_reference env sigma v =
 (* Quantified named or numbered hypothesis or hypothesis in context *)
 (* (as in Inversion) *)
 let coerce_to_quantified_hypothesis sigma v =
-  let v = Value.normalize v in
   if has_type v (topwit wit_intro_pattern) then
     let v = out_gen (topwit wit_intro_pattern) v in
     match v with
@@ -329,7 +319,6 @@ let coerce_to_quantified_hypothesis sigma v =
 (* Quantified named or numbered hypothesis or hypothesis in context *)
 (* (as in Inversion) *)
 let coerce_to_decl_or_quant_hyp env sigma v =
-  let v = Value.normalize v in
   if has_type v (topwit wit_int) then
     AnonHyp (out_gen (topwit wit_int) v)
   else
diff --git a/plugins/ltac/taccoerce.mli b/plugins/ltac/taccoerce.mli
index 1a67f6f88..dce16b733 100644
--- a/plugins/ltac/taccoerce.mli
+++ b/plugins/ltac/taccoerce.mli
@@ -10,7 +10,6 @@ open Util
 open Names
 open EConstr
 open Misctypes
-open Pattern
 open Genarg
 open Geninterp
 
@@ -32,13 +31,10 @@ module Value :
 sig
   type t = Val.t
 
-  val normalize : t -> t
-  (** Eliminated the leading dynamic type casts. *)
-
   val of_constr : constr -> t
   val to_constr : t -> constr option
-  val of_uconstr : Glob_term.closed_glob_constr -> t
-  val to_uconstr : t -> Glob_term.closed_glob_constr option
+  val of_uconstr : Ltac_pretype.closed_glob_constr -> t
+  val to_uconstr : t -> Ltac_pretype.closed_glob_constr option
   val of_int : int -> t
   val to_int : t -> int option
   val to_list : t -> t list option
@@ -63,9 +59,9 @@ val coerce_to_hint_base : Value.t -> string
 
 val coerce_to_int : Value.t -> int
 
-val coerce_to_constr : Environ.env -> Value.t -> constr_under_binders
+val coerce_to_constr : Environ.env -> Value.t -> Ltac_pretype.constr_under_binders
 
-val coerce_to_uconstr : Environ.env -> Value.t -> Glob_term.closed_glob_constr
+val coerce_to_uconstr : Environ.env -> Value.t -> Ltac_pretype.closed_glob_constr
 
 val coerce_to_closed_constr : Environ.env -> Value.t -> constr
 
@@ -93,4 +89,4 @@ val coerce_to_int_or_var_list : Value.t -> int or_var list
 
 val wit_constr_context : (Empty.t, Empty.t, EConstr.constr) genarg_type
 
-val wit_constr_under_binders : (Empty.t, Empty.t, constr_under_binders) genarg_type
+val wit_constr_under_binders : (Empty.t, Empty.t, Ltac_pretype.constr_under_binders) genarg_type
diff --git a/plugins/ltac/tacentries.ml b/plugins/ltac/tacentries.ml
index cf676f598..4313456a4 100644
--- a/plugins/ltac/tacentries.ml
+++ b/plugins/ltac/tacentries.ml
@@ -63,28 +63,37 @@ let get_separator = function
 | None -> user_err Pp.(str "Missing separator.")
 | Some sep -> sep
 
-let rec parse_user_entry s sep =
+let check_separator ?loc = function
+| None -> ()
+| Some _ -> user_err ?loc (str "Separator is only for arguments with suffix _list_sep.")
+
+let rec parse_user_entry ?loc s sep =
   let l = String.length s in
   if l > 8 && coincide s "ne_" 0 && coincide s "_list" (l - 5) then
-    let entry = parse_user_entry (String.sub s 3 (l-8)) None in
+    let entry = parse_user_entry ?loc (String.sub s 3 (l-8)) None in
+    check_separator ?loc sep;
     Ulist1 entry
   else if l > 12 && coincide s "ne_" 0 &&
                    coincide s "_list_sep" (l-9) then
-    let entry = parse_user_entry (String.sub s 3 (l-12)) None in
+    let entry = parse_user_entry ?loc (String.sub s 3 (l-12)) None in
     Ulist1sep (entry, get_separator sep)
   else if l > 5 && coincide s "_list" (l-5) then
-    let entry = parse_user_entry (String.sub s 0 (l-5)) None in
+    let entry = parse_user_entry ?loc (String.sub s 0 (l-5)) None in
+    check_separator ?loc sep;
     Ulist0 entry
   else if l > 9 && coincide s "_list_sep" (l-9) then
-    let entry = parse_user_entry (String.sub s 0 (l-9)) None in
+    let entry = parse_user_entry ?loc (String.sub s 0 (l-9)) None in
     Ulist0sep (entry, get_separator sep)
   else if l > 4 && coincide s "_opt" (l-4) then
-    let entry = parse_user_entry (String.sub s 0 (l-4)) None in
+    let entry = parse_user_entry ?loc (String.sub s 0 (l-4)) None in
+    check_separator ?loc sep;
     Uopt entry
   else if Int.equal l 7 && coincide s "tactic" 0 && '5' >= s.[6] && s.[6] >= '0' then
     let n = Char.code s.[6] - 48 in
+    check_separator ?loc sep;
     Uentryl ("tactic", n)
   else
+    let _ = check_separator ?loc sep in
     Uentry s
 
 let interp_entry_name interp symb =
@@ -203,7 +212,7 @@ let register_tactic_notation_entry name entry =
 let interp_prod_item = function
   | TacTerm s -> TacTerm s
   | TacNonTerm (loc, ((nt, sep), ido)) ->
-    let symbol = parse_user_entry nt sep in
+    let symbol = parse_user_entry ?loc nt sep in
     let interp s = function
     | None ->
       if String.Map.mem s !entry_names then String.Map.find s !entry_names
@@ -216,7 +225,6 @@ let interp_prod_item = function
       assert (String.equal s "tactic");
       begin match Tacarg.wit_tactic with
       | ExtraArg tag -> ArgT.Any tag
-      | _ -> assert false
       end
     in
     let symbol = interp_entry_name interp symbol in
@@ -366,7 +374,7 @@ let add_ml_tactic_notation name ~level prods =
     in
     let ids = List.map_filter get_id prods in
     let entry = { mltac_name = name; mltac_index = len - i - 1 } in
-    let map id = Reference (Misctypes.ArgVar (Loc.tag id)) in
+    let map id = Reference (Misctypes.ArgVar (CAst.make id)) in
     let tac = TacML (Loc.tag (entry, List.map map ids)) in
     add_glob_tactic_notation false ~level prods true ids tac
   in
@@ -410,7 +418,7 @@ let create_ltac_quotation name cast (e, l) =
 
 type tacdef_kind =
   | NewTac of Id.t
-  | UpdateTac of Nametab.ltac_constant
+  | UpdateTac of Tacexpr.ltac_constant
 
 let is_defined_tac kn =
   try ignore (Tacenv.interp_ltac kn); true with Not_found -> false
@@ -423,11 +431,11 @@ let warn_unusable_identifier =
 let register_ltac local tacl =
   let map tactic_body =
     match tactic_body with
-    | Tacexpr.TacticDefinition ((loc,id), body) ->
+    | Tacexpr.TacticDefinition ({CAst.loc;v=id}, body) ->
         let kn = Lib.make_kn id in
         let id_pp = Id.print id in
         let () = if is_defined_tac kn then
-          CErrors.user_err ?loc 
+          CErrors.user_err ?loc
             (str "There is already an Ltac named " ++ id_pp ++ str".")
         in
         let is_shadowed =
@@ -442,7 +450,7 @@ let register_ltac local tacl =
     | Tacexpr.TacticRedefinition (ident, body) ->
         let loc = loc_of_reference ident in
         let kn =
-          try Nametab.locate_tactic (snd (qualid_of_reference ident))
+          try Tacenv.locate_tactic (snd (qualid_of_reference ident))
           with Not_found ->
             CErrors.user_err ?loc 
                        (str "There is no Ltac named " ++ pr_reference ident ++ str ".")
@@ -465,18 +473,20 @@ let register_ltac local tacl =
   let defs () =
     (** Register locally the tactic to handle recursivity. This function affects
         the whole environment, so that we transactify it afterwards. *)
-    let iter_rec (sp, kn) = Nametab.push_tactic (Nametab.Until 1) sp kn in
+    let iter_rec (sp, kn) = Tacenv.push_tactic (Nametab.Until 1) sp kn in
     let () = List.iter iter_rec recvars in
     List.map map rfun
   in
-  let defs = Future.transactify defs () in
+  (* STATE XXX: Review what is going on here. Why does this needs
+     protection? Why is not the STM level protection enough? Fishy *)
+  let defs = States.with_state_protection defs () in
   let iter (def, tac) = match def with
   | NewTac id ->
     Tacenv.register_ltac false local id tac;
     Flags.if_verbose Feedback.msg_info (Id.print id ++ str " is defined")
   | UpdateTac kn ->
     Tacenv.redefine_ltac local kn tac;
-    let name = Nametab.shortest_qualid_of_tactic kn in
+    let name = Tacenv.shortest_qualid_of_tactic kn in
     Flags.if_verbose Feedback.msg_info (Libnames.pr_qualid name ++ str " is redefined")
   in
   List.iter iter defs
@@ -489,7 +499,7 @@ let print_ltacs () =
   let entries = List.sort sort entries in
   let map (kn, entry) =
     let qid =
-      try Some (Nametab.shortest_qualid_of_tactic kn)
+      try Some (Tacenv.shortest_qualid_of_tactic kn)
       with Not_found -> None
     in
     match qid with
@@ -507,14 +517,38 @@ let print_ltacs () =
   in
   Feedback.msg_notice (prlist_with_sep fnl pr_entry entries)
 
+let locatable_ltac = "Ltac"
+
+let () =
+  let open Prettyp in
+  let locate qid = try Some (Tacenv.locate_tactic qid) with Not_found -> None in
+  let locate_all = Tacenv.locate_extended_all_tactic in
+  let shortest_qualid = Tacenv.shortest_qualid_of_tactic in
+  let name kn = str "Ltac" ++ spc () ++ pr_path (Tacenv.path_of_tactic kn) in
+  let print kn =
+    let qid = qualid_of_path (Tacenv.path_of_tactic kn) in
+    Tacintern.print_ltac qid
+  in
+  let about = name in
+  register_locatable locatable_ltac {
+    locate;
+    locate_all;
+    shortest_qualid;
+    name;
+    print;
+    about;
+  }
+
+let print_located_tactic qid =
+  Feedback.msg_notice (Prettyp.print_located_other locatable_ltac qid)
+
 (** 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
+  register_grammars_by_name "tactic" entries
diff --git a/plugins/ltac/tacentries.mli b/plugins/ltac/tacentries.mli
index aa8f4efe6..ab2c6b307 100644
--- a/plugins/ltac/tacentries.mli
+++ b/plugins/ltac/tacentries.mli
@@ -62,3 +62,6 @@ val create_ltac_quotation : string ->
 
 val print_ltacs : unit -> unit
 (** Display the list of ltac definitions currently available. *)
+
+val print_located_tactic : Libnames.reference -> unit
+(** Display the absolute name of a tactic. *)
diff --git a/plugins/ltac/tacenv.ml b/plugins/ltac/tacenv.ml
index 13b44f0e2..8c59a36fa 100644
--- a/plugins/ltac/tacenv.ml
+++ b/plugins/ltac/tacenv.ml
@@ -11,6 +11,42 @@ open Pp
 open Names
 open Tacexpr
 
+(** Nametab for tactics *)
+
+(** TODO: Share me somewhere *)
+module FullPath =
+struct
+  open Libnames
+  type t = full_path
+  let equal = eq_full_path
+  let to_string = string_of_path
+  let repr sp =
+    let dir,id = repr_path sp in
+      id, (DirPath.repr dir)
+end
+
+module KnTab = Nametab.Make(FullPath)(KerName)
+
+let tactic_tab = Summary.ref ~name:"LTAC-NAMETAB" (KnTab.empty, KNmap.empty)
+
+let push_tactic vis sp kn =
+  let (tab, revtab) = !tactic_tab in
+  let tab = KnTab.push vis sp kn tab in
+  let revtab = KNmap.add kn sp revtab in
+  tactic_tab := (tab, revtab)
+
+let locate_tactic qid = KnTab.locate qid (fst !tactic_tab)
+
+let locate_extended_all_tactic qid = KnTab.find_prefixes qid (fst !tactic_tab)
+
+let exists_tactic kn = KnTab.exists kn (fst !tactic_tab)
+
+let path_of_tactic kn = KNmap.find kn (snd !tactic_tab)
+
+let shortest_qualid_of_tactic kn =
+  let sp = KNmap.find kn (snd !tactic_tab) in
+  KnTab.shortest_qualid Id.Set.empty sp (fst !tactic_tab)
+
 (** Tactic notations (TacAlias) *)
 
 type alias = KerName.t
@@ -103,19 +139,19 @@ let replace kn path t =
 
 let load_md i ((sp, kn), (local, id, b, t)) = match id with
 | None ->
-  let () = if not local then Nametab.push_tactic (Until i) sp kn in
+  let () = if not local then push_tactic (Until i) sp kn in
   add kn b t
 | Some kn0 -> replace kn0 kn t
 
 let open_md i ((sp, kn), (local, id, b, t)) = match id with
 | None ->
-  let () = if not local then Nametab.push_tactic (Exactly i) sp kn in
+  let () = if not local then push_tactic (Exactly i) sp kn in
   add kn b t
 | Some kn0 -> replace kn0 kn t
 
 let cache_md ((sp, kn), (local, id ,b, t)) = match id with
 | None ->
-  let () = Nametab.push_tactic (Until 1) sp kn in
+  let () = push_tactic (Until 1) sp kn in
   add kn b t
 | Some kn0 -> replace kn0 kn t
 
@@ -128,7 +164,7 @@ let subst_md (subst, (local, id, b, t)) =
 
 let classify_md (local, _, _, _ as o) = Substitute o
 
-let inMD : bool * Nametab.ltac_constant option * bool * glob_tactic_expr -> obj =
+let inMD : bool * ltac_constant option * bool * glob_tactic_expr -> obj =
   declare_object {(default_object "TAC-DEFINITION") with
      cache_function  = cache_md;
      load_function   = load_md;
diff --git a/plugins/ltac/tacenv.mli b/plugins/ltac/tacenv.mli
index 958109e5a..4ecc978fe 100644
--- a/plugins/ltac/tacenv.mli
+++ b/plugins/ltac/tacenv.mli
@@ -7,11 +7,21 @@
 (************************************************************************)
 
 open Names
+open Libnames
 open Tacexpr
 open Geninterp
 
 (** This module centralizes the various ways of registering tactics. *)
 
+(** {5 Tactic naming} *)
+
+val push_tactic : Nametab.visibility -> full_path -> ltac_constant -> unit
+val locate_tactic : qualid -> ltac_constant
+val locate_extended_all_tactic : qualid -> ltac_constant list
+val exists_tactic : full_path -> bool
+val path_of_tactic : ltac_constant -> full_path
+val shortest_qualid_of_tactic : ltac_constant -> qualid
+
 (** {5 Tactic notations} *)
 
 type alias = KerName.t
diff --git a/plugins/ltac/tacexpr.mli b/plugins/ltac/tacexpr.mli
index 64da097de..146d8300d 100644
--- a/plugins/ltac/tacexpr.mli
+++ b/plugins/ltac/tacexpr.mli
@@ -10,13 +10,14 @@ open Loc
 open Names
 open Constrexpr
 open Libnames
-open Nametab
 open Genredexpr
 open Genarg
 open Pattern
 open Misctypes
 open Locus
 
+type ltac_constant = KerName.t
+
 type direction_flag = bool (* true = Left-to-right    false = right-to-right *)
 type lazy_flag =
   | General (* returns all possible successes *)
@@ -40,7 +41,7 @@ type goal_selector = Vernacexpr.goal_selector =
 
 type 'a core_destruction_arg = 'a Misctypes.core_destruction_arg =
   | ElimOnConstr of 'a
-  | ElimOnIdent of Id.t located
+  | ElimOnIdent of lident
   | ElimOnAnonHyp of int
 
 type 'a destruction_arg =
@@ -80,12 +81,12 @@ type 'a with_bindings_arg = clear_flag * 'a with_bindings
 (* Type of patterns *)
 type 'a match_pattern =
   | Term of 'a
-  | Subterm of bool * Id.t option * 'a
+  | Subterm of Id.t option * 'a
 
 (* Type of hypotheses for a Match Context rule *)
 type 'a match_context_hyps =
-  | Hyp of Name.t located * 'a match_pattern
-  | Def of Name.t located * 'a match_pattern * 'a match_pattern
+  | Hyp of lname * 'a match_pattern
+  | Def of lname * 'a match_pattern * 'a match_pattern
 
 (* Type of a Match rule for Match Context and Match *)
 type ('a,'t) match_rule =
@@ -253,7 +254,7 @@ and 'a gen_tactic_expr =
   | TacFail of global_flag * int or_var * 'n message_token list
   | TacInfo of 'a gen_tactic_expr
   | TacLetIn of rec_flag *
-      (Id.t located * 'a gen_tactic_arg) list *
+      (lname * 'a gen_tactic_arg) list *
       'a gen_tactic_expr
   | TacMatch of lazy_flag *
       'a gen_tactic_expr *
@@ -299,7 +300,7 @@ type g_trm = glob_constr_and_expr
 type g_pat = glob_constr_pattern_and_expr
 type g_cst = evaluable_global_reference and_short_name or_var
 type g_ref = ltac_constant located or_var
-type g_nam  = Id.t located
+type g_nam = lident
 
 type g_dispatch =  <
     term:g_trm;
@@ -327,7 +328,7 @@ type r_trm = constr_expr
 type r_pat = constr_pattern_expr
 type r_cst = reference or_by_notation
 type r_ref = reference
-type r_nam  = Id.t located
+type r_nam = lident
 type r_lev = rlevel
 
 type r_dispatch =  <
@@ -356,7 +357,7 @@ type t_trm = EConstr.constr
 type t_pat = constr_pattern
 type t_cst = evaluable_global_reference
 type t_ref = ltac_constant located
-type t_nam  = Id.t
+type t_nam = Id.t
 
 type t_dispatch =  <
     term:t_trm;
@@ -385,10 +386,10 @@ type ltac_call_kind =
   | LtacNameCall of ltac_constant
   | LtacAtomCall of glob_atomic_tactic_expr
   | LtacVarCall of Id.t * glob_tactic_expr
-  | LtacConstrInterp of Glob_term.glob_constr * Glob_term.ltac_var_map
+  | LtacConstrInterp of Glob_term.glob_constr * Ltac_pretype.ltac_var_map
 
 type ltac_trace = ltac_call_kind Loc.located list
 
 type tacdef_body =
-  | TacticDefinition of Id.t Loc.located * raw_tactic_expr  (* indicates that user employed ':=' in Ltac body *)
+  | TacticDefinition of lident * 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/plugins/ltac/tacintern.ml b/plugins/ltac/tacintern.ml
index 0554d4364..22ec6c5b1 100644
--- a/plugins/ltac/tacintern.ml
+++ b/plugins/ltac/tacintern.ml
@@ -6,12 +6,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Pattern
 open Pp
+open CErrors
+open CAst
+open Pattern
 open Genredexpr
 open Glob_term
 open Tacred
-open CErrors
 open Util
 open Names
 open Libnames
@@ -73,11 +74,11 @@ let strict_check = ref false
 let adjust_loc loc = if !strict_check then None else loc
 
 (* Globalize a name which must be bound -- actually just check it is bound *)
-let intern_hyp ist (loc,id as locid) =
+let intern_hyp ist ({loc;v=id} as locid) =
   if not !strict_check then
     locid
   else if find_ident id ist then
-    Loc.tag id
+    make id
   else
     Pretype_errors.error_var_not_found ?loc id
 
@@ -89,7 +90,8 @@ let intern_int_or_var = intern_or_var (fun (n : int) -> n)
 let intern_string_or_var = intern_or_var (fun (s : string) -> s)
 
 let intern_global_reference ist = function
-  | Ident (loc,id) when find_var id ist -> ArgVar (loc,id)
+  | Ident (loc,id) when find_var id ist ->
+    ArgVar CAst.(make ?loc id)
   | r ->
       let loc,_ as lqid = qualid_of_reference r in
       try ArgArg (loc,locate_global_with_alias lqid)
@@ -99,26 +101,26 @@ let intern_ltac_variable ist = function
   | Ident (loc,id) ->
       if find_var id ist then
 	(* A local variable of any type *)
-	ArgVar (loc,id)
+        ArgVar CAst.(make ?loc id)
       else raise Not_found
   | _ ->
       raise Not_found
 
 let intern_constr_reference strict ist = function
   | Ident (_,id) as r when not strict && find_hyp id ist ->
-      (CAst.make @@ GVar id), Some (CAst.make @@ CRef (r,None))
+      (DAst.make @@ GVar id), Some (CAst.make @@ CRef (r,None))
   | Ident (_,id) as r when find_var id ist ->
-      (CAst.make @@ GVar id), if strict then None else Some (CAst.make @@ CRef (r,None))
+      (DAst.make @@ GVar id), if strict then None else Some (CAst.make @@ CRef (r,None))
   | r ->
       let loc,_ as lqid = qualid_of_reference r in
-      CAst.make @@ GRef (locate_global_with_alias lqid,None), 
+      DAst.make @@ GRef (locate_global_with_alias lqid,None), 
 	if strict then None else Some (CAst.make @@ CRef (r,None))
 
 (* Internalize an isolated reference in position of tactic *)
 
 let intern_isolated_global_tactic_reference r =
   let (loc,qid) = qualid_of_reference r in
-  TacCall (Loc.tag ?loc (ArgArg (loc,locate_tactic qid),[]))
+  TacCall (Loc.tag ?loc (ArgArg (loc,Tacenv.locate_tactic qid),[]))
 
 let intern_isolated_tactic_reference strict ist r =
   (* An ltac reference *)
@@ -137,7 +139,7 @@ let intern_isolated_tactic_reference strict ist r =
 
 let intern_applied_global_tactic_reference r =
   let (loc,qid) = qualid_of_reference r in
-  ArgArg (loc,locate_tactic qid)
+  ArgArg (loc,Tacenv.locate_tactic qid)
 
 let intern_applied_tactic_reference ist r =
   (* An ltac reference *)
@@ -249,7 +251,7 @@ and intern_or_and_intro_pattern lf ist = function
       IntroOrPattern (List.map (List.map (intern_intro_pattern lf ist)) ll)
 
 let intern_or_and_intro_pattern_loc lf ist = function
-  | ArgVar (_,id) as x ->
+  | ArgVar {v=id} as x ->
       if find_var id ist then x
       else user_err Pp.(str "Disjunctive/conjunctive introduction pattern expected.")
   | ArgArg (loc,l) -> ArgArg (loc,intern_or_and_intro_pattern lf ist l)
@@ -261,17 +263,18 @@ let intern_intro_pattern_naming_loc lf ist (loc,pat) =
 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) ->
+  | clear,ElimOnIdent {loc;v=id} ->
       if !strict_check then
 	(* If in a defined tactic, no intros-until *)
-	match intern_constr ist (CAst.make @@ CRef (Ident (Loc.tag id), None)) with
-	| {loc; CAst.v = GVar id}, _ -> clear,ElimOnIdent (loc,id)
-	| c -> clear,ElimOnConstr (c,NoBindings)
+	let c, p = intern_constr ist (CAst.make @@ CRef (Ident (Loc.tag id), None)) in
+	match DAst.get c with
+        | GVar id -> clear,ElimOnIdent CAst.(make ?loc:c.loc id)
+	| _ -> clear,ElimOnConstr ((c, p), NoBindings)
       else
-	clear,ElimOnIdent (loc,id)
+        clear,ElimOnIdent CAst.(make ?loc id)
 
 let short_name = function
-  | AN (Ident (loc,id)) when not !strict_check -> Some (loc,id)
+  | AN (Ident (loc,id)) when not !strict_check -> Some CAst.(make ?loc id)
   | _ -> None
 
 let intern_evaluable_global_reference ist r =
@@ -291,9 +294,9 @@ let intern_evaluable_reference_or_by_notation ist = function
 
 (* Globalize a reduction expression *)
 let intern_evaluable ist = function
-  | AN (Ident (loc,id)) when find_var id ist -> ArgVar (loc,id)
+  | AN (Ident (loc,id)) when find_var id ist -> ArgVar CAst.(make ?loc id)
   | AN (Ident (loc,id)) when not !strict_check && find_hyp id ist ->
-      ArgArg (EvalVarRef id, Some (loc,id))
+      ArgArg (EvalVarRef id, Some CAst.(make ?loc id))
   | r ->
       let e = intern_evaluable_reference_or_by_notation ist r in
       let na = short_name r in
@@ -321,13 +324,23 @@ let intern_constr_pattern ist ~as_type ~ltacvars pc =
 
 let dummy_pat = PRel 0
 
-let intern_typed_pattern ist p =
+let intern_typed_pattern ist ~as_type ~ltacvars p =
   (* we cannot ensure in non strict mode that the pattern is closed *)
   (* keeping a constr_expr copy is too complicated and we want anyway to *)
   (* type it, so we remember the pattern as a glob_constr only *)
+  let metas,pat =
+    if !strict_check then
+      let ltacvars = {
+          Constrintern.ltac_vars = ltacvars;
+          ltac_bound = Id.Set.empty;
+          ltac_extra = ist.extra;
+        } in
+      Constrintern.intern_constr_pattern ist.genv ~as_type ~ltacvars p
+    else
+      [], dummy_pat in
   let (glob,_ as c) = intern_constr_gen true false ist p in
   let bound_names = Glob_ops.bound_glob_vars glob in
-  (bound_names,c,dummy_pat)
+  metas,(bound_names,c,pat)
 
 let intern_typed_pattern_or_ref_with_occurrences ist (l,p) =
   let interp_ref r =
@@ -348,7 +361,7 @@ let intern_typed_pattern_or_ref_with_occurrences ist (l,p) =
         ltac_extra = ist.extra;
       } in
       let c = Constrintern.interp_reference sign r in
-      match c.CAst.v with
+      match DAst.get c with
       | GRef (r,None) ->
           Inl (ArgArg (evaluable_of_global_reference ist.genv r,None))
       | GVar id ->
@@ -359,11 +372,11 @@ let intern_typed_pattern_or_ref_with_occurrences ist (l,p) =
           Inr (bound_names,(c,None),dummy_pat) in
   (l, match p with
   | Inl r -> interp_ref r
-  | Inr { CAst.v = CAppExpl((None,r,None),[]) } ->
+  | Inr { v = CAppExpl((None,r,None),[]) } ->
       (* We interpret similarly @ref and ref *)
       interp_ref (AN r)
   | Inr c ->
-      Inr (intern_typed_pattern ist c))
+      Inr (snd (intern_typed_pattern ist ~as_type:false ~ltacvars:ist.ltacvars c)))
 
 (* This seems fairly hacky, but it's the first way I've found to get proper
    globalization of [unfold].  --adamc *)
@@ -389,8 +402,8 @@ let intern_red_expr ist = function
   | Lazy f -> Lazy (intern_flag ist f)
   | Pattern l -> Pattern (List.map (intern_constr_with_occurrences ist) l)
   | Simpl (f,o) ->
-     Simpl (intern_flag ist f,
-	    Option.map (intern_typed_pattern_or_ref_with_occurrences ist) o)
+    Simpl (intern_flag ist f,
+           Option.map (intern_typed_pattern_or_ref_with_occurrences ist) o)
   | CbvVm o -> CbvVm (Option.map (intern_typed_pattern_or_ref_with_occurrences ist) o)
   | CbvNative o -> CbvNative (Option.map (intern_typed_pattern_or_ref_with_occurrences ist) o)
   | (Red _ | Hnf | ExtraRedExpr _ as r ) -> r
@@ -417,9 +430,9 @@ let intern_hyp_location ist ((occs,id),hl) =
 
 (* Reads a pattern *)
 let intern_pattern ist ?(as_type=false) ltacvars = function
-  | Subterm (b,ido,pc) ->
+  | Subterm (ido,pc) ->
       let (metas,pc) = intern_constr_pattern ist ~as_type:false ~ltacvars pc in
-      ido, metas, Subterm (b,ido,pc)
+      ido, metas, Subterm (ido,pc)
   | Term pc ->
       let (metas,pc) = intern_constr_pattern ist ~as_type ~ltacvars pc in
       None, metas, Term pc
@@ -427,7 +440,7 @@ let intern_pattern ist ?(as_type=false) ltacvars = function
 let intern_constr_may_eval ist = function
   | ConstrEval (r,c) -> ConstrEval (intern_red_expr ist r,intern_constr ist c)
   | ConstrContext (locid,c) ->
-      ConstrContext (intern_hyp ist locid,intern_constr ist c)
+    ConstrContext (intern_hyp ist locid,intern_constr ist c)
   | ConstrTypeOf c -> ConstrTypeOf (intern_constr ist c)
   | ConstrTerm c -> ConstrTerm (intern_constr ist c)
 
@@ -441,12 +454,12 @@ let opt_cons accu = function
 
 (* Reads the hypotheses of a "match goal" rule *)
 let rec intern_match_goal_hyps ist ?(as_type=false) lfun = function
-  | (Hyp ((_,na) as locna,mp))::tl ->
+  | (Hyp ({v=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
       let lfun' = name_cons (opt_cons lfun ido) na in
       lfun', metas1@metas2, Hyp (locna,pat)::hyps
-  | (Def ((_,na) as locna,mv,mp))::tl ->
+  | (Def ({v=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 ~as_type lfun tl in
@@ -456,10 +469,11 @@ let rec intern_match_goal_hyps ist ?(as_type=false) lfun = function
 
 (* Utilities *)
 let extract_let_names lrc =
-  let fold accu ((loc, name), _) =
-    if Id.Set.mem name accu then user_err ?loc
+  let fold accu ({loc;v=name}, _) =
+    Nameops.Name.fold_right (fun id accu ->
+    if Id.Set.mem id accu then user_err ?loc
       ~hdr:"glob_tactic" (str "This variable is bound several times.")
-    else Id.Set.add name accu
+    else Id.Set.add id accu) name accu
   in
   List.fold_left fold Id.Set.empty lrc
 
@@ -528,7 +542,12 @@ let rec intern_atomic lf ist x =
          then intern_type ist c else intern_constr ist c),
 	clause_app (intern_hyp_location ist) cl)
   | TacChange (Some p,c,cl) ->
-      TacChange (Some (intern_typed_pattern ist p),intern_constr ist c,
+      let { ltacvars } = ist in
+      let metas,pat = intern_typed_pattern ist ~as_type:false ~ltacvars p in
+      let fold accu x = Id.Set.add x accu in
+      let ltacvars = List.fold_left fold ltacvars metas in
+      let ist' = { ist with ltacvars } in
+      TacChange (Some pat,intern_constr ist' c,
 	clause_app (intern_hyp_location ist) cl)
 
   (* Equality and inversion *)
@@ -721,7 +740,7 @@ let pr_ltac_fun_arg n = spc () ++ Name.print n
 
 let print_ltac id =
  try
-  let kn = Nametab.locate_tactic id in
+  let kn = Tacenv.locate_tactic id in
   let entries = Tacenv.ltac_entries () in
   let tac = KNmap.find kn entries in
   let filter mp =
@@ -796,7 +815,7 @@ 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
+    (CAst.make ?loc @@ Name id, c) :: accu
   in
   let bindings = Id.Map.fold fold bindings [] in
   (** This is theoretically not correct due to potential variable capture, but
diff --git a/plugins/ltac/tacintern.mli b/plugins/ltac/tacintern.mli
index e3a4d5c79..8021dc715 100644
--- a/plugins/ltac/tacintern.mli
+++ b/plugins/ltac/tacintern.mli
@@ -47,7 +47,7 @@ val intern_constr_with_bindings :
   glob_sign -> constr_expr * constr_expr bindings ->
   glob_constr_and_expr * glob_constr_and_expr bindings
 
-val intern_hyp : glob_sign -> Id.t Loc.located -> Id.t Loc.located
+val intern_hyp : glob_sign -> lident -> lident
 
 (** Adds a globalization function for extra generic arguments *)
 
diff --git a/plugins/ltac/tacinterp.ml b/plugins/ltac/tacinterp.ml
index 2a1e2b682..79b5c1622 100644
--- a/plugins/ltac/tacinterp.ml
+++ b/plugins/ltac/tacinterp.ml
@@ -9,6 +9,7 @@
 open Constrintern
 open Patternops
 open Pp
+open CAst
 open Genredexpr
 open Glob_term
 open Glob_ops
@@ -38,6 +39,7 @@ open Tacintern
 open Taccoerce
 open Proofview.Notations
 open Context.Named.Declaration
+open Ltac_pretype
 
 let ltac_trace_info = Tactic_debug.ltac_trace_info
 
@@ -75,6 +77,9 @@ let out_gen wit v =
 
 let val_tag wit = val_tag (topwit wit)
 
+let base_val_typ wit =
+  match val_tag wit with Val.Base t -> t | _ -> anomaly (str "Not a base val.")
+
 let pr_argument_type arg =
   let Val.Dyn (tag, _) = arg in
   Val.pr tag
@@ -123,6 +128,8 @@ type tacvalue =
 let (wit_tacvalue : (Empty.t, tacvalue, tacvalue) Genarg.genarg_type) =
   let wit = Genarg.create_arg "tacvalue" in
   let () = register_val0 wit None in
+  let () = Genprint.register_val_print0 (base_val_typ wit)
+             (fun _ -> Genprint.TopPrinterBasic (fun () -> str "<tactic closure>")) in
   wit
 
 let of_tacvalue v = in_gen (topwit wit_tacvalue) v
@@ -130,7 +137,6 @@ let to_tacvalue v = out_gen (topwit wit_tacvalue) v
 
 (** More naming applications *)
 let name_vfun appl vle =
-  let vle = Value.normalize vle in
   if has_type vle (topwit wit_tacvalue) then
     match to_tacvalue vle with
     | VFun (appl0,trace,lfun,vars,t) -> of_tacvalue (VFun (combine_appl appl0 appl,trace,lfun,vars,t))
@@ -139,7 +145,7 @@ let name_vfun appl vle =
 
 module TacStore = Geninterp.TacStore
 
-let f_avoid_ids : Id.t list TacStore.field = TacStore.field ()
+let f_avoid_ids : Id.Set.t TacStore.field = TacStore.field ()
 (* ids inherited from the call context (needed to get fresh ids) *)
 let f_debug : debug_info TacStore.field = TacStore.field ()
 let f_trace : ltac_trace TacStore.field = TacStore.field ()
@@ -229,25 +235,16 @@ let curr_debug ist = match TacStore.get ist.extra f_debug with
 
 (* Displays a value *)
 let pr_value env v =
-  let v = Value.normalize v in
-  if has_type v (topwit wit_tacvalue) then str "a tactic"
-  else if has_type v (topwit wit_constr_context) then
-    let c = out_gen (topwit wit_constr_context) v in
-    match env with
-    | Some (env,sigma) -> pr_leconstr_env env sigma c
-    | _ -> str "a term"
-  else if has_type v (topwit wit_constr) then
-    let c = out_gen (topwit wit_constr) v in
+  let pr_with_env pr =
     match env with
-    | Some (env,sigma) -> pr_leconstr_env env sigma c
-    | _ -> str "a term"
-  else if has_type v (topwit wit_constr_under_binders) then
-    let c = out_gen (topwit wit_constr_under_binders) v in
-    match env with
-    | Some (env,sigma) -> pr_lconstr_under_binders_env env sigma c
-    | _ -> str "a term"
-  else
-    str "a value of type" ++ spc () ++ pr_argument_type v
+    | Some (env,sigma) -> pr env sigma
+    | None -> str "a value of type" ++ spc () ++ pr_argument_type v in
+  let open Genprint in
+  match generic_val_print v with
+  | TopPrinterBasic pr -> pr ()
+  | TopPrinterNeedsContext pr -> pr_with_env pr
+  | TopPrinterNeedsContextAndLevel { default_already_surrounded; printer } ->
+     pr_with_env (fun env sigma -> printer env sigma default_already_surrounded)
 
 let pr_closure env ist body =
   let pp_body = Pptactic.pr_glob_tactic env body in
@@ -287,7 +284,6 @@ let push_trace call ist = match TacStore.get ist.extra f_trace with
 | Some trace -> Proofview.tclUNIT (call :: trace)
 
 let propagate_trace ist loc id v =
-  let v = Value.normalize v in
   if has_type v (topwit wit_tacvalue) then
     let tacv = to_tacvalue v in
     match tacv with
@@ -300,7 +296,6 @@ let propagate_trace ist loc id v =
   else Proofview.tclUNIT v
 
 let append_trace trace v =
-  let v = Value.normalize v in
   if has_type v (topwit wit_tacvalue) then
     match to_tacvalue v with
     | VFun (appl,trace',lfun,it,b) -> of_tacvalue (VFun (appl,trace'@trace,lfun,it,b))
@@ -309,11 +304,9 @@ 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 
     (str "Variable " ++ Id.print id ++ str " should be bound to a tactic.")
   in
-  let v = Value.normalize v in
   if has_type v (topwit wit_tacvalue) then
     let tacv = to_tacvalue v in
     match tacv with
@@ -371,16 +364,16 @@ let error_ltac_variable ?loc id env v s =
    strbrk "which cannot be coerced to " ++ str s ++ str".")
 
 (* Raise Not_found if not in interpretation sign *)
-let try_interp_ltac_var coerce ist env (loc,id) =
+let try_interp_ltac_var coerce ist env {loc;v=id} =
   let v = Id.Map.find id ist.lfun in
   try coerce v with CannotCoerceTo s -> error_ltac_variable ?loc id env v s
 
 let interp_ltac_var coerce ist env locid =
   try try_interp_ltac_var coerce ist env locid
-  with Not_found -> anomaly (str "Detected '" ++ Id.print (snd locid) ++ str "' as ltac var at interning time.")
+  with Not_found -> anomaly (str "Detected '" ++ Id.print locid.v ++ str "' as ltac var at interning time.")
 
 let interp_ident ist env sigma id =
-  try try_interp_ltac_var (coerce_var_to_ident false env sigma) ist (Some (env,sigma)) (Loc.tag id)
+  try try_interp_ltac_var (coerce_var_to_ident false env sigma) ist (Some (env,sigma)) (make id)
   with Not_found -> id
 
 (* Interprets an optional identifier, bound or fresh *)
@@ -389,25 +382,25 @@ let interp_name ist env sigma = function
   | Name id -> Name (interp_ident ist env sigma id)
 
 let interp_intro_pattern_var loc ist env sigma id =
-  try try_interp_ltac_var (coerce_to_intro_pattern env sigma) ist (Some (env,sigma)) (loc,id)
+  try try_interp_ltac_var (coerce_to_intro_pattern env sigma) ist (Some (env,sigma)) (make ?loc id)
   with Not_found -> IntroNaming (IntroIdentifier id)
 
 let interp_intro_pattern_naming_var loc ist env sigma id =
-  try try_interp_ltac_var (coerce_to_intro_pattern_naming env sigma) ist (Some (env,sigma)) (loc,id)
+  try try_interp_ltac_var (coerce_to_intro_pattern_naming env sigma) ist (Some (env,sigma)) (make ?loc id)
   with Not_found -> IntroIdentifier id
 
-let interp_int ist locid =
+let interp_int ist ({loc;v=id} as locid) =
   try try_interp_ltac_var coerce_to_int ist None locid
   with Not_found ->
-    user_err ?loc:(fst locid) ~hdr:"interp_int"
-     (str "Unbound variable "  ++ Id.print (snd locid) ++ str".")
+    user_err ?loc ~hdr:"interp_int"
+     (str "Unbound variable "  ++ Id.print id ++ str".")
 
 let interp_int_or_var ist = function
   | ArgVar locid -> interp_int ist locid
   | ArgArg n -> n
 
 let interp_int_or_var_as_list ist = function
-  | ArgVar (_,id as locid) ->
+  | ArgVar ({v=id} as locid) ->
       (try coerce_to_int_or_var_list (Id.Map.find id ist.lfun)
        with Not_found | CannotCoerceTo _ -> [ArgArg (interp_int ist locid)])
   | ArgArg n as x -> [x]
@@ -416,15 +409,15 @@ let interp_int_or_var_list ist l =
   List.flatten (List.map (interp_int_or_var_as_list ist) l)
 
 (* Interprets a bound variable (especially an existing hypothesis) *)
-let interp_hyp ist env sigma (loc,id as locid) =
+let interp_hyp ist env sigma ({loc;v=id} as locid) =
   (* Look first in lfun for a value coercible to a variable *)
   try try_interp_ltac_var (coerce_to_hyp env sigma) ist (Some (env,sigma)) 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 (env, sigma, Logic.NoSuchHyp id))
 
-let interp_hyp_list_as_list ist env sigma (loc,id as x) =
+let interp_hyp_list_as_list ist env sigma ({loc;v=id} as x) =
   try coerce_to_hyp_list env sigma (Id.Map.find id ist.lfun)
   with Not_found | CannotCoerceTo _ -> [interp_hyp ist env sigma x]
 
@@ -433,8 +426,8 @@ let interp_hyp_list ist env sigma l =
 
 let interp_reference ist env sigma = function
   | ArgArg (_,r) -> r
-  | ArgVar (loc, id) ->
-    try try_interp_ltac_var (coerce_to_reference env sigma) ist (Some (env,sigma)) (loc, id)
+  | ArgVar {loc;v=id} ->
+    try try_interp_ltac_var (coerce_to_reference env sigma) ist (Some (env,sigma)) (make ?loc id)
     with Not_found ->
       try
         VarRef (get_id (Environ.lookup_named id env))
@@ -447,7 +440,7 @@ let try_interp_evaluable env (loc, id) =
   | _ -> error_not_evaluable (VarRef id)
 
 let interp_evaluable ist env sigma = function
-  | ArgArg (r,Some (loc,id)) ->
+  | ArgArg (r,Some {loc;v=id}) ->
     (* Maybe [id] has been introduced by Intro-like tactics *)
     begin
       try try_interp_evaluable env (loc, id)
@@ -457,8 +450,8 @@ let interp_evaluable ist env sigma = function
         | _ -> 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 sigma) ist (Some (env,sigma)) (loc, id)
+  | ArgVar {loc;v=id} ->
+    try try_interp_ltac_var (coerce_to_evaluable_ref env sigma) ist (Some (env,sigma)) (make ?loc id)
     with Not_found ->
       try try_interp_evaluable env (loc, id)
       with Not_found -> error_global_not_found ?loc (qualid_of_ident id)
@@ -501,57 +494,55 @@ let extract_ltac_constr_values ist env =
     could barely be defined as a feature... *)
 
 (* Extract the identifier list from lfun: join all branches (what to do else?)*)
-let rec intropattern_ids (loc,pat) = match pat with
-  | IntroNaming (IntroIdentifier id) -> [id]
+let rec intropattern_ids accu (loc,pat) = match pat with
+  | IntroNaming (IntroIdentifier id) -> Id.Set.add id accu
   | IntroAction (IntroOrAndPattern (IntroAndPattern l)) ->
-      List.flatten (List.map intropattern_ids l)
+      List.fold_left intropattern_ids accu l
   | IntroAction (IntroOrAndPattern (IntroOrPattern ll)) ->
-      List.flatten (List.map intropattern_ids (List.flatten ll))
+      List.fold_left intropattern_ids accu (List.flatten ll)
   | IntroAction (IntroInjection l) ->
-      List.flatten (List.map intropattern_ids l)
-  | IntroAction (IntroApplyOn ((_,c),pat)) -> intropattern_ids pat
+      List.fold_left intropattern_ids accu l
+  | IntroAction (IntroApplyOn ((_,c),pat)) -> intropattern_ids accu pat
   | IntroNaming (IntroAnonymous | IntroFresh _)
   | IntroAction (IntroWildcard | IntroRewrite _)
-  | IntroForthcoming _ -> []
+  | IntroForthcoming _ -> accu
 
-let extract_ids ids lfun =
+let extract_ids ids lfun accu =
   let fold id v accu =
-    let v = Value.normalize v in
     if has_type v (topwit wit_intro_pattern) then
       let (_, ipat) = out_gen (topwit wit_intro_pattern) v in
       if Id.List.mem id ids then accu
-      else accu @ intropattern_ids (Loc.tag ipat)
+      else intropattern_ids accu (Loc.tag ipat)
     else accu
   in
-  Id.Map.fold fold lfun []
+  Id.Map.fold fold lfun accu
 
 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 env sigma)
-			    ist (Some (env,sigma)) (Loc.tag id)
+                            ist (Some (env,sigma)) (make id)
     with Not_found -> id in
-  let ids = List.map_filter (function ArgVar (_, id) -> Some id | _ -> None) l in
+  let ids = List.map_filter (function ArgVar {v=id} -> Some id | _ -> None) l in
   let avoid = match TacStore.get ist.extra f_avoid_ids with
-  | None -> []
+  | None -> Id.Set.empty
   | Some l -> l
   in
-  let avoid = (extract_ids ids ist.lfun) @ avoid in
+  let avoid = extract_ids ids ist.lfun avoid in
   let id =
     if List.is_empty l then default_fresh_id
     else
       let s =
 	String.concat "" (List.map (function
 	  | ArgArg s -> s
-	  | ArgVar (_,id) -> Id.to_string (extract_ident ist env sigma id)) l) in
+          | ArgVar {v=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
 
 (* Extract the uconstr list from lfun *)
 let extract_ltac_constr_context ist env sigma =
-  let open Glob_term in
   let add_uconstr id v map =
     try Id.Map.add id (coerce_to_uconstr env v) map
     with CannotCoerceTo _ -> map
@@ -602,10 +593,10 @@ let interp_gen kind ist pattern_mode flags env sigma c =
   let { closure = constrvars ; term } =
     interp_glob_closure ist env sigma ~kind:kind_for_intern ~pattern_mode c in
   let vars = {
-    Glob_term.ltac_constrs = constrvars.typed;
-    Glob_term.ltac_uconstrs = constrvars.untyped;
-    Glob_term.ltac_idents = constrvars.idents;
-    Glob_term.ltac_genargs = ist.lfun;
+    ltac_constrs = constrvars.typed;
+    ltac_uconstrs = constrvars.untyped;
+    ltac_idents = constrvars.idents;
+    ltac_genargs = ist.lfun;
   } in
   (* Jason Gross: To avoid unnecessary modifications to tacinterp, as
       suggested by Arnaud Spiwack, we run push_trace immediately.  We do
@@ -679,8 +670,8 @@ let interp_typed_pattern ist env sigma (_,c,_) =
 (* Interprets a constr expression *)
 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
-    | { CAst.v = GVar id }, _ ->
+    try match DAst.get (fst (dest_fun x)) with
+    | GVar id ->
       let v = Id.Map.find id ist.lfun in
       sigma, List.map inj_fun (coerce_to_constr_list env v)
     | _ ->
@@ -711,7 +702,7 @@ let interp_constr_with_occurrences ist env sigma (occs,c) =
 
 let interp_closed_typed_pattern_with_occurrences ist env sigma (occs, a) =
   let p = match a with
-  | Inl (ArgVar (loc,id)) ->
+  | Inl (ArgVar {loc;v=id}) ->
       (* This is the encoding of an ltac var supposed to be bound
          prioritary to an evaluable reference and otherwise to a constr
          (it is an encoding to satisfy the "union" type given to Simpl) *)
@@ -720,7 +711,7 @@ let interp_closed_typed_pattern_with_occurrences ist env sigma (occs, a) =
       with CannotCoerceTo _ ->
         let c = coerce_to_closed_constr env x in
         Inr (pattern_of_constr env sigma (EConstr.to_constr sigma c)) in
-    (try try_interp_ltac_var coerce_eval_ref_or_constr ist (Some (env,sigma)) (loc,id)
+    (try try_interp_ltac_var coerce_eval_ref_or_constr ist (Some (env,sigma)) (make ?loc id)
      with Not_found ->
        error_global_not_found ?loc (qualid_of_ident id))
   | Inl (ArgArg _ as b) -> Inl (interp_evaluable ist env sigma b)
@@ -766,7 +757,7 @@ let interp_may_eval f ist env sigma = function
       let (sigma,c_interp) = f ist env sigma c in
       let (redfun, _) = Redexpr.reduction_of_red_expr env redexp in
       redfun env sigma c_interp
-  | ConstrContext ((loc,s),c) ->
+  | ConstrContext ({loc;v=s},c) ->
       (try
 	let (sigma,ic) = f ist env sigma c in
 	let ctxt = coerce_to_constr_context (Id.Map.find s ist.lfun) in
@@ -818,56 +809,20 @@ let interp_constr_may_eval ist env sigma c =
   end
 
 (** TODO: should use dedicated printers *)
-let rec message_of_value v =
-  let v = Value.normalize v in
-  let open Ftactic in
-  if has_type v (topwit wit_tacvalue) then
-    Ftactic.return (str "<tactic>")
-  else if has_type v (topwit wit_constr) then
-    let v = out_gen (topwit wit_constr) v in
-    Ftactic.enter begin fun gl -> Ftactic.return (pr_econstr_env (pf_env gl) (project gl) v) end
-  else if has_type v (topwit wit_constr_under_binders) then
-    let c = out_gen (topwit wit_constr_under_binders) v in
-    Ftactic.enter begin fun gl ->
-      Ftactic.return (pr_constr_under_binders_env (pf_env gl) (project gl) c)
-    end
-  else if has_type v (topwit wit_unit) then
-    Ftactic.return (str "()")
-  else if has_type v (topwit wit_int) then
-    Ftactic.return (int (out_gen (topwit wit_int) v))
-  else if has_type v (topwit wit_intro_pattern) then
-    let p = out_gen (topwit wit_intro_pattern) v in
-    let print env sigma c =
-      let (sigma, c) = c env sigma in
-      pr_econstr_env env sigma c
-    in
-    Ftactic.enter begin fun gl ->
-      Ftactic.return (Miscprint.pr_intro_pattern (fun c -> print (pf_env gl) (project gl) c) p)
-    end
-  else if has_type v (topwit wit_constr_context) then
-    let c = out_gen (topwit wit_constr_context) v in
-    Ftactic.enter begin fun gl -> Ftactic.return (pr_econstr_env (pf_env gl) (project gl) c) end
-  else if has_type v (topwit wit_uconstr) then
-    let c = out_gen (topwit wit_uconstr) v in
-    Ftactic.enter begin fun gl ->
-      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.enter begin fun gl -> Ftactic.return (Id.print id) end
-  else match Value.to_list v with
-  | Some l ->
-    Ftactic.List.map message_of_value l >>= fun l ->
-    Ftactic.return (prlist_with_sep spc (fun x -> x) l)
-  | None ->
-    let tag = pr_argument_type v in
-    Ftactic.return (str "<" ++ tag ++ str ">") (** TODO *)
+let message_of_value v =
+  let pr_with_env pr =
+    Ftactic.enter begin fun gl -> Ftactic.return (pr (pf_env gl) (project gl)) end in
+  let open Genprint in
+  match generic_val_print v with
+  | TopPrinterBasic pr -> Ftactic.return (pr ())
+  | TopPrinterNeedsContext pr -> pr_with_env pr
+  | TopPrinterNeedsContextAndLevel { default_ensure_surrounded; printer } ->
+     pr_with_env (fun env sigma -> printer env sigma default_ensure_surrounded)
 
 let interp_message_token ist = function
   | MsgString s -> Ftactic.return (str s)
   | MsgInt n -> Ftactic.return (int n)
-  | MsgIdent (loc,id) ->
+  | MsgIdent {loc;v=id} ->
     let v = try Some (Id.Map.find id ist.lfun) with Not_found -> None in
     match v with
     | None -> Ftactic.lift (Tacticals.New.tclZEROMSG (Id.print id ++ str" not found."))
@@ -927,8 +882,8 @@ let interp_intro_pattern_naming_option ist env sigma = function
 
 let interp_or_and_intro_pattern_option ist env sigma = function
   | None -> sigma, None
-  | Some (ArgVar (loc,id)) ->
-      (match coerce_to_intro_pattern env sigma (Id.Map.find id ist.lfun) with
+  | Some (ArgVar {loc;v=id}) ->
+      (match interp_intro_pattern_var loc ist env sigma id with
       | IntroAction (IntroOrAndPattern l) -> sigma, Some (loc,l)
       | _ ->
         user_err ?loc (str "Cannot coerce to a disjunctive/conjunctive pattern."))
@@ -946,31 +901,31 @@ let interp_in_hyp_as ist env sigma (id,ipat) =
   let sigma, ipat = interp_intro_pattern_option ist env sigma ipat in
   sigma,(interp_hyp ist env sigma id,ipat)
 
-let interp_binding_name ist sigma = function
+let interp_binding_name ist env sigma = function
   | AnonHyp n -> AnonHyp n
   | NamedHyp id ->
       (* If a name is bound, it has to be a quantified hypothesis *)
       (* user has to use other names for variables if these ones clash with *)
       (* a name intented to be used as a (non-variable) identifier *)
-      try try_interp_ltac_var (coerce_to_quantified_hypothesis sigma) ist None(Loc.tag id)
+      try try_interp_ltac_var (coerce_to_quantified_hypothesis sigma) ist (Some (env,sigma)) (make id)
       with Not_found -> NamedHyp id
 
 let interp_declared_or_quantified_hypothesis ist env sigma = function
   | AnonHyp n -> AnonHyp n
   | NamedHyp id ->
       try try_interp_ltac_var
-	    (coerce_to_decl_or_quant_hyp env sigma) ist (Some (env,sigma)) (Loc.tag id)
+            (coerce_to_decl_or_quant_hyp env sigma) ist (Some (env,sigma)) (make id)
       with Not_found -> NamedHyp id
 
 let interp_binding ist env sigma (loc,(b,c)) =
   let sigma, c = interp_open_constr ist env sigma c in
-  sigma, (loc,(interp_binding_name ist sigma b,c))
+  sigma, (loc,(interp_binding_name ist env sigma b,c))
 
 let interp_bindings ist env sigma = function
 | NoBindings ->
     sigma, NoBindings
 | ImplicitBindings l ->
-    let sigma, l = interp_open_constr_list ist env sigma l in   
+    let sigma, l = interp_open_constr_list ist env sigma l in
     sigma, ImplicitBindings l
 | ExplicitBindings l ->
     let sigma, l = List.fold_left_map (interp_binding ist env) sigma l in
@@ -1005,14 +960,14 @@ let interp_destruction_arg ist gl arg =
         interp_open_constr_with_bindings ist env sigma c
       end
   | keep,ElimOnAnonHyp n as x -> x
-  | keep,ElimOnIdent (loc,id) ->
+  | keep,ElimOnIdent {loc;v=id} ->
       let error () = user_err ?loc 
        (strbrk "Cannot coerce " ++ Id.print id ++
         strbrk " neither to a quantified hypothesis nor to a term.")
       in
       let try_cast_id id' =
         if Tactics.is_quantified_hypothesis id' gl
-        then keep,ElimOnIdent (loc,id')
+        then keep,ElimOnIdent CAst.(make ?loc id')
         else
           (keep, ElimOnConstr begin fun env sigma ->
           try (sigma, (constr_of_id env id', NoBindings))
@@ -1024,7 +979,6 @@ let interp_destruction_arg ist gl arg =
       try
         (** FIXME: should be moved to taccoerce *)
         let v = Id.Map.find id ist.lfun in
-        let v = Value.normalize v in
         if has_type v (topwit wit_intro_pattern) then
           let v = out_gen (topwit wit_intro_pattern) v in
           match v with
@@ -1041,9 +995,9 @@ let interp_destruction_arg ist gl arg =
       with Not_found ->
 	(* We were in non strict (interactive) mode *)
 	if Tactics.is_quantified_hypothesis id gl then
-          keep,ElimOnIdent (loc,id)
+          keep,ElimOnIdent CAst.(make ?loc id)
 	else
-          let c = (CAst.make ?loc @@ GVar id,Some (CAst.make @@ CRef (Ident (loc,id),None))) in
+          let c = (DAst.make ?loc @@ GVar id,Some (CAst.make @@ CRef (Ident (loc,id),None))) in
           let f env sigma =
             let (sigma,c) = interp_open_constr ist env sigma c in
             (sigma, (c,NoBindings))
@@ -1078,7 +1032,7 @@ let eval_pattern lfun ist env sigma (bvars,(glob,_),pat as c) =
     (bvars,instantiate_pattern env sigma lfun pat)
 
 let read_pattern lfun ist env sigma = function
-  | Subterm (b,ido,c) -> Subterm (b,ido,eval_pattern lfun ist env sigma c)
+  | Subterm (ido,c) -> Subterm (ido,eval_pattern lfun ist env sigma c)
   | Term c -> Term (eval_pattern lfun ist env sigma c)
 
 (* Reads the hypotheses of a Match Context rule *)
@@ -1090,11 +1044,11 @@ let cons_and_check_name id l =
   else id::l
 
 let rec read_match_goal_hyps lfun ist env sigma lidh = function
-  | (Hyp ((loc,na) as locna,mp))::tl ->
+  | (Hyp ({loc;v=na} as locna,mp))::tl ->
       let lidh' = Name.fold_right cons_and_check_name na lidh in
       Hyp (locna,read_pattern lfun ist env sigma mp)::
 	(read_match_goal_hyps lfun ist env sigma lidh' tl)
-  | (Def ((loc,na) as locna,mv,mp))::tl ->
+  | (Def ({loc;v=na} as locna,mv,mp))::tl ->
       let lidh' = Name.fold_right cons_and_check_name na lidh in
       Def (locna,read_pattern lfun ist env sigma mv, read_pattern lfun ist env sigma mp)::
 	(read_match_goal_hyps lfun ist env sigma lidh' tl)
@@ -1159,7 +1113,7 @@ let rec val_interp ist ?(appl=UnnamedAppl) (tac:glob_tactic_expr) : Val.t Ftacti
         in
 	Tactic_debug.debug_prompt lev tac eval
   | _ -> value_interp ist >>= fun v -> return (name_vfun appl v)
-      
+
 
 and eval_tactic ist tac : unit Proofview.tactic = match tac with
   | TacAtom (loc,t) ->
@@ -1196,10 +1150,14 @@ and eval_tactic ist tac : unit Proofview.tactic = match tac with
          Proofview.V82.tactic begin
            tclSHOWHYPS (Proofview.V82.of_tactic (interp_tactic ist tac))
          end
-  | TacAbstract (tac,ido) ->
+  | TacAbstract (t,ido) ->
+      let call = LtacMLCall tac in
+      push_trace(None,call) ist >>= fun trace ->
+      Profile_ltac.do_profile "eval_tactic:TacAbstract" trace
+        (catch_error_tac trace begin
       Proofview.Goal.enter begin fun gl -> Tactics.tclABSTRACT
-        (Option.map (interp_ident ist (pf_env gl) (project gl)) ido) (interp_tactic ist tac)
-      end
+        (Option.map (interp_ident ist (pf_env gl) (project gl)) ido) (interp_tactic ist t)
+      end end)
   | TacThen (t1,t) ->
       Tacticals.New.tclTHEN (interp_tactic ist t1) (interp_tactic ist t)
   | TacDispatch tl ->
@@ -1282,7 +1240,6 @@ and eval_tactic ist tac : unit Proofview.tactic = match tac with
       Ftactic.run args tac
 
 and force_vrec ist v : Val.t Ftactic.t =
-  let v = Value.normalize v in
   if has_type v (topwit wit_tacvalue) then
     let v = to_tacvalue v in
     match v with
@@ -1292,7 +1249,7 @@ and force_vrec ist v : Val.t Ftactic.t =
 
 and interp_ltac_reference ?loc' mustbetac ist r : Val.t Ftactic.t =
   match r with
-  | ArgVar (loc,id) ->
+  | ArgVar {loc;v=id} ->
       let v =
         try Id.Map.find id ist.lfun
         with Not_found -> in_gen (topwit wit_var) id
@@ -1303,14 +1260,15 @@ and interp_ltac_reference ?loc' mustbetac ist r : Val.t Ftactic.t =
       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 ids = extract_ids [] ist.lfun Id.Set.empty in
       let loc_info = (Option.default loc loc',LtacNameCall r) 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)
+      Profile_ltac.do_profile "interp_ltac_reference" trace ~count_call:false
+        (val_interp ~appl ist (Tacenv.interp_ltac r))
 
 and interp_tacarg ist arg : Val.t Ftactic.t =
   match arg with
@@ -1357,7 +1315,6 @@ and interp_tacarg ist arg : Val.t Ftactic.t =
 and interp_app loc ist fv largs : Val.t Ftactic.t =
   let (>>=) = Ftactic.bind in
   let fail = Tacticals.New.tclZEROMSG (str "Illegal tactic application.") in
-  let fv = Value.normalize fv in
   if has_type fv (topwit wit_tacvalue) then
   match to_tacvalue fv with
      (* if var=[] and body has been delayed by val_interp, then body
@@ -1376,7 +1333,8 @@ and interp_app loc ist fv largs : Val.t Ftactic.t =
               let ist = {
                 lfun = newlfun;
                 extra = TacStore.set ist.extra f_trace []; } in
-              catch_error_tac trace (val_interp ist body) >>= fun v ->
+              Profile_ltac.do_profile "interp_app" trace ~count_call:false
+                (catch_error_tac trace (val_interp ist body)) >>= fun v ->
               Ftactic.return (name_vfun (push_appl appl largs) v)
             end
 	    begin fun (e, info) ->
@@ -1386,20 +1344,29 @@ and interp_app loc ist fv largs : Val.t Ftactic.t =
         end >>= fun v ->
         (* No errors happened, we propagate the trace *)
         let v = append_trace trace v in
-        Proofview.tclLIFT begin
-          debugging_step ist
-	    (fun () ->
-	      str"evaluation returns"++fnl()++pr_value None v)
+        let call_debug env =
+          Proofview.tclLIFT (debugging_step ist (fun () -> str"evaluation returns"++fnl()++pr_value env v)) in
+        begin
+          let open Genprint in
+          match generic_val_print v with
+          | TopPrinterBasic _ -> call_debug None
+          | TopPrinterNeedsContext _ | TopPrinterNeedsContextAndLevel _ ->
+             Proofview.Goal.enter (fun gl -> call_debug (Some (pf_env gl,project gl)))
         end <*>
         if List.is_empty lval then Ftactic.return v else interp_app loc ist v lval
       else
         Ftactic.return (of_tacvalue (VFun(push_appl appl largs,trace,newlfun,lvar,body)))
-    | _ -> fail
+    | (VFun(appl,trace,olfun,[],body)) ->
+      let extra_args = List.length largs in
+      Tacticals.New.tclZEROMSG (str "Illegal tactic application: got " ++
+                                str (string_of_int extra_args) ++
+                                str " extra " ++ str (String.plural extra_args "argument") ++
+                                str ".")
+    | VRec(_,_) -> fail
   else fail
 
 (* Gives the tactic corresponding to the tactic value *)
 and tactic_of_value ist vle =
-  let vle = Value.normalize vle in
   if has_type vle (topwit wit_tacvalue) then
   match to_tacvalue vle with
   | VFun (appl,trace,lfun,[],t) ->
@@ -1408,13 +1375,38 @@ and tactic_of_value ist vle =
         extra = TacStore.set ist.extra f_trace []; } in
       let tac = name_if_glob appl (eval_tactic ist t) in
       Profile_ltac.do_profile "tactic_of_value" trace (catch_error_tac trace tac)
-  | VFun (_, _, _,vars,_) ->
-    let numargs = List.length vars in
-    Tacticals.New.tclZEROMSG
-      (str "A fully applied tactic is expected:" ++ spc() ++ Pp.str "missing " ++
-       Pp.str (String.plural numargs "argument") ++ Pp.str " for " ++
-       Pp.str (String.plural numargs "variable") ++ Pp.str " " ++
-       pr_enum Name.print vars ++ Pp.str ".")
+  | VFun (appl,_,vmap,vars,_) ->
+     let tactic_nm =
+       match appl with
+         UnnamedAppl -> "An unnamed user-defined tactic"
+       | GlbAppl apps ->
+          let nms = List.map (fun (kn,_) -> Names.KerName.to_string kn) apps in
+          match nms with
+            []    -> assert false
+          | kn::_ -> "The user-defined tactic \"" ^ kn ^ "\"" (* TODO: when do we not have a singleton? *)
+     in
+     let numargs = List.length vars in
+     let givenargs =
+       List.map (fun (arg,_) -> Names.Id.to_string arg) (Names.Id.Map.bindings vmap) in
+     let numgiven = List.length givenargs in
+     Tacticals.New.tclZEROMSG
+       (Pp.str tactic_nm ++ Pp.str " was not fully applied:" ++ spc() ++
+          (match numargs with
+            0 -> assert false
+          | 1 ->
+             Pp.str "There is a missing argument for variable " ++
+               (Name.print (List.hd vars))
+          | _ -> Pp.str "There are missing arguments for variables " ++
+             pr_enum Name.print vars) ++ Pp.pr_comma () ++
+          match numgiven with
+            0 ->
+              Pp.str "no arguments at all were provided."
+          | 1 ->
+             Pp.str "an argument was provided for variable " ++
+               Pp.str (List.hd givenargs) ++ Pp.str "."
+          | _ ->
+             Pp.str "arguments were provided for variables " ++
+               pr_enum Pp.str givenargs ++ Pp.str ".")
   | 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
@@ -1425,9 +1417,9 @@ and tactic_of_value ist vle =
 and interp_letrec ist llc u =
   Proofview.tclUNIT () >>= fun () -> (* delay for the effects of [lref], just in case. *)
   let lref = ref ist.lfun in
-  let fold accu ((_, id), b) =
+  let fold accu ({v=na}, b) =
     let v = of_tacvalue (VRec (lref, TacArg (Loc.tag b))) in
-    Id.Map.add id v accu
+    Name.fold_right (fun id -> Id.Map.add id v) na accu
   in
   let lfun = List.fold_left fold ist.lfun llc in
   let () = lref := lfun in
@@ -1440,9 +1432,9 @@ and interp_letin ist llc u =
   | [] ->
     let ist = { ist with lfun } in
     val_interp ist u
-  | ((_, id), body) :: defs ->
+  | ({v=na}, body) :: defs ->
     Ftactic.bind (interp_tacarg ist body) (fun v ->
-    fold (Id.Map.add id v lfun) defs)
+    fold (Name.fold_right (fun id -> Id.Map.add id v) na lfun) defs)
   in
   fold ist.lfun llc
 
@@ -1601,7 +1593,6 @@ and interp_ltac_constr ist e : EConstr.t Ftactic.t =
   Ftactic.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = project gl in
-  let result = Value.normalize result in
   try
     let cresult = coerce_to_closed_constr env result in
     Proofview.tclLIFT begin
@@ -1956,7 +1947,7 @@ let interp_tac_gen lfun avoid_ids debug t =
     (intern_pure_tactic { (Genintern.empty_glob_sign env) with ltacvars } t)
   end
 
-let interp t = interp_tac_gen Id.Map.empty [] (get_debug()) t
+let interp t = interp_tac_gen Id.Map.empty Id.Set.empty (get_debug()) t
 
 (* Used to hide interpretation for pretty-print, now just launch tactics *)
 (* [global] means that [t] should be internalized outside of goals. *)
diff --git a/plugins/ltac/tacinterp.mli b/plugins/ltac/tacinterp.mli
index c1ab2b4c4..2d448e832 100644
--- a/plugins/ltac/tacinterp.mli
+++ b/plugins/ltac/tacinterp.mli
@@ -40,11 +40,11 @@ type interp_sign = Geninterp.interp_sign = {
   lfun : value Id.Map.t;
   extra : TacStore.t }
 
-val f_avoid_ids : Id.t list TacStore.field
+val f_avoid_ids : Id.Set.t TacStore.field
 val f_debug : debug_info TacStore.field
 
 val extract_ltac_constr_values : interp_sign -> Environ.env ->
-  Pattern.constr_under_binders Id.Map.t
+  Ltac_pretype.constr_under_binders Id.Map.t
 (** Given an interpretation signature, extract all values which are coercible to
     a [constr]. *)
 
@@ -57,7 +57,7 @@ val get_debug : unit -> debug_info
 val type_uconstr :
   ?flags:Pretyping.inference_flags ->
   ?expected_type:Pretyping.typing_constraint ->
-  Geninterp.interp_sign -> Glob_term.closed_glob_constr -> constr Tactypes.delayed_open
+  Geninterp.interp_sign -> Ltac_pretype.closed_glob_constr -> constr Tactypes.delayed_open
 
 (** Adds an interpretation function for extra generic arguments *)
 
@@ -75,14 +75,14 @@ val interp_redexp : Environ.env -> Evd.evar_map -> raw_red_expr -> Evd.evar_map
 (** Interprets tactic expressions *)
 
 val interp_hyp : interp_sign -> Environ.env -> Evd.evar_map ->
-  Id.t Loc.located -> Id.t
+  lident -> Id.t
 
 val interp_glob_closure : interp_sign -> Environ.env -> Evd.evar_map ->
   ?kind:Pretyping.typing_constraint -> ?pattern_mode:bool -> glob_constr_and_expr ->
-  Glob_term.closed_glob_constr
+  Ltac_pretype.closed_glob_constr
 
 val interp_uconstr : interp_sign -> Environ.env -> Evd.evar_map ->
-  glob_constr_and_expr -> Glob_term.closed_glob_constr
+  glob_constr_and_expr -> Ltac_pretype.closed_glob_constr
 
 val interp_constr_gen : Pretyping.typing_constraint -> interp_sign ->
   Environ.env -> Evd.evar_map -> glob_constr_and_expr -> Evd.evar_map * constr
@@ -113,7 +113,7 @@ val tactic_of_value : interp_sign -> Value.t -> unit Proofview.tactic
 
 (** Globalization + interpretation *)
 
-val interp_tac_gen : value Id.Map.t -> Id.t list ->
+val interp_tac_gen : value Id.Map.t -> Id.Set.t ->
                  debug_info -> raw_tactic_expr -> unit Proofview.tactic
 
 val interp : raw_tactic_expr -> unit Proofview.tactic
@@ -125,9 +125,9 @@ val hide_interp : bool -> raw_tactic_expr -> unit Proofview.tactic option -> uni
 (** Internals that can be useful for syntax extensions. *)
 
 val interp_ltac_var : (value -> 'a) -> interp_sign ->
-  (Environ.env * Evd.evar_map) option -> Id.t Loc.located -> 'a
+  (Environ.env * Evd.evar_map) option -> lident -> 'a
 
-val interp_int : interp_sign -> Id.t Loc.located -> int
+val interp_int : interp_sign -> lident -> int
 
 val interp_int_or_var : interp_sign -> int or_var -> int
 
diff --git a/plugins/ltac/tacsubst.ml b/plugins/ltac/tacsubst.ml
index 180fb2db4..79bf3685e 100644
--- a/plugins/ltac/tacsubst.ml
+++ b/plugins/ltac/tacsubst.ml
@@ -91,9 +91,10 @@ let subst_global_reference subst =
  let subst_global ref =
   let ref',t' = subst_global subst ref in
    if not (is_global ref' t') then
-    Feedback.msg_warning (strbrk "The reference " ++ pr_global ref ++ str " is not " ++
-          str " expanded to \"" ++ pr_lconstr t' ++ str "\", but to " ++
-          pr_global ref') ;
+    (let sigma, env = Pfedit.get_current_context () in
+     Feedback.msg_warning (strbrk "The reference " ++ pr_global ref ++ str " is not " ++
+          str " expanded to \"" ++ pr_lconstr_env env sigma t' ++ str "\", but to " ++
+          pr_global ref'));
    ref'
  in
   subst_or_var (subst_located subst_global)
@@ -120,7 +121,7 @@ let subst_raw_may_eval subst = function
   | ConstrTerm c -> ConstrTerm (subst_glob_constr subst c)
 
 let subst_match_pattern subst = function
-  | Subterm (b,ido,pc) -> Subterm (b,ido,(subst_glob_constr_or_pattern subst pc))
+  | Subterm (ido,pc) -> Subterm (ido,(subst_glob_constr_or_pattern subst pc))
   | Term pc -> Term (subst_glob_constr_or_pattern subst pc)
 
 let rec subst_match_goal_hyps subst = function
diff --git a/plugins/ltac/tactic_debug.ml b/plugins/ltac/tactic_debug.ml
index 5394b1e11..2dd7c9a74 100644
--- a/plugins/ltac/tactic_debug.ml
+++ b/plugins/ltac/tactic_debug.ml
@@ -20,7 +20,9 @@ let prmatchpatt env sigma hyp =
   Pptactic.pr_match_pattern (Printer.pr_constr_pattern_env env sigma) hyp
 let prmatchrl rl =
   Pptactic.pr_match_rule false (Pptactic.pr_glob_tactic (Global.env()))
-    (fun (_,p) -> Printer.pr_constr_pattern p) rl
+    (fun (_,p) ->
+       let sigma, env = Pfedit.get_current_context () in
+       Printer.pr_constr_pattern_env env sigma p) rl
 
 (* This module intends to be a beginning of debugger for tactic expressions.
    Currently, it is quite simple and we can hope to have, in the future, a more
@@ -363,13 +365,14 @@ let explain_ltac_call_trace last trace loc =
   | Tacexpr.LtacAtomCall te ->
       quote (Pptactic.pr_glob_tactic (Global.env())
               (Tacexpr.TacAtom (Loc.tag te)))
-  | Tacexpr.LtacConstrInterp (c, { Glob_term.ltac_constrs = vars }) ->
+  | Tacexpr.LtacConstrInterp (c, { Ltac_pretype.ltac_constrs = vars }) ->
       quote (Printer.pr_glob_constr_env (Global.env()) c) ++
         (if not (Id.Map.is_empty vars) then
           strbrk " (with " ++
             prlist_with_sep pr_comma
             (fun (id,c) ->
-                Id.print id ++ str ":=" ++ Printer.pr_lconstr_under_binders c)
+              let sigma, env = Pfedit.get_current_context () in
+              Id.print id ++ str ":=" ++ Printer.pr_lconstr_under_binders_env env sigma c)
             (List.rev (Id.Map.bindings vars)) ++ str ")"
         else mt())
   in
diff --git a/plugins/ltac/tactic_debug.mli b/plugins/ltac/tactic_debug.mli
index 2475e41f9..dce6f5558 100644
--- a/plugins/ltac/tactic_debug.mli
+++ b/plugins/ltac/tactic_debug.mli
@@ -74,7 +74,7 @@ val db_logic_failure : debug_info -> exn -> unit Proofview.NonLogical.t
 
 (** Prints a logic failure message for a rule *)
 val db_breakpoint : debug_info ->
-  Id.t Loc.located message_token list -> unit Proofview.NonLogical.t
+  Misctypes.lident message_token list -> unit Proofview.NonLogical.t
 
 val extract_ltac_trace :
   ?loc:Loc.t -> Tacexpr.ltac_trace -> Pp.t option Loc.located
diff --git a/plugins/ltac/tactic_matching.ml b/plugins/ltac/tactic_matching.ml
index 63b8cc482..6bf9215e0 100644
--- a/plugins/ltac/tactic_matching.ml
+++ b/plugins/ltac/tactic_matching.ml
@@ -22,7 +22,7 @@ module NamedDecl = Context.Named.Declaration
     those of {!Matching.matching_result}), and a {!Term.constr}
     substitution mapping corresponding to matched hypotheses. *)
 type 'a t = {
-  subst : Constr_matching.bound_ident_map * Pattern.extended_patvar_map ;
+  subst : Constr_matching.bound_ident_map * Ltac_pretype.extended_patvar_map ;
   context : EConstr.constr Id.Map.t;
   terms : EConstr.constr Id.Map.t;
   lhs : 'a;
@@ -36,8 +36,8 @@ type 'a t = {
 (** Some of the functions of {!Matching} return the substitution with a
     [patvar_map] instead of an [extended_patvar_map]. [adjust] coerces
     substitution of the former type to the latter. *)
-let adjust : Constr_matching.bound_ident_map * Pattern.patvar_map ->
-             Constr_matching.bound_ident_map * Pattern.extended_patvar_map =
+let adjust : Constr_matching.bound_ident_map * Ltac_pretype.patvar_map ->
+             Constr_matching.bound_ident_map * Ltac_pretype.extended_patvar_map =
   fun (l, lc) -> (l, Id.Map.map (fun c -> [], c) lc)
 
 
@@ -203,7 +203,7 @@ module PatternMatching (E:StaticEnvironment) = struct
 
   let pick l = pick l imatching_error
 
-  (** Declares a subsitution, a context substitution and a term substitution. *)
+  (** Declares a substitution, a context substitution and a term substitution. *)
   let put subst context terms : unit m =
     let s = { subst ; context ; terms ; lhs = () } in
     { stream = fun k ctx -> match merge s ctx with None -> Proofview.tclZERO matching_error | Some s -> k () s }
@@ -237,7 +237,7 @@ module PatternMatching (E:StaticEnvironment) = struct
             return lhs
           with Constr_matching.PatternMatchingFailure -> fail
         end
-    | Subterm (with_app_context,id_ctxt,p) ->
+    | Subterm (id_ctxt,p) ->
 
       let rec map s (e, info) =
         { stream = fun k ctx -> match IStream.peek s with
@@ -252,7 +252,7 @@ module PatternMatching (E:StaticEnvironment) = struct
             | Some nctx -> Proofview.tclOR (k lhs nctx) (fun e -> (map s e).stream k ctx)
         }
       in
-      map (Constr_matching.match_subterm_gen E.env E.sigma with_app_context p term) imatching_error
+      map (Constr_matching.match_subterm E.env E.sigma p term) imatching_error
 
 
   (** [rule_match_term term rule] matches the term [term] with the
@@ -306,9 +306,9 @@ module PatternMatching (E:StaticEnvironment) = struct
       [pat] is [Hyp _] or [Def _]. *)
   let hyp_match pat hyps =
     match pat with
-    | Hyp ((_,hypname),typepat) ->
+    | Hyp ({CAst.v=hypname},typepat) ->
         hyp_match_type hypname typepat hyps
-    | Def ((_,hypname),bodypat,typepat) ->
+    | Def ({CAst.v=hypname},bodypat,typepat) ->
         hyp_match_body_and_type hypname bodypat typepat hyps
 
   (** [hyp_pattern_list_match pats hyps lhs], matches the list of
diff --git a/plugins/ltac/tactic_matching.mli b/plugins/ltac/tactic_matching.mli
index 01334d36c..955f8105f 100644
--- a/plugins/ltac/tactic_matching.mli
+++ b/plugins/ltac/tactic_matching.mli
@@ -18,7 +18,7 @@
     those of {!Matching.matching_result}), and a {!Term.constr}
     substitution mapping corresponding to matched hypotheses. *)
 type 'a t = {
-  subst : Constr_matching.bound_ident_map * Pattern.extended_patvar_map ;
+  subst : Constr_matching.bound_ident_map * Ltac_pretype.extended_patvar_map ;
   context : EConstr.constr Names.Id.Map.t;
   terms : EConstr.constr Names.Id.Map.t;
   lhs : 'a;
diff --git a/plugins/ltac/tauto.ml b/plugins/ltac/tauto.ml
index 01d3f79c7..5ce30c3d7 100644
--- a/plugins/ltac/tauto.ml
+++ b/plugins/ltac/tauto.ml
@@ -255,10 +255,10 @@ let tauto_power_flags = {
 }
 
 let with_flags flags _ ist =
-  let f = (Loc.tag @@ Id.of_string "f") in
-  let x = (Loc.tag @@ Id.of_string "x") in
+  let f = CAst.make @@ Id.of_string "f" in
+  let x = CAst.make @@ Id.of_string "x" in
   let arg = Val.Dyn (tag_tauto_flags, flags) in
-  let ist = { ist with lfun = Id.Map.add (snd x) arg ist.lfun } in
+  let ist = { ist with lfun = Id.Map.add x.CAst.v arg ist.lfun } in
   eval_tactic_ist ist (TacArg (Loc.tag @@ TacCall (Loc.tag (ArgVar f, [Reference (ArgVar x)]))))
 
 let register_tauto_tactic tac name0 args =
diff --git a/plugins/micromega/EnvRing.v b/plugins/micromega/EnvRing.v
index 56b3d480e..ae4857a77 100644
--- a/plugins/micromega/EnvRing.v
+++ b/plugins/micromega/EnvRing.v
@@ -56,10 +56,18 @@ Section MakeRingPol.
  Infix "?=!" := ceqb. Notation "[ x ]" := (phi x).
 
  (* Useful tactics *)
- Add Morphism radd : radd_ext. exact (Radd_ext Reqe). Qed.
- Add Morphism rmul : rmul_ext. exact (Rmul_ext Reqe). Qed.
- Add Morphism ropp : ropp_ext. exact (Ropp_ext Reqe). Qed.
- Add Morphism rsub : rsub_ext. exact (ARsub_ext Rsth Reqe ARth). Qed.
+ Add Morphism radd with signature (req ==> req ==> req) as radd_ext.
+ Proof. exact (Radd_ext Reqe). Qed.
+
+ Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext.
+ Proof. exact (Rmul_ext Reqe). Qed.
+
+ Add Morphism ropp with signature (req ==> req) as ropp_ext.
+ Proof. exact (Ropp_ext Reqe). Qed.
+
+ Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext.
+ Proof. exact (ARsub_ext Rsth Reqe ARth). Qed.
+
  Ltac rsimpl := gen_srewrite Rsth Reqe ARth.
 
  Ltac add_push := gen_add_push radd Rsth Reqe ARth.
diff --git a/plugins/micromega/MExtraction.v b/plugins/micromega/MExtraction.v
index e5b5854f0..362cc3a59 100644
--- a/plugins/micromega/MExtraction.v
+++ b/plugins/micromega/MExtraction.v
@@ -49,16 +49,13 @@ Extract Constant Rmult => "( * )".
 Extract Constant Ropp  => "fun x -> - x".
 Extract Constant Rinv   => "fun x -> 1 / x".
 
-(** We now extract to stdout, see comment in Makefile.build *)
-
-(*Extraction "plugins/micromega/micromega.ml" *)
-Recursive Extraction
-  List.map simpl_cone (*map_cone  indexes*)
-  denorm Qpower vm_add
-  n_of_Z N.of_nat ZTautoChecker ZWeakChecker QTautoChecker RTautoChecker find.
-
-
-
+(** In order to avoid annoying build dependencies the actual
+    extraction is only performed as a test in the test suite. *)
+(* Extraction "plugins/micromega/micromega.ml" *)
+(* Recursive Extraction *)
+(*   List.map simpl_cone (*map_cone  indexes*) *)
+(*   denorm Qpower vm_add *)
+(*   n_of_Z N.of_nat ZTautoChecker ZWeakChecker QTautoChecker RTautoChecker find. *)
 
 (* Local Variables: *)
 (* coding: utf-8 *)
diff --git a/plugins/micromega/coq_micromega.ml b/plugins/micromega/coq_micromega.ml
index a4103634e..cb54cac3f 100644
--- a/plugins/micromega/coq_micromega.ml
+++ b/plugins/micromega/coq_micromega.ml
@@ -20,6 +20,7 @@ open Pp
 open Mutils
 open Goptions
 open Names
+open Constr
 
 (**
   * Debug flag 
@@ -580,9 +581,9 @@ struct
     | Ukn
     | BadStr of string
     | BadNum of int
-    | BadTerm of Term.constr
+    | BadTerm of constr
     | Msg   of string
-    | Goal of (Term.constr list ) * Term.constr * parse_error
+    | Goal of (constr list ) * constr * parse_error
 
   let string_of_error = function
    | Ukn -> "ukn"
@@ -983,7 +984,9 @@ struct
 
   let parse_expr sigma parse_constant parse_exp ops_spec env term =
     if debug
-    then Feedback.msg_debug (Pp.str "parse_expr: " ++ Printer.pr_leconstr term);
+    then (
+      let _, env = Pfedit.get_current_context () in
+      Feedback.msg_debug (Pp.str "parse_expr: " ++ Printer.pr_leconstr_env env sigma term));
 
 (*
     let constant_or_variable env term =
@@ -1102,9 +1105,10 @@ struct
     |  _ -> raise ParseError
 
 
-  let rconstant sigma term = 
+  let rconstant sigma term =
+    let _, env = Pfedit.get_current_context () in
     if debug
-    then Feedback.msg_debug (Pp.str "rconstant: " ++ Printer.pr_leconstr term ++ fnl ());
+    then Feedback.msg_debug (Pp.str "rconstant: " ++ Printer.pr_leconstr_env env sigma term ++ fnl ());
     let res = rconstant sigma term in
       if debug then 
 	(Printf.printf "rconstant -> %a\n" pp_Rcst res ; flush stdout) ;
@@ -1144,9 +1148,9 @@ struct
 
   let  parse_arith parse_op parse_expr env cstr gl =
     let sigma = gl.sigma in
-   if debug
-   then Feedback.msg_debug (Pp.str "parse_arith: " ++ Printer.pr_leconstr cstr ++ fnl ());
-   match EConstr.kind sigma cstr with
+    if debug
+    then Feedback.msg_debug (Pp.str "parse_arith: " ++ Printer.pr_leconstr_env gl.env sigma cstr ++ fnl ());
+    match EConstr.kind sigma cstr with
     | Term.App(op,args) ->
        let (op,lhs,rhs) = parse_op gl (op,args) in
        let (e1,env) = parse_expr sigma env lhs in
@@ -1521,7 +1525,7 @@ let rec witness prover   l1 l2 =
 let rec apply_ids t ids =
  match ids with
   | [] -> t
-  | i::ids -> apply_ids (Term.mkApp(t,[| Term.mkVar i |])) ids
+  | i::ids -> apply_ids (mkApp(t,[| mkVar i |])) ids
 
 let coq_Node = 
  lazy (gen_constant_in_modules "VarMap"
@@ -1907,7 +1911,7 @@ let micromega_tauto negate normalise unsat deduce spec prover env polys1 polys2
      let formula_typ = (EConstr.mkApp(Lazy.force coq_Cstr, [|spec.coeff|])) in
      let ff = dump_formula formula_typ
        (dump_cstr spec.typ spec.dump_coeff) ff in
-       Feedback.msg_notice (Printer.pr_leconstr ff);
+       Feedback.msg_notice (Printer.pr_leconstr_env gl.env gl.sigma ff);
        Printf.fprintf stdout "cnf : %a\n" (pp_cnf (fun o _ -> ())) cnf_ff
    end;
 
@@ -1931,9 +1935,9 @@ let micromega_tauto negate normalise unsat deduce spec prover env polys1 polys2
       Feedback.msg_notice (Pp.str "\nAFormula\n") ;
       let formula_typ = (EConstr.mkApp( Lazy.force coq_Cstr,[| spec.coeff|])) in
       let ff' = dump_formula formula_typ
-        (dump_cstr spec.typ spec.dump_coeff) ff' in
-        Feedback.msg_notice (Printer.pr_leconstr ff');
-        Printf.fprintf stdout "cnf : %a\n" (pp_cnf (fun o _ -> ())) cnf_ff'
+          (dump_cstr spec.typ spec.dump_coeff) ff' in
+      Feedback.msg_notice (Printer.pr_leconstr_env gl.env gl.sigma ff');
+      Printf.fprintf stdout "cnf : %a\n" (pp_cnf (fun o _ -> ())) cnf_ff'
     end;
 
   (* Even if it does not work, this does not mean it is not provable
@@ -1986,7 +1990,7 @@ let micromega_gen
        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.tag @@ Misctypes.IntroNaming (Misctypes.IntroIdentifier id)) in
-       let goal_name = fresh_id [] (Names.Id.of_string "__arith") gl in
+       let goal_name = fresh_id Id.Set.empty (Names.Id.of_string "__arith") gl in
        let env' = List.map (fun (id,i) -> EConstr.mkVar id,i) vars in 
 
        let tac_arith = Tacticals.New.tclTHENLIST [ intro_props ; intro_vars ; 
@@ -2101,7 +2105,7 @@ let micromega_genr prover tac =
        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.tag @@ Misctypes.IntroNaming (Misctypes.IntroIdentifier id)) in
-       let goal_name = fresh_id [] (Names.Id.of_string "__arith") gl in
+       let goal_name = fresh_id Id.Set.empty (Names.Id.of_string "__arith") gl in
        let env' = List.map (fun (id,i) -> EConstr.mkVar id,i) vars in 
        
        let tac_arith = Tacticals.New.tclTHENLIST [ intro_props ; intro_vars ; 
diff --git a/plugins/micromega/g_micromega.ml4 b/plugins/micromega/g_micromega.ml4
index b15dd7ae6..9f1d83f96 100644
--- a/plugins/micromega/g_micromega.ml4
+++ b/plugins/micromega/g_micromega.ml4
@@ -14,8 +14,6 @@
 (*                                                                      *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Ltac_plugin
 open Stdarg
 open Tacarg
diff --git a/plugins/micromega/micromega.ml b/plugins/micromega/micromega.ml
index 7da4a3b82..52c6ef983 100644
--- a/plugins/micromega/micromega.ml
+++ b/plugins/micromega/micromega.ml
@@ -981,8 +981,8 @@ let rec or_cnf unsat deduce f f' =
 
 (** val and_cnf : 'a1 cnf -> 'a1 cnf -> 'a1 cnf **)
 
-let and_cnf f1 f2 =
-  app f1 f2
+let and_cnf =
+  app
 
 (** val xcnf :
     ('a2 -> bool) -> ('a2 -> 'a2 -> 'a2 option) -> ('a1 -> 'a2 cnf) -> ('a1
@@ -1204,22 +1204,22 @@ type 't formula = { flhs : 't pExpr; fop : op2; frhs : 't pExpr }
     '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
+let norm =
+  norm_aux
 
 (** val psub0 :
     '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
+let psub0 =
+  psub
 
 (** val padd0 :
     'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> bool) -> 'a1 pol -> 'a1 pol
     -> 'a1 pol **)
 
-let padd0 cO cplus ceqb =
-  padd cO cplus ceqb
+let padd0 =
+  padd
 
 (** val xnormalise :
     'a1 -> 'a1 -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1 -> 'a1) -> ('a1 -> 'a1
diff --git a/plugins/micromega/persistent_cache.ml b/plugins/micromega/persistent_cache.ml
index 49ccb468c..387a52514 100644
--- a/plugins/micromega/persistent_cache.ml
+++ b/plugins/micromega/persistent_cache.ml
@@ -149,7 +149,7 @@ let open_in f =
     match read_key_elem inch with
       | None -> ()
       | Some (key,elem) ->
-	  Table.add htbl key elem ;
+          Table.replace htbl key elem ;
 	  xload () in
     try
       (* Locking of the (whole) file while reading *)
@@ -195,7 +195,7 @@ let add t k e =
     else
       let fd = descr_of_out_channel outch in
       begin
-       Table.add tbl k e ;
+       Table.replace tbl k e ;
        do_under_lock Write fd 
         (fun _ -> 
          Marshal.to_channel outch (k,e) [Marshal.No_sharing] ;
diff --git a/plugins/nsatz/g_nsatz.ml4 b/plugins/nsatz/g_nsatz.ml4
index 01c3d7940..272d4a20f 100644
--- a/plugins/nsatz/g_nsatz.ml4
+++ b/plugins/nsatz/g_nsatz.ml4
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Ltac_plugin
 
 DECLARE PLUGIN "nsatz_plugin"
diff --git a/plugins/nsatz/nsatz.ml b/plugins/nsatz/nsatz.ml
index 72934a15d..559dfab52 100644
--- a/plugins/nsatz/nsatz.ml
+++ b/plugins/nsatz/nsatz.ml
@@ -8,7 +8,7 @@
 
 open CErrors
 open Util
-open Term
+open Constr
 open Tactics
 open Coqlib
 
@@ -204,42 +204,42 @@ else
     mkt_app ttpow [Lazy.force tz; mkt_term t1; mkt_n (num_of_int n)]
 
 let rec parse_pos p =
-  match kind_of_term p with
+  match Constr.kind p with
 | App (a,[|p2|]) ->
-    if eq_constr a (Lazy.force pxO) then num_2 */ (parse_pos p2)
+    if Constr.equal a (Lazy.force pxO) then num_2 */ (parse_pos p2)
     else num_1 +/ (num_2 */ (parse_pos p2))
 | _ -> num_1
 
 let parse_z z =
-  match kind_of_term z with
+  match Constr.kind z with
 | App (a,[|p2|]) ->
-    if eq_constr a (Lazy.force zpos) then parse_pos p2 else (num_0 -/ (parse_pos p2))
+    if Constr.equal a (Lazy.force zpos) then parse_pos p2 else (num_0 -/ (parse_pos p2))
 | _ -> num_0
 
 let parse_n z =
-  match kind_of_term z with
+  match Constr.kind z with
 | App (a,[|p2|]) ->
     parse_pos p2
 | _ -> num_0
 
 let rec parse_term p =
-  match kind_of_term p with
+  match Constr.kind p with
 | App (a,[|_;p2|]) ->
-    if eq_constr a (Lazy.force ttvar) then Var (string_of_num (parse_pos p2))
-    else if eq_constr a (Lazy.force ttconst) then Const (parse_z p2)
-    else if eq_constr a (Lazy.force ttopp) then Opp (parse_term p2)
+    if Constr.equal a (Lazy.force ttvar) then Var (string_of_num (parse_pos p2))
+    else if Constr.equal a (Lazy.force ttconst) then Const (parse_z p2)
+    else if Constr.equal a (Lazy.force ttopp) then Opp (parse_term p2)
     else Zero
 | App (a,[|_;p2;p3|]) ->
-    if eq_constr a (Lazy.force ttadd) then Add (parse_term p2, parse_term p3)
-    else if eq_constr a (Lazy.force ttsub) then Sub (parse_term p2, parse_term p3)
-    else if eq_constr a (Lazy.force ttmul) then Mul (parse_term p2, parse_term p3)
-    else if eq_constr a (Lazy.force ttpow) then
+    if Constr.equal a (Lazy.force ttadd) then Add (parse_term p2, parse_term p3)
+    else if Constr.equal a (Lazy.force ttsub) then Sub (parse_term p2, parse_term p3)
+    else if Constr.equal a (Lazy.force ttmul) then Mul (parse_term p2, parse_term p3)
+    else if Constr.equal a (Lazy.force ttpow) then
       Pow (parse_term p2, int_of_num (parse_n p3))
     else Zero
 | _ -> Zero
 
 let rec parse_request lp =
-  match kind_of_term lp with
+  match Constr.kind lp with
     | App (_,[|_|])  -> []
     | App (_,[|_;p;lp1|])  ->
 	(parse_term p)::(parse_request lp1)
diff --git a/plugins/nsatz/nsatz.mli b/plugins/nsatz/nsatz.mli
index d6e3071aa..e50a12a50 100644
--- a/plugins/nsatz/nsatz.mli
+++ b/plugins/nsatz/nsatz.mli
@@ -6,4 +6,4 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-val nsatz_compute : Term.constr -> unit Proofview.tactic
+val nsatz_compute : Constr.t -> unit Proofview.tactic
diff --git a/plugins/omega/PreOmega.v b/plugins/omega/PreOmega.v
index 8da45e0ad..93103e026 100644
--- a/plugins/omega/PreOmega.v
+++ b/plugins/omega/PreOmega.v
@@ -26,7 +26,7 @@ Local Open Scope Z_scope.
      - on Z: Z.min, Z.max, Z.abs, Z.sgn are translated in term of <= < =
      - on nat: + * - S O pred min max Pos.to_nat N.to_nat Z.abs_nat
      - on positive: Zneg Zpos xI xO xH + * - Pos.succ Pos.pred Pos.min Pos.max Pos.of_succ_nat
-     - on N: N0 Npos + * - N.succ N.min N.max N.of_nat Z.abs_N
+     - on N: N0 Npos + * - N.pred N.succ N.min N.max N.of_nat Z.abs_N
 *)
 
 
@@ -391,6 +391,10 @@ Ltac zify_N_op :=
   | H : context [ Z.of_N (N.sub ?a ?b) ] |- _ => rewrite (N2Z.inj_sub_max a b) in H
   | |- context [ Z.of_N (N.sub ?a ?b) ] => rewrite (N2Z.inj_sub_max a b)
 
+  (* pred -> minus ... -1 -> Z.max (Z.sub ... -1) 0 *)
+  | H : context [ Z.of_N (N.pred ?a) ] |- _ => rewrite (N.pred_sub a) in H
+  | |- context [ Z.of_N (N.pred ?a) ] => rewrite (N.pred_sub a)
+
   (* N.succ -> Z.succ *)
   | H : context [ Z.of_N (N.succ ?a) ] |- _ => rewrite (N2Z.inj_succ a) in H
   | |- context [ Z.of_N (N.succ ?a) ] => rewrite (N2Z.inj_succ a)
diff --git a/plugins/omega/coq_omega.ml b/plugins/omega/coq_omega.ml
index d07b2e0b4..4271c80cd 100644
--- a/plugins/omega/coq_omega.ml
+++ b/plugins/omega/coq_omega.ml
@@ -50,6 +50,7 @@ let display_time_flag = ref false
 let display_system_flag = ref false
 let display_action_flag = ref false
 let old_style_flag = ref false
+let letin_flag = ref true
 
 (* Should we reset all variable labels between two runs of omega ? *)
 
@@ -100,6 +101,14 @@ let _ =
       optread  = read reset_flag;
       optwrite = write reset_flag }
 
+let _ =
+  declare_bool_option
+    { optdepr  = false;
+      optname  = "Omega takes advantage of context variables with body";
+      optkey   = ["Omega";"UseLocalDefs"];
+      optread  = read letin_flag;
+      optwrite = write letin_flag }
+
 let intref, reset_all_references =
   let refs = ref [] in
   (fun n -> let r = ref n in refs := (r,n) :: !refs; r),
@@ -376,16 +385,15 @@ let mk_var v = mkVar (Id.of_string v)
 let mk_plus t1 t2 = mkApp (Lazy.force coq_Zplus, [| t1; t2 |])
 let mk_times t1 t2 = mkApp (Lazy.force coq_Zmult, [| t1; t2 |])
 let mk_minus t1 t2 = mkApp (Lazy.force coq_Zminus, [| t1;t2 |])
-let mk_eq t1 t2 = mkApp (Lazy.force coq_eq,
-			 [| Lazy.force coq_Z; t1; t2 |])
+let mk_gen_eq ty t1 t2 = mkApp (Lazy.force coq_eq, [| ty; t1; t2 |])
+let mk_eq t1 t2 = mk_gen_eq (Lazy.force coq_Z) t1 t2
 let mk_le t1 t2 = mkApp (Lazy.force coq_Zle, [| t1; t2 |])
 let mk_gt t1 t2 = mkApp (Lazy.force coq_Zgt, [| t1; t2 |])
 let mk_inv t = mkApp (Lazy.force coq_Zopp, [| t |])
 let mk_and t1 t2 =  mkApp (Lazy.force coq_and, [| t1; t2 |])
 let mk_or t1 t2 =  mkApp (Lazy.force coq_or, [| t1; t2 |])
 let mk_not t = mkApp (Lazy.force coq_not, [| t |])
-let mk_eq_rel t1 t2 = mkApp (Lazy.force coq_eq,
-			     [| Lazy.force coq_comparison; t1; t2 |])
+let mk_eq_rel t1 t2 = mk_gen_eq (Lazy.force coq_comparison) t1 t2
 let mk_inj t = mkApp (Lazy.force coq_Z_of_nat, [| t |])
 
 let mk_integer n =
@@ -458,12 +466,14 @@ let destructurate_prop sigma t =
     | Prod (Name _,_,_),[] -> CErrors.user_err Pp.(str "Omega: Not a quantifier-free goal")
     | _ -> Kufo
 
-let destructurate_type sigma t =
-  let eq_constr c1 c2 = eq_constr sigma c1 c2 in
-  let c, args = decompose_app sigma t in
+let nf = Tacred.simpl
+
+let destructurate_type env sigma t =
+  let is_conv = Reductionops.is_conv env sigma in
+  let c, args = decompose_app sigma (nf env sigma t) in
   match EConstr.kind sigma c, args with
-    | _, [] when eq_constr c (Lazy.force coq_Z) -> Kapp (Z,args)
-    | _, [] when eq_constr c (Lazy.force coq_nat) -> Kapp (Nat,args)
+    | _, [] when is_conv c (Lazy.force coq_Z) -> Kapp (Z,args)
+    | _, [] when is_conv c (Lazy.force coq_nat) -> Kapp (Nat,args)
     | _ -> Kufo
 
 let destructurate_term sigma t =
@@ -642,7 +652,7 @@ let decompile af =
 
 (** Backward compat to emulate the old Refine: normalize the goal conclusion *)
 let new_hole env sigma c =
-  let c = Reductionops.nf_betaiota sigma c in
+  let c = Reductionops.nf_betaiota env sigma c in
   Evarutil.new_evar env sigma c
 
 let clever_rewrite_base_poly typ p result theorem =
@@ -1451,17 +1461,13 @@ let normalize_equation sigma id flag theorem pos t t1 t2 (tactic,defs) =
   else
     (tactic,defs)
 
-let pf_nf gl c = Tacmach.New.pf_apply Tacred.simpl gl c
-
-let destructure_omega gl tac_def (id,c) =
-  let open Tacmach.New in
-  let sigma = project gl in
+let destructure_omega env sigma tac_def (id,c) =
   if String.equal (atompart_of_id id) "State" then
     tac_def
   else
     try match destructurate_prop sigma c with
       | Kapp(Eq,[typ;t1;t2])
-	when begin match destructurate_type sigma (pf_nf gl typ) with Kapp(Z,[]) -> true | _ -> false end ->
+        when begin match destructurate_type env sigma typ with Kapp(Z,[]) -> true | _ -> false end ->
 	  let t = mk_plus t1 (mk_inv t2) in
 	  normalize_equation sigma
 	    id EQUA (Lazy.force coq_Zegal_left) 2 t t1 t2 tac_def
@@ -1499,7 +1505,7 @@ let coq_omega =
   Proofview.Goal.enter begin fun gl ->
   clear_constr_tables ();
   let hyps_types = Tacmach.New.pf_hyps_types gl in
-  let destructure_omega = destructure_omega gl in
+  let destructure_omega = Tacmach.New.pf_apply destructure_omega gl in
   let tactic_normalisation, system =
     List.fold_left destructure_omega ([],[]) hyps_types in
   let prelude,sys =
@@ -1719,27 +1725,26 @@ let not_binop = function
 
 exception Undecidable
 
-let rec decidability gl t =
-  let open Tacmach.New in
-  match destructurate_prop (project gl) t with
+let rec decidability env sigma t =
+  match destructurate_prop sigma t with
     | Kapp(Or,[t1;t2]) ->
 	mkApp (Lazy.force coq_dec_or, [| t1; t2;
-		  decidability gl t1; decidability gl t2 |])
+                  decidability env sigma t1; decidability env sigma t2 |])
     | Kapp(And,[t1;t2]) ->
 	mkApp (Lazy.force coq_dec_and, [| t1; t2;
-		  decidability gl t1; decidability gl t2 |])
+                  decidability env sigma t1; decidability env sigma t2 |])
     | Kapp(Iff,[t1;t2]) ->
 	mkApp (Lazy.force coq_dec_iff, [| t1; t2;
-		  decidability gl t1; decidability gl t2 |])
+                  decidability env sigma t1; decidability env sigma t2 |])
     | Kimp(t1,t2) ->
         (* This is the only situation where it's not obvious that [t]
 	   is in Prop. The recursive call on [t2] will ensure that. *)
         mkApp (Lazy.force coq_dec_imp,
-		 [| t1; t2; decidability gl t1; decidability gl t2 |])
+                 [| t1; t2; decidability env sigma t1; decidability env sigma t2 |])
     | Kapp(Not,[t1]) ->
-        mkApp (Lazy.force coq_dec_not, [| t1; decidability gl t1 |])
+        mkApp (Lazy.force coq_dec_not, [| t1; decidability env sigma t1 |])
     | Kapp(Eq,[typ;t1;t2]) ->
-	begin match destructurate_type (project gl) (pf_nf gl typ) with
+        begin match destructurate_type env sigma typ with
           | Kapp(Z,[]) ->  mkApp (Lazy.force coq_dec_eq, [| t1;t2 |])
           | Kapp(Nat,[]) ->  mkApp (Lazy.force coq_dec_eq_nat, [| t1;t2 |])
           | _ -> raise Undecidable
@@ -1760,7 +1765,7 @@ let onClearedName id tac =
   tclTHEN
     (tclTRY (clear [id]))
     (Proofview.Goal.nf_enter begin fun gl ->
-     let id = fresh_id [] id gl in
+     let id = fresh_id Id.Set.empty id gl in
      tclTHEN (introduction id) (tac id)
     end)
 
@@ -1768,26 +1773,36 @@ let onClearedName2 id tac =
   tclTHEN
     (tclTRY (clear [id]))
     (Proofview.Goal.nf_enter begin fun gl ->
-     let id1 = fresh_id [] (add_suffix id "_left") gl in
-     let id2 = fresh_id [] (add_suffix id "_right") gl in
+     let id1 = fresh_id Id.Set.empty (add_suffix id "_left") gl in
+     let id2 = fresh_id Id.Set.empty (add_suffix id "_right") gl in
       tclTHENLIST [ introduction id1; introduction id2; tac id1 id2 ]
     end)
 
-let rec is_Prop sigma c = match EConstr.kind sigma c with
-  | Sort s -> Sorts.is_prop (ESorts.kind sigma s)
-  | Cast (c,_,_) -> is_Prop sigma c
-  | _ -> false
-
 let destructure_hyps =
   Proofview.Goal.enter begin fun gl ->
   let type_of = Tacmach.New.pf_unsafe_type_of gl in
-  let decidability = decidability gl in
-  let pf_nf = pf_nf gl in
-    let rec loop = function
-      | [] -> (tclTHEN nat_inject coq_omega)
-      | decl::lit ->
-          let i = NamedDecl.get_id decl in
-          Proofview.tclEVARMAP >>= fun sigma ->
+  let env = Proofview.Goal.env gl in
+  let sigma = Proofview.Goal.sigma gl in
+  let decidability = decidability env sigma in
+  let rec loop = function
+    | [] -> (tclTHEN nat_inject coq_omega)
+    | LocalDef (i,body,typ) :: lit when !letin_flag ->
+       Proofview.tclEVARMAP >>= fun sigma ->
+       begin
+         try
+           match destructurate_type env sigma typ with
+           | Kapp(Nat,_) | Kapp(Z,_) ->
+              let hid = fresh_id Id.Set.empty (add_suffix i "_eqn") gl in
+              let hty = mk_gen_eq typ (mkVar i) body in
+              tclTHEN
+                (assert_by (Name hid) hty reflexivity)
+                (loop (LocalAssum (hid, hty) :: lit))
+           | _ -> loop lit
+         with e when catchable_exception e -> loop lit
+       end
+    | decl :: lit -> (* variable without body (or !letin_flag isn't set) *)
+       let i = NamedDecl.get_id decl in
+       Proofview.tclEVARMAP >>= fun sigma ->
 	  begin try match destructurate_prop sigma (NamedDecl.get_type decl) with
 	  | Kapp(False,[]) -> elim_id i
           | Kapp((Zle|Zge|Zgt|Zlt|Zne),[t1;t2]) -> loop lit
@@ -1809,7 +1824,7 @@ let destructure_hyps =
           | Kimp(t1,t2) ->
 	      (* t1 and t2 might be in Type rather than Prop.
 		 For t1, the decidability check will ensure being Prop. *)
-              if is_Prop sigma (type_of t2)
+              if Termops.is_Prop sigma (type_of t2)
               then
 		let d1 = decidability t1 in
 		tclTHENLIST [
@@ -1878,7 +1893,7 @@ let destructure_hyps =
 		   with Not_found -> loop lit)
 	      | Kapp(Eq,[typ;t1;t2]) ->
                   if !old_style_flag then begin
-		    match destructurate_type sigma (pf_nf typ) with
+                    match destructurate_type env sigma typ with
 		    | Kapp(Nat,_) ->
                         tclTHENLIST [
 			  (simplest_elim
@@ -1895,7 +1910,7 @@ let destructure_hyps =
                         ]
 		    | _ -> loop lit
                   end else begin
-		    match destructurate_type sigma (pf_nf typ) with
+                    match destructurate_type env sigma typ with
 		    | Kapp(Nat,_) ->
                         (tclTHEN
 			   (convert_hyp_no_check (NamedDecl.set_type (mkApp (Lazy.force coq_neq, [| t1;t2|]))
@@ -1923,7 +1938,9 @@ let destructure_hyps =
 let destructure_goal =
   Proofview.Goal.enter begin fun gl ->
     let concl = Proofview.Goal.concl gl in
-    let decidability = decidability gl in
+    let env = Proofview.Goal.env gl in
+    let sigma = Proofview.Goal.sigma gl in
+    let decidability = decidability env sigma in
     let rec loop t =
       Proofview.tclEVARMAP >>= fun sigma ->
       let prop () = Proofview.tclUNIT (destructurate_prop sigma t) in
diff --git a/plugins/omega/g_omega.ml4 b/plugins/omega/g_omega.ml4
index 735af6bab..f7b153a13 100644
--- a/plugins/omega/g_omega.ml4
+++ b/plugins/omega/g_omega.ml4
@@ -13,8 +13,6 @@
 (*                                                                        *)
 (**************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 
 DECLARE PLUGIN "omega_plugin"
 
diff --git a/plugins/quote/g_quote.ml4 b/plugins/quote/g_quote.ml4
index f7ebd3204..55dc7f580 100644
--- a/plugins/quote/g_quote.ml4
+++ b/plugins/quote/g_quote.ml4
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Ltac_plugin
 open Names
 open Misctypes
@@ -24,7 +22,7 @@ let x = Id.of_string "x"
 
 let make_cont (k : Val.t) (c : EConstr.t) =
   let c = Tacinterp.Value.of_constr c in
-  let tac = TacCall (Loc.tag (ArgVar (Loc.tag cont), [Reference (ArgVar (Loc.tag x))])) in
+  let tac = TacCall (Loc.tag (ArgVar CAst.(make cont), [Reference (ArgVar CAst.(make x))])) in
   let ist = { lfun = Id.Map.add cont k (Id.Map.singleton x c); extra = TacStore.empty; } in
   Tacinterp.eval_tactic_ist ist (TacArg (Loc.tag tac))
 
diff --git a/plugins/quote/quote.ml b/plugins/quote/quote.ml
index e1e73b1c3..0ea8904f2 100644
--- a/plugins/quote/quote.ml
+++ b/plugins/quote/quote.ml
@@ -104,7 +104,7 @@
 open CErrors
 open Util
 open Names
-open Term
+open Constr
 open EConstr
 open Pattern
 open Patternops
@@ -166,11 +166,7 @@ exchange ?1 and ?2 in the example above)
 
 *)
 
-module ConstrSet = Set.Make(
-  struct
-    type t = Term.constr
-    let compare = Term.compare
-  end)
+module ConstrSet = Set.Make(Constr)
 
 type inversion_scheme = {
   normal_lhs_rhs : (constr * constr_pattern) list;
@@ -385,11 +381,7 @@ let rec sort_subterm gl l =
     | [] -> []
     | h::t -> insert h (sort_subterm gl t)
 
-module Constrhash = Hashtbl.Make
-  (struct type t = Term.constr
-	  let equal = Term.eq_constr
-	  let hash = Term.hash_constr
-   end)
+module Constrhash = Hashtbl.Make(Constr)
 
 let subst_meta subst c =
   let subst = List.map (fun (i, c) -> i, EConstr.Unsafe.to_constr c) subst in
diff --git a/plugins/romega/ROmega.v b/plugins/romega/ROmega.v
index 3ddb6bed1..657aae90e 100644
--- a/plugins/romega/ROmega.v
+++ b/plugins/romega/ROmega.v
@@ -11,4 +11,4 @@ Require Export Setoid.
 Require Export PreOmega.
 Require Export ZArith_base.
 Require Import OmegaPlugin.
-Declare ML Module "romega_plugin".
\ No newline at end of file
+Declare ML Module "romega_plugin".
diff --git a/plugins/romega/const_omega.ml b/plugins/romega/const_omega.ml
index 4ffbd5aa8..0f5417e7d 100644
--- a/plugins/romega/const_omega.ml
+++ b/plugins/romega/const_omega.ml
@@ -7,14 +7,15 @@
  *************************************************************************)
 
 open Names
+open Constr
 
 let module_refl_name = "ReflOmegaCore"
 let module_refl_path = ["Coq"; "romega"; module_refl_name]
 
 type result =
   | Kvar of string
-  | Kapp of string * Term.constr list
-  | Kimp of Term.constr * Term.constr
+  | Kapp of string * constr list
+  | Kimp of constr * constr
   | Kufo
 
 let meaningful_submodule = [ "Z"; "N"; "Pos" ]
@@ -30,27 +31,27 @@ let string_of_global r =
   prefix^(Names.Id.to_string (Nametab.basename_of_global r))
 
 let destructurate t =
-  let c, args = Term.decompose_app t in
-  match Term.kind_of_term c, args with
-  | Term.Const (sp,_), args ->
+  let c, args = decompose_app t in
+  match Constr.kind c, args with
+  | Const (sp,_), args ->
      Kapp (string_of_global (Globnames.ConstRef sp), args)
-  | Term.Construct (csp,_) , args ->
+  | Construct (csp,_) , args ->
      Kapp (string_of_global (Globnames.ConstructRef csp), args)
-  | Term.Ind (isp,_), args ->
+  | Ind (isp,_), args ->
      Kapp (string_of_global (Globnames.IndRef isp), args)
-  | Term.Var id, [] -> Kvar(Names.Id.to_string id)
-  | Term.Prod (Anonymous,typ,body), [] -> Kimp(typ,body)
+  | Var id, [] -> Kvar(Names.Id.to_string id)
+  | Prod (Anonymous,typ,body), [] -> Kimp(typ,body)
   | _ -> Kufo
 
 exception DestConstApp
 
 let dest_const_apply t =
-  let f,args = Term.decompose_app t in
+  let f,args = decompose_app t in
   let ref =
-  match Term.kind_of_term f with
-    | Term.Const (sp,_)      -> Globnames.ConstRef sp
-    | Term.Construct (csp,_) -> Globnames.ConstructRef csp
-    | Term.Ind (isp,_)       -> Globnames.IndRef isp
+  match Constr.kind f with
+    | Const (sp,_)      -> Globnames.ConstRef sp
+    | Construct (csp,_) -> Globnames.ConstructRef csp
+    | Ind (isp,_)       -> Globnames.IndRef isp
     | _ -> raise DestConstApp
   in Nametab.basename_of_global ref, args
 
@@ -129,7 +130,7 @@ let coq_O = lazy(init_constant "O")
 
 let rec mk_nat = function
   | 0 -> Lazy.force coq_O
-  | n -> Term.mkApp (Lazy.force coq_S, [| mk_nat (n-1) |])
+  | n -> mkApp (Lazy.force coq_S, [| mk_nat (n-1) |])
 
 (* Lists *)
 
@@ -141,47 +142,47 @@ let mkListConst c =
     if Global.is_polymorphic r then fun u -> Univ.Instance.of_array [|u|]
     else fun _ -> Univ.Instance.empty
   in
-    fun u -> Term.mkConstructU (Globnames.destConstructRef r, inst u)
+    fun u -> mkConstructU (Globnames.destConstructRef r, inst u)
 
-let coq_cons univ typ = Term.mkApp (mkListConst "cons" univ, [|typ|])
-let coq_nil univ typ =  Term.mkApp (mkListConst "nil" univ, [|typ|])
+let coq_cons univ typ = mkApp (mkListConst "cons" univ, [|typ|])
+let coq_nil univ typ =  mkApp (mkListConst "nil" univ, [|typ|])
 
 let mk_list univ typ l =
   let rec loop = function
     | [] -> coq_nil univ typ
     | (step :: l) ->
-	Term.mkApp (coq_cons univ typ, [| step; loop l |]) in
+	mkApp (coq_cons univ typ, [| step; loop l |]) in
   loop l
 
 let mk_plist = 
-  let type1lev = Universes.new_univ_level (Global.current_dirpath ()) in
-    fun l -> mk_list type1lev Term.mkProp l
+  let type1lev = Universes.new_univ_level () in
+    fun l -> mk_list type1lev mkProp l
 
 let mk_list = mk_list Univ.Level.set
 
 type parse_term =
-  | Tplus of Term.constr * Term.constr
-  | Tmult of Term.constr * Term.constr
-  | Tminus of Term.constr * Term.constr
-  | Topp of Term.constr
-  | Tsucc of Term.constr
+  | Tplus of constr * constr
+  | Tmult of constr * constr
+  | Tminus of constr * constr
+  | Topp of constr
+  | Tsucc of constr
   | Tnum of Bigint.bigint
   | Tother
 
 type parse_rel =
-  | Req of Term.constr * Term.constr
-  | Rne of Term.constr * Term.constr
-  | Rlt of Term.constr * Term.constr
-  | Rle of Term.constr * Term.constr
-  | Rgt of Term.constr * Term.constr
-  | Rge of Term.constr * Term.constr
+  | Req of constr * constr
+  | Rne of constr * constr
+  | Rlt of constr * constr
+  | Rle of constr * constr
+  | Rgt of constr * constr
+  | Rge of constr * constr
   | Rtrue
   | Rfalse
-  | Rnot of Term.constr
-  | Ror of Term.constr * Term.constr
-  | Rand of Term.constr * Term.constr
-  | Rimp of Term.constr * Term.constr
-  | Riff of Term.constr * Term.constr
+  | Rnot of constr
+  | Ror of constr * constr
+  | Rand of constr * constr
+  | Rimp of constr * constr
+  | Riff of constr * constr
   | Rother
 
 let parse_logic_rel c = match destructurate c with
@@ -196,6 +197,7 @@ let parse_logic_rel c = match destructurate c with
 
 (* Binary numbers *)
 
+let coq_Z = lazy (bin_constant "Z")
 let coq_xH = lazy (bin_constant "xH")
 let coq_xO = lazy (bin_constant "xO")
 let coq_xI = lazy (bin_constant "xI")
@@ -209,33 +211,34 @@ let rec mk_positive n =
   if Bigint.equal n Bigint.one then Lazy.force coq_xH
   else
     let (q,r) = Bigint.euclid n Bigint.two in
-    Term.mkApp
+    mkApp
       ((if Bigint.equal r Bigint.zero
         then Lazy.force coq_xO else Lazy.force coq_xI),
        [| mk_positive q |])
 
 let mk_N = function
   | 0 -> Lazy.force coq_N0
-  | n -> Term.mkApp (Lazy.force coq_Npos,
+  | n -> mkApp (Lazy.force coq_Npos,
                      [| mk_positive (Bigint.of_int n) |])
 
 module type Int = sig
-  val typ : Term.constr Lazy.t
-  val plus : Term.constr Lazy.t
-  val mult : Term.constr Lazy.t
-  val opp : Term.constr Lazy.t
-  val minus : Term.constr Lazy.t
-
-  val mk : Bigint.bigint -> Term.constr
-  val parse_term : Term.constr -> parse_term
-  val parse_rel : [ `NF ] Proofview.Goal.t -> Term.constr -> parse_rel
+  val typ : constr Lazy.t
+  val is_int_typ : Proofview.Goal.t -> constr -> bool
+  val plus : constr Lazy.t
+  val mult : constr Lazy.t
+  val opp : constr Lazy.t
+  val minus : constr Lazy.t
+
+  val mk : Bigint.bigint -> constr
+  val parse_term : constr -> parse_term
+  val parse_rel : Proofview.Goal.t -> constr -> parse_rel
   (* check whether t is built only with numbers and + * - *)
-  val get_scalar : Term.constr -> Bigint.bigint option
+  val get_scalar : constr -> Bigint.bigint option
 end
 
 module Z : Int = struct
 
-let typ = lazy (bin_constant "Z")
+let typ = coq_Z
 let plus = lazy (z_constant "Z.add")
 let mult = lazy (z_constant  "Z.mul")
 let opp = lazy (z_constant "Z.opp")
@@ -265,9 +268,9 @@ let recognize_Z t =
 let mk_Z n =
   if Bigint.equal n Bigint.zero then Lazy.force coq_Z0
   else if Bigint.is_strictly_pos n then
-    Term.mkApp (Lazy.force coq_Zpos, [| mk_positive n |])
+    mkApp (Lazy.force coq_Zpos, [| mk_positive n |])
   else
-    Term.mkApp (Lazy.force coq_Zneg, [| mk_positive (Bigint.neg n) |])
+    mkApp (Lazy.force coq_Zneg, [| mk_positive (Bigint.neg n) |])
 
 let mk = mk_Z
 
@@ -283,16 +286,13 @@ let parse_term t =
      (match recognize_Z t with Some t -> Tnum t | None -> Tother)
   | _ -> Tother
 
-let pf_nf gl c =
-  EConstr.Unsafe.to_constr
-    (Tacmach.New.pf_apply Tacred.simpl gl (EConstr.of_constr c))
+let is_int_typ gl t =
+  Tacmach.New.pf_apply Reductionops.is_conv gl
+    (EConstr.of_constr t) (EConstr.of_constr (Lazy.force coq_Z))
 
 let parse_rel gl t =
   match destructurate t with
-  | Kapp("eq",[typ;t1;t2]) ->
-     (match destructurate (pf_nf gl typ) with
-      | Kapp("Z",[]) -> Req (t1,t2)
-      | _ -> Rother)
+  | Kapp("eq",[typ;t1;t2]) when is_int_typ gl typ -> Req (t1,t2)
   | Kapp("Zne",[t1;t2]) -> Rne (t1,t2)
   | Kapp("Z.le",[t1;t2]) -> Rle (t1,t2)
   | Kapp("Z.lt",[t1;t2]) -> Rlt (t1,t2)
diff --git a/plugins/romega/const_omega.mli b/plugins/romega/const_omega.mli
index a452b1a91..ecddc55de 100644
--- a/plugins/romega/const_omega.mli
+++ b/plugins/romega/const_omega.mli
@@ -8,114 +8,117 @@
 
 
 (** Coq objects used in romega *)
+open Constr
 
 (* from Logic *)
-val coq_refl_equal : Term.constr lazy_t
-val coq_and : Term.constr lazy_t
-val coq_not : Term.constr lazy_t
-val coq_or : Term.constr lazy_t
-val coq_True : Term.constr lazy_t
-val coq_False : Term.constr lazy_t
-val coq_I : Term.constr lazy_t
+val coq_refl_equal : constr lazy_t
+val coq_and : constr lazy_t
+val coq_not : constr lazy_t
+val coq_or : constr lazy_t
+val coq_True : constr lazy_t
+val coq_False : constr lazy_t
+val coq_I : constr lazy_t
 
 (* from ReflOmegaCore/ZOmega *)
 
-val coq_t_int : Term.constr lazy_t
-val coq_t_plus : Term.constr lazy_t
-val coq_t_mult : Term.constr lazy_t
-val coq_t_opp : Term.constr lazy_t
-val coq_t_minus : Term.constr lazy_t
-val coq_t_var : Term.constr lazy_t
-
-val coq_proposition : Term.constr lazy_t
-val coq_p_eq : Term.constr lazy_t
-val coq_p_leq : Term.constr lazy_t
-val coq_p_geq : Term.constr lazy_t
-val coq_p_lt : Term.constr lazy_t
-val coq_p_gt : Term.constr lazy_t
-val coq_p_neq : Term.constr lazy_t
-val coq_p_true : Term.constr lazy_t
-val coq_p_false : Term.constr lazy_t
-val coq_p_not : Term.constr lazy_t
-val coq_p_or : Term.constr lazy_t
-val coq_p_and : Term.constr lazy_t
-val coq_p_imp : Term.constr lazy_t
-val coq_p_prop : Term.constr lazy_t
-
-val coq_s_bad_constant : Term.constr lazy_t
-val coq_s_divide : Term.constr lazy_t
-val coq_s_not_exact_divide : Term.constr lazy_t
-val coq_s_sum : Term.constr lazy_t
-val coq_s_merge_eq : Term.constr lazy_t
-val coq_s_split_ineq : Term.constr lazy_t
-
-val coq_direction : Term.constr lazy_t
-val coq_d_left : Term.constr lazy_t
-val coq_d_right : Term.constr lazy_t
-
-val coq_e_split : Term.constr lazy_t
-val coq_e_extract : Term.constr lazy_t
-val coq_e_solve : Term.constr lazy_t
-
-val coq_interp_sequent : Term.constr lazy_t
-val coq_do_omega : Term.constr lazy_t
-
-val mk_nat : int -> Term.constr
-val mk_N : int -> Term.constr
+val coq_t_int : constr lazy_t
+val coq_t_plus : constr lazy_t
+val coq_t_mult : constr lazy_t
+val coq_t_opp : constr lazy_t
+val coq_t_minus : constr lazy_t
+val coq_t_var : constr lazy_t
+
+val coq_proposition : constr lazy_t
+val coq_p_eq : constr lazy_t
+val coq_p_leq : constr lazy_t
+val coq_p_geq : constr lazy_t
+val coq_p_lt : constr lazy_t
+val coq_p_gt : constr lazy_t
+val coq_p_neq : constr lazy_t
+val coq_p_true : constr lazy_t
+val coq_p_false : constr lazy_t
+val coq_p_not : constr lazy_t
+val coq_p_or : constr lazy_t
+val coq_p_and : constr lazy_t
+val coq_p_imp : constr lazy_t
+val coq_p_prop : constr lazy_t
+
+val coq_s_bad_constant : constr lazy_t
+val coq_s_divide : constr lazy_t
+val coq_s_not_exact_divide : constr lazy_t
+val coq_s_sum : constr lazy_t
+val coq_s_merge_eq : constr lazy_t
+val coq_s_split_ineq : constr lazy_t
+
+val coq_direction : constr lazy_t
+val coq_d_left : constr lazy_t
+val coq_d_right : constr lazy_t
+
+val coq_e_split : constr lazy_t
+val coq_e_extract : constr lazy_t
+val coq_e_solve : constr lazy_t
+
+val coq_interp_sequent : constr lazy_t
+val coq_do_omega : constr lazy_t
+
+val mk_nat : int -> constr
+val mk_N : int -> constr
 
 (** Precondition: the type of the list is in Set *)
-val mk_list : Term.constr -> Term.constr list -> Term.constr
-val mk_plist : Term.types list -> Term.types
+val mk_list : constr -> constr list -> constr
+val mk_plist : types list -> types
 
 (** Analyzing a coq term *)
 
 (* The generic result shape of the analysis of a term.
    One-level depth, except when a number is found *)
 type parse_term =
-    Tplus of Term.constr * Term.constr
-  | Tmult of Term.constr * Term.constr
-  | Tminus of Term.constr * Term.constr
-  | Topp of Term.constr
-  | Tsucc of Term.constr
+    Tplus of constr * constr
+  | Tmult of constr * constr
+  | Tminus of constr * constr
+  | Topp of constr
+  | Tsucc of constr
   | Tnum of Bigint.bigint
   | Tother
 
 (* The generic result shape of the analysis of a relation.
    One-level depth. *)
 type parse_rel =
-    Req of Term.constr * Term.constr
-  | Rne of Term.constr * Term.constr
-  | Rlt of Term.constr * Term.constr
-  | Rle of Term.constr * Term.constr
-  | Rgt of Term.constr * Term.constr
-  | Rge of Term.constr * Term.constr
+    Req of constr * constr
+  | Rne of constr * constr
+  | Rlt of constr * constr
+  | Rle of constr * constr
+  | Rgt of constr * constr
+  | Rge of constr * constr
   | Rtrue
   | Rfalse
-  | Rnot of Term.constr
-  | Ror of Term.constr * Term.constr
-  | Rand of Term.constr * Term.constr
-  | Rimp of Term.constr * Term.constr
-  | Riff of Term.constr * Term.constr
+  | Rnot of constr
+  | Ror of constr * constr
+  | Rand of constr * constr
+  | Rimp of constr * constr
+  | Riff of constr * constr
   | Rother
 
 (* A module factorizing what we should now about the number representation *)
 module type Int =
   sig
     (* the coq type of the numbers *)
-    val typ : Term.constr Lazy.t
+    val typ : constr Lazy.t
+    (* Is a constr expands to the type of these numbers *)
+    val is_int_typ : Proofview.Goal.t -> constr -> bool
     (* the operations on the numbers *)
-    val plus : Term.constr Lazy.t
-    val mult : Term.constr Lazy.t
-    val opp : Term.constr Lazy.t
-    val minus : Term.constr Lazy.t
+    val plus : constr Lazy.t
+    val mult : constr Lazy.t
+    val opp : constr Lazy.t
+    val minus : constr Lazy.t
     (* building a coq number *)
-    val mk : Bigint.bigint -> Term.constr
+    val mk : Bigint.bigint -> constr
     (* parsing a term (one level, except if a number is found) *)
-    val parse_term : Term.constr -> parse_term
+    val parse_term : constr -> parse_term
     (* parsing a relation expression, including = < <= >= > *)
-    val parse_rel : [ `NF ] Proofview.Goal.t -> Term.constr -> parse_rel
+    val parse_rel : Proofview.Goal.t -> constr -> parse_rel
     (* Is a particular term only made of numbers and + * - ? *)
-    val get_scalar : Term.constr -> Bigint.bigint option
+    val get_scalar : constr -> Bigint.bigint option
   end
 
 (* Currently, we only use Z numbers *)
diff --git a/plugins/romega/g_romega.ml4 b/plugins/romega/g_romega.ml4
index 5fd9c9419..5b77d08de 100644
--- a/plugins/romega/g_romega.ml4
+++ b/plugins/romega/g_romega.ml4
@@ -6,8 +6,6 @@
 
  *************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 
 DECLARE PLUGIN "romega_plugin"
 
diff --git a/plugins/romega/refl_omega.ml b/plugins/romega/refl_omega.ml
index 517df41d9..54ff44fbd 100644
--- a/plugins/romega/refl_omega.ml
+++ b/plugins/romega/refl_omega.ml
@@ -8,6 +8,7 @@
 
 open Pp
 open Util
+open Constr
 open Const_omega
 module OmegaSolver = Omega_plugin.Omega.MakeOmegaSolver (Bigint)
 open OmegaSolver
@@ -27,8 +28,6 @@ let pp i = print_int i; print_newline (); flush stdout
 (* More readable than the prefix notation *)
 let (>>) = Tacticals.New.tclTHEN
 
-let mkApp = Term.mkApp
-
 (* \section{Types}
   \subsection{How to walk in a term}
   To represent how to get to a proposition. Only choice points are
@@ -68,14 +67,14 @@ type comparaison = Eq | Leq | Geq | Gt | Lt | Neq
    (it could contains some [Term.Var] but no [Term.Rel]). So no need to
    lift when breaking or creating arrows. *)
 type oproposition =
-    Pequa of Term.constr * oequation (* constr = copy of the Coq formula *)
+    Pequa of constr * oequation (* constr = copy of the Coq formula *)
   | Ptrue
   | Pfalse
   | Pnot of oproposition
   | Por of int * oproposition * oproposition
   | Pand of int * oproposition * oproposition
   | Pimp of int * oproposition * oproposition
-  | Pprop of Term.constr
+  | Pprop of constr
 
 (* The equations *)
 and oequation = {
@@ -102,9 +101,9 @@ and oequation = {
 
 type environment = {
   (* La liste des termes non reifies constituant l'environnement global *)
-  mutable terms : Term.constr list;
+  mutable terms : constr list;
   (* La meme chose pour les propositions *)
-  mutable props : Term.constr list;
+  mutable props : constr list;
   (* Traduction des indices utilisés ici en les indices finaux utilisés par
    * la tactique Omega après dénombrement des variables utiles *)
   real_indices : int IntHtbl.t;
@@ -184,8 +183,9 @@ let print_env_reification env =
   let rec loop c i = function
       [] ->  str "  ===============================\n\n"
     | t :: l ->
+      let sigma, env = Pfedit.get_current_context () in
       let s = Printf.sprintf "(%c%02d)" c i in
-      spc () ++ str s ++ str " := " ++ Printer.pr_lconstr t ++ fnl () ++
+      spc () ++ str s ++ str " := " ++ Printer.pr_lconstr_env env sigma t ++ fnl () ++
       loop c (succ i) l
   in
   let prop_info = str "ENVIRONMENT OF PROPOSITIONS :" ++ fnl () ++ loop 'P' 0 env.props in
@@ -219,7 +219,7 @@ let display_omega_var i = Printf.sprintf "OV%d" i
    calcul des variables utiles. *)
 
 let add_reified_atom t env =
-  try List.index0 Term.eq_constr t env.terms
+  try List.index0 Constr.equal t env.terms
   with Not_found ->
     let i = List.length env.terms in
     env.terms <- env.terms @ [t]; i
@@ -237,7 +237,7 @@ let set_reified_atom v t env =
 (* \subsection{Gestion de l'environnement de proposition pour Omega} *)
 (* ajout d'une proposition *)
 let add_prop env t =
-  try List.index0 Term.eq_constr t env.props
+  try List.index0 Constr.equal t env.props
   with Not_found ->
     let i = List.length env.props in  env.props <- env.props @ [t]; i
 
@@ -547,22 +547,33 @@ let display_gl env t_concl t_lhyps =
   Printf.printf "REIFED PROBLEM\n\n";
   Printf.printf "  CONCL: %a\n" pprint t_concl;
   List.iter
-    (fun (i,t) -> Printf.printf "  %s: %a\n" (Id.to_string i) pprint t)
+    (fun (i,_,t) -> Printf.printf "  %s: %a\n" (Id.to_string i) pprint t)
     t_lhyps;
   print_env_reification env
 
+type defined = Defined | Assumed
+
+let reify_hyp env gl i =
+  let open Context.Named.Declaration in
+  let ctxt = (false,[],i,[]) in
+  match Tacmach.New.pf_get_hyp i gl with
+  | LocalDef (_,d,t) when Z.is_int_typ gl (EConstr.Unsafe.to_constr t) ->
+     let d = EConstr.Unsafe.to_constr d in
+     let dummy = Lazy.force coq_True in
+     let p = mk_equation env ctxt dummy Eq (mkVar i) d in
+     i,Defined,p
+  | LocalDef (_,_,t) | LocalAssum (_,t) ->
+     let t = EConstr.Unsafe.to_constr t in
+     let p = oproposition_of_constr env ctxt gl t in
+     i,Assumed,p
+
 let reify_gl env gl =
   let concl = Tacmach.New.pf_concl gl in
   let concl = EConstr.Unsafe.to_constr concl in
-  let hyps = Tacmach.New.pf_hyps_types gl in
-  let hyps = List.map (fun (i,t) -> (i,EConstr.Unsafe.to_constr t)) hyps in
-  let t_concl =
-    oproposition_of_constr env (true,[],id_concl,[O_mono]) gl concl in
-  let t_lhyps =
-    List.map
-      (fun (i,t) -> i,oproposition_of_constr env (false,[],i,[]) gl t)
-      hyps
-  in
+  let hyps = Tacmach.New.pf_ids_of_hyps gl in
+  let ctxt_concl = (true,[],id_concl,[O_mono]) in
+  let t_concl = oproposition_of_constr env ctxt_concl gl concl in
+  let t_lhyps = List.map (reify_hyp env gl) hyps in
   let () = if !debug then display_gl env t_concl t_lhyps in
   t_concl, t_lhyps
 
@@ -602,7 +613,7 @@ and destruct_neg_hyp eqns = function
 
 let rec destructurate_hyps = function
   | [] -> [[]]
-  | (i,t) :: l ->
+  | (i,_,t) :: l ->
      let l_syst1 = destruct_pos_hyp [] t in
      let l_syst2 = destructurate_hyps l in
      List.cartesian (@) l_syst1 l_syst2
@@ -673,6 +684,9 @@ let rec stated_in_tree = function
   | Tree(_,t1,t2) -> StateSet.union (stated_in_tree t1) (stated_in_tree t2)
   | Leaf s -> stated_in_trace s.s_trace
 
+let mk_refl t =
+  EConstr.of_constr (app coq_refl_equal [|Lazy.force Z.typ; t|])
+
 let digest_stated_equations env tree =
   let do_equation st (vars,gens,eqns,ids) =
     (** We turn the definition of [v]
@@ -684,9 +698,7 @@ let digest_stated_equations env tree =
     (** We then update the environment *)
     set_reified_atom st.st_var coq_v env;
     (** The term we'll introduce *)
-    let term_to_generalize =
-      EConstr.of_constr (app coq_refl_equal [|Lazy.force Z.typ; coq_v|])
-    in
+    let term_to_generalize = mk_refl coq_v in
     (** Its representation as equation (but not reified yet,
         we lack the proper env to do that). *)
     let term_to_reify = (v_def,Oatom st.st_var) in
@@ -954,18 +966,19 @@ let resolution unsafe env (reified_concl,reified_hyps) systems_list =
     display_solution_tree stdout solution_tree;
     print_newline()
   end;
-  (** Collect all hypotheses used in the solution tree *)
+  (** Collect all hypotheses and variables used in the solution tree *)
   let useful_equa_ids = equas_of_solution_tree solution_tree in
-  let equations = List.map (get_equation env) (IntSet.elements useful_equa_ids)
+  let useful_hypnames, useful_vars =
+    IntSet.fold
+      (fun i (hyps,vars) ->
+        let e = get_equation env i in
+        Id.Set.add e.e_origin.o_hyp hyps,
+        vars_of_equations [e] @@ vars)
+      useful_equa_ids
+      (Id.Set.empty, vars_of_prop reified_concl)
   in
-  let hyps_of_eqns =
-    List.fold_left (fun s e -> Id.Set.add e.e_origin.o_hyp s) Id.Set.empty in
-  let hyps = hyps_of_eqns equations in
-  let useful_hypnames = Id.Set.elements (Id.Set.remove id_concl hyps) in
-  let useful_hyptypes =
-    List.map (fun id -> List.assoc_f Id.equal id reified_hyps) useful_hypnames
-  in
-  let useful_vars = vars_of_equations equations @@ vars_of_prop reified_concl
+  let useful_hypnames =
+    Id.Set.elements (Id.Set.remove id_concl useful_hypnames)
   in
 
   (** Parts coming from equations introduced by omega: *)
@@ -996,9 +1009,17 @@ let resolution unsafe env (reified_concl,reified_hyps) systems_list =
   let reified_concl = reified_of_proposition env reified_concl in
   let l_reified_terms =
     List.map
-      (fun p -> reified_of_proposition env (maximize_prop useful_equa_ids p))
-      useful_hyptypes
+      (fun id ->
+        match Id.Map.find id reified_hyps with
+        | Defined,p ->
+           reified_of_proposition env p, mk_refl (mkVar id)
+        | Assumed,p ->
+           reified_of_proposition env (maximize_prop useful_equa_ids p),
+           EConstr.mkVar id
+        | exception Not_found -> assert false)
+      useful_hypnames
   in
+  let l_reified_terms, l_reified_hypnames = List.split l_reified_terms in
   let env_props_reified = mk_plist env.props in
   let reified_goal =
     mk_list (Lazy.force coq_proposition)
@@ -1007,14 +1028,14 @@ let resolution unsafe env (reified_concl,reified_hyps) systems_list =
     app coq_interp_sequent
        [| reified_concl;env_props_reified;reduced_term_env;reified_goal|]
   in
+  let mk_occ id = {o_hyp=id;o_path=[]} in
   let initial_context =
-    List.map (fun id -> CCHyp{o_hyp=id;o_path=[]}) useful_hypnames in
+    List.map (fun id -> CCHyp (mk_occ id)) useful_hypnames in
   let context =
-    CCHyp{o_hyp=id_concl;o_path=[]} :: hyp_stated_vars @ initial_context in
+    CCHyp (mk_occ id_concl) :: hyp_stated_vars @ initial_context in
   let decompose_tactic = decompose_tree env context solution_tree in
 
-  Tactics.generalize
-    (l_generalize_arg @ List.map EConstr.mkVar useful_hypnames) >>
+  Tactics.generalize (l_generalize_arg @ l_reified_hypnames) >>
   Tactics.convert_concl_no_check (EConstr.of_constr reified) Term.DEFAULTcast >>
   Tactics.apply (EConstr.of_constr (app coq_do_omega [|decompose_tactic|])) >>
   show_goal >>
@@ -1034,13 +1055,16 @@ let total_reflexive_omega_tactic unsafe =
   rst_omega_var ();
   try
   let env = new_environment () in
-  let (concl,hyps) as reified_goal = reify_gl env gl in
+  let (concl,hyps) = reify_gl env gl in
   (* Register all atom indexes created during reification as omega vars *)
   set_omega_maxvar (pred (List.length env.terms));
-  let full_reified_goal = (id_concl,Pnot concl) :: hyps in
+  let full_reified_goal = (id_concl,Assumed,Pnot concl) :: hyps in
   let systems_list = destructurate_hyps full_reified_goal in
+  let hyps =
+    List.fold_left (fun s (id,d,p) -> Id.Map.add id (d,p) s) Id.Map.empty hyps
+  in
   if !debug then display_systems systems_list;
-  resolution unsafe env reified_goal systems_list
+  resolution unsafe env (concl,hyps) systems_list
   with NO_CONTRADICTION -> CErrors.user_err Pp.(str "ROmega can't solve this system")
   end
 
diff --git a/plugins/rtauto/g_rtauto.ml4 b/plugins/rtauto/g_rtauto.ml4
index bfa1e5f39..1bfcdc2fb 100644
--- a/plugins/rtauto/g_rtauto.ml4
+++ b/plugins/rtauto/g_rtauto.ml4
@@ -7,8 +7,6 @@
 (************************************************************************)
 
 
-(*i camlp4deps: "grammar/grammar.cma"  i*)
-
 open Ltac_plugin
 
 DECLARE PLUGIN "rtauto_plugin"
diff --git a/plugins/rtauto/refl_tauto.ml b/plugins/rtauto/refl_tauto.ml
index 9f02388c3..150c253a7 100644
--- a/plugins/rtauto/refl_tauto.ml
+++ b/plugins/rtauto/refl_tauto.ml
@@ -13,6 +13,7 @@ open Ltac_plugin
 open CErrors
 open Util
 open Term
+open Constr
 open Tacmach
 open Proof_search
 open Context.Named.Declaration
@@ -82,7 +83,7 @@ let make_atom atom_env term=
   let term = EConstr.Unsafe.to_constr term in
   try
     let (_,i)=
-      List.find (fun (t,_)-> eq_constr term t) atom_env.env
+      List.find (fun (t,_)-> Constr.equal term t) atom_env.env
     in Atom i
   with Not_found ->
     let i=atom_env.next in
diff --git a/plugins/rtauto/refl_tauto.mli b/plugins/rtauto/refl_tauto.mli
index bec18f6df..b2285a4a1 100644
--- a/plugins/rtauto/refl_tauto.mli
+++ b/plugins/rtauto/refl_tauto.mli
@@ -10,7 +10,7 @@
 
 type atom_env=
     {mutable next:int;
-     mutable env:(Term.constr*int) list}
+     mutable env:(Constr.t*int) list}
 
 val make_form : atom_env ->
     Goal.goal Evd.sigma -> EConstr.types -> Proof_search.form
diff --git a/plugins/setoid_ring/ArithRing.v b/plugins/setoid_ring/ArithRing.v
index 447acb905..8e4d8b0d3 100644
--- a/plugins/setoid_ring/ArithRing.v
+++ b/plugins/setoid_ring/ArithRing.v
@@ -41,9 +41,12 @@ Ltac Ss_to_add f acc :=
   | _ => constr:((acc + f)%nat)
   end.
 
+(* For internal use only *)
+Local Definition protected_to_nat := N.to_nat.
+
 Ltac natprering :=
   match goal with
-    |- context C [S ?p] =>
+  |- context C [S ?p] =>
     match p with
       O => fail 1 (* avoid replacing 1 with 1+0 ! *)
     | p => match isnatcst p with
@@ -52,9 +55,19 @@ Ltac natprering :=
                          fold v; natprering
            end
     end
-  | _ => idtac
+  | _ => change N.to_nat with protected_to_nat
+  end.
+
+Ltac natpostring :=
+  match goal with
+  | |- context [N.to_nat ?x] =>
+    let v := eval cbv in (N.to_nat x) in
+    change (N.to_nat x) with v;
+    natpostring
+  | _ => change protected_to_nat with N.to_nat
   end.
 
 Add Ring natr : natSRth
-  (morphism nat_morph_N, constants [natcst], preprocess [natprering]).
+  (morphism nat_morph_N, constants [natcst],
+   preprocess [natprering], postprocess [natpostring]).
 
diff --git a/plugins/setoid_ring/Field_theory.v b/plugins/setoid_ring/Field_theory.v
index 56b985aa3..462ffde31 100644
--- a/plugins/setoid_ring/Field_theory.v
+++ b/plugins/setoid_ring/Field_theory.v
@@ -56,11 +56,16 @@ Let rI_neq_rO := AFth.(AF_1_neq_0).
 Let rdiv_def := AFth.(AFdiv_def).
 Let rinv_l := AFth.(AFinv_l).
 
-Add Morphism radd : radd_ext. Proof. exact (Radd_ext Reqe). Qed.
-Add Morphism rmul : rmul_ext. Proof. exact (Rmul_ext Reqe). Qed.
-Add Morphism ropp : ropp_ext. Proof. exact (Ropp_ext Reqe). Qed.
-Add Morphism rsub : rsub_ext. Proof. exact (ARsub_ext Rsth Reqe ARth). Qed.
-Add Morphism rinv : rinv_ext. Proof. exact SRinv_ext. Qed.
+Add Morphism radd with signature (req ==> req ==> req) as radd_ext.
+Proof. exact (Radd_ext Reqe). Qed.
+Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext.
+Proof. exact (Rmul_ext Reqe). Qed.
+Add Morphism ropp with signature (req ==> req) as ropp_ext.
+Proof. exact (Ropp_ext Reqe). Qed.
+Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext.
+Proof. exact (ARsub_ext Rsth Reqe ARth). Qed.
+Add Morphism rinv with signature (req ==> req) as rinv_ext.
+Proof. exact SRinv_ext. Qed.
 
 Let eq_trans := Setoid.Seq_trans _ _ Rsth.
 Let eq_sym := Setoid.Seq_sym _ _ Rsth.
@@ -1607,11 +1612,18 @@ Section Complete.
   Notation "x / y " := (rdiv x y).  Notation "/ x" := (rinv x).
   Notation "x == y" := (req x y) (at level 70, no associativity).
  Variable Rsth : Setoid_Theory R req.
-   Add Setoid R req Rsth as R_setoid3.
+   Add Parametric Relation : R req
+     reflexivity  proved by Rsth.(@Equivalence_Reflexive _ _)
+     symmetry     proved by Rsth.(@Equivalence_Symmetric _ _)
+     transitivity proved by Rsth.(@Equivalence_Transitive _ _)
+    as R_setoid3.
  Variable Reqe : ring_eq_ext radd rmul ropp req.
-   Add Morphism radd : radd_ext3.  exact (Radd_ext Reqe). Qed.
-   Add Morphism rmul : rmul_ext3.  exact (Rmul_ext Reqe). Qed.
-   Add Morphism ropp : ropp_ext3.  exact (Ropp_ext Reqe). Qed.
+   Add Morphism radd with signature (req ==> req ==> req) as radd_ext3.
+   Proof. exact (Radd_ext Reqe). Qed.
+   Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext3.
+   Proof. exact (Rmul_ext Reqe). Qed.
+   Add Morphism ropp with signature (req ==> req) as ropp_ext3.
+   Proof. exact (Ropp_ext Reqe). Qed.
 
 Section AlmostField.
 
diff --git a/plugins/setoid_ring/InitialRing.v b/plugins/setoid_ring/InitialRing.v
index 98ffff432..8aa0b1c91 100644
--- a/plugins/setoid_ring/InitialRing.v
+++ b/plugins/setoid_ring/InitialRing.v
@@ -48,12 +48,19 @@ Section ZMORPHISM.
   Notation "x - y " := (rsub x y).  Notation "- x" := (ropp x).
   Notation "x == y" := (req x y).
   Variable Rsth : Setoid_Theory R req.
-     Add Setoid R req Rsth as R_setoid3.
+     Add Parametric Relation : R req
+       reflexivity  proved by Rsth.(@Equivalence_Reflexive _ _)
+       symmetry     proved by Rsth.(@Equivalence_Symmetric _ _)
+       transitivity proved by Rsth.(@Equivalence_Transitive _ _)
+      as R_setoid3.
      Ltac rrefl := gen_reflexivity Rsth.
  Variable Reqe : ring_eq_ext radd rmul ropp req.
-   Add Morphism radd : radd_ext3.  exact (Radd_ext Reqe). Qed.
-   Add Morphism rmul : rmul_ext3.  exact (Rmul_ext Reqe). Qed.
-   Add Morphism ropp : ropp_ext3.  exact (Ropp_ext Reqe). Qed.
+   Add Morphism radd with signature (req ==> req ==> req) as radd_ext3.
+   Proof. exact (Radd_ext Reqe). Qed.
+   Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext3.
+   Proof. exact (Rmul_ext Reqe). Qed.
+   Add Morphism ropp with signature (req ==> req) as ropp_ext3.
+   Proof. exact (Ropp_ext Reqe). Qed.
 
  Fixpoint gen_phiPOS1 (p:positive) : R :=
   match p with
@@ -103,7 +110,8 @@ Section ZMORPHISM.
 
  Section ALMOST_RING.
  Variable ARth : almost_ring_theory 0 1 radd rmul rsub ropp req.
-   Add Morphism rsub : rsub_ext3. exact (ARsub_ext Rsth Reqe ARth). Qed.
+   Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext3.
+   Proof. exact (ARsub_ext Rsth Reqe ARth). Qed.
    Ltac norm := gen_srewrite Rsth Reqe ARth.
    Ltac add_push := gen_add_push radd Rsth Reqe ARth.
 
@@ -151,7 +159,8 @@ Section ZMORPHISM.
 
  Variable Rth : ring_theory 0 1 radd rmul rsub ropp req.
  Let ARth := Rth_ARth Rsth Reqe Rth.
-   Add Morphism rsub : rsub_ext4. exact (ARsub_ext Rsth Reqe ARth). Qed.
+   Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext4.
+   Proof. exact (ARsub_ext Rsth Reqe ARth). Qed.
    Ltac norm := gen_srewrite Rsth Reqe ARth.
    Ltac add_push := gen_add_push radd Rsth Reqe ARth.
 
@@ -255,7 +264,11 @@ Section NMORPHISM.
   Notation "0" := rO.  Notation "1" := rI.
   Notation "x + y" := (radd x y).  Notation "x * y " := (rmul x y).
  Variable Rsth : Setoid_Theory R req.
-     Add Setoid R req Rsth as R_setoid4.
+     Add Parametric Relation : R req
+       reflexivity  proved by Rsth.(@Equivalence_Reflexive _ _)
+       symmetry     proved by Rsth.(@Equivalence_Symmetric _ _)
+       transitivity proved by Rsth.(@Equivalence_Transitive _ _)
+       as R_setoid4.
      Ltac rrefl := gen_reflexivity Rsth.
  Variable SReqe : sring_eq_ext radd rmul req.
  Variable SRth : semi_ring_theory 0 1 radd rmul req.
@@ -265,8 +278,10 @@ Section NMORPHISM.
  Let rsub := (@SRsub R radd).
   Notation "x - y " := (rsub x y).  Notation "- x" := (ropp x).
   Notation "x == y" := (req x y).
-   Add Morphism radd : radd_ext4.  exact (Radd_ext Reqe). Qed.
-   Add Morphism rmul : rmul_ext4.  exact (Rmul_ext Reqe). Qed.
+   Add Morphism radd with signature (req ==> req ==> req) as radd_ext4.
+   Proof. exact (Radd_ext Reqe). Qed.
+   Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext4.
+   Proof. exact (Rmul_ext Reqe). Qed.
    Ltac norm := gen_srewrite_sr Rsth Reqe ARth.
 
  Definition gen_phiN1 x :=
@@ -374,15 +389,23 @@ Section NWORDMORPHISM.
   Notation "x - y " := (rsub x y).  Notation "- x" := (ropp x).
   Notation "x == y" := (req x y).
   Variable Rsth : Setoid_Theory R req.
-     Add Setoid R req Rsth as R_setoid5.
+     Add Parametric Relation : R req
+       reflexivity  proved by Rsth.(@Equivalence_Reflexive _ _)
+       symmetry     proved by Rsth.(@Equivalence_Symmetric _ _)
+       transitivity proved by Rsth.(@Equivalence_Transitive _ _)
+      as R_setoid5.
      Ltac rrefl := gen_reflexivity Rsth.
  Variable Reqe : ring_eq_ext radd rmul ropp req.
-   Add Morphism radd : radd_ext5.  exact (Radd_ext Reqe). Qed.
-   Add Morphism rmul : rmul_ext5.  exact (Rmul_ext Reqe). Qed.
-   Add Morphism ropp : ropp_ext5.  exact (Ropp_ext Reqe). Qed.
+   Add Morphism radd with signature (req ==> req ==> req) as radd_ext5.
+   Proof. exact (Radd_ext Reqe). Qed.
+   Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext5.
+   Proof. exact (Rmul_ext Reqe). Qed.
+   Add Morphism ropp with signature (req ==> req) as ropp_ext5.
+   Proof. exact (Ropp_ext Reqe). Qed.
 
  Variable ARth : almost_ring_theory 0 1 radd rmul rsub ropp req.
-   Add Morphism rsub : rsub_ext7. exact (ARsub_ext Rsth Reqe ARth). Qed.
+   Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext7.
+   Proof. exact (ARsub_ext Rsth Reqe ARth). Qed.
    Ltac norm := gen_srewrite Rsth Reqe ARth.
    Ltac add_push := gen_add_push radd Rsth Reqe ARth.
 
@@ -555,12 +578,20 @@ Section GEN_DIV.
  Variable morph : ring_morph rO rI radd rmul rsub ropp req cO cI cadd cmul csub copp ceqb phi.
 
   (* Useful tactics *)
-  Add Setoid R req Rsth as R_set1.
+  Add Parametric Relation : R req
+    reflexivity  proved by Rsth.(@Equivalence_Reflexive _ _)
+    symmetry     proved by Rsth.(@Equivalence_Symmetric _ _)
+    transitivity proved by Rsth.(@Equivalence_Transitive _ _)
+   as R_set1.
  Ltac rrefl := gen_reflexivity Rsth.
-  Add Morphism radd : radd_ext.  exact (Radd_ext Reqe). Qed.
-  Add Morphism rmul : rmul_ext.  exact (Rmul_ext Reqe). Qed.
-  Add Morphism ropp : ropp_ext.  exact (Ropp_ext Reqe). Qed.
-  Add Morphism rsub : rsub_ext. exact (ARsub_ext Rsth Reqe ARth). Qed.
+  Add Morphism radd with signature (req ==> req ==> req) as radd_ext.
+  Proof. exact (Radd_ext Reqe). Qed.
+  Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext.
+  Proof. exact (Rmul_ext Reqe). Qed.
+  Add Morphism ropp with signature (req ==> req) as ropp_ext.
+  Proof. exact (Ropp_ext Reqe). Qed.
+  Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext.
+  Proof. exact (ARsub_ext Rsth Reqe ARth). Qed.
  Ltac rsimpl := gen_srewrite Rsth Reqe ARth.
 
  Definition triv_div x y :=
@@ -859,8 +890,3 @@ Ltac isZcst t :=
   (* *)
   | _ => constr:(false)
   end.
-
-
-
-
-
diff --git a/plugins/setoid_ring/Ring_polynom.v b/plugins/setoid_ring/Ring_polynom.v
index ac54d862c..a94f8d8df 100644
--- a/plugins/setoid_ring/Ring_polynom.v
+++ b/plugins/setoid_ring/Ring_polynom.v
@@ -59,10 +59,18 @@ Section MakeRingPol.
  Infix "?=!" := ceqb. Notation "[ x ]" := (phi x).
 
  (* Useful tactics *)
- Add Morphism radd : radd_ext. exact (Radd_ext Reqe). Qed.
- Add Morphism rmul : rmul_ext. exact (Rmul_ext Reqe). Qed.
- Add Morphism ropp : ropp_ext. exact (Ropp_ext Reqe). Qed.
- Add Morphism rsub : rsub_ext. exact (ARsub_ext Rsth Reqe ARth). Qed.
+ Add Morphism radd with signature (req ==> req ==> req) as radd_ext.
+ Proof. exact (Radd_ext Reqe). Qed.
+
+ Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext.
+ Proof. exact (Rmul_ext Reqe). Qed.
+
+ Add Morphism ropp with signature (req ==> req) as ropp_ext.
+ Proof. exact (Ropp_ext Reqe). Qed.
+
+ Add Morphism rsub with signature (req ==> req ==> req) as rsub_ext.
+ Proof. exact (ARsub_ext Rsth Reqe ARth). Qed.
+
  Ltac rsimpl := gen_srewrite Rsth Reqe ARth.
 
  Ltac add_push := gen_add_push radd Rsth Reqe ARth.
diff --git a/plugins/setoid_ring/Ring_tac.v b/plugins/setoid_ring/Ring_tac.v
index 329fa0ee8..36d1e7c54 100644
--- a/plugins/setoid_ring/Ring_tac.v
+++ b/plugins/setoid_ring/Ring_tac.v
@@ -460,4 +460,4 @@ Tactic Notation "ring_simplify" "["constr_list(lH)"]" constr_list(rl) "in" hyp(H
   intro H';
   move H' after H;
   clear H;rename H' into H;
-  unfold g;clear g.
\ No newline at end of file
+  unfold g;clear g.
diff --git a/plugins/setoid_ring/Ring_theory.v b/plugins/setoid_ring/Ring_theory.v
index 8dda5ecd3..14aead045 100644
--- a/plugins/setoid_ring/Ring_theory.v
+++ b/plugins/setoid_ring/Ring_theory.v
@@ -254,12 +254,16 @@ Section ALMOST_RING.
  Section SEMI_RING.
  Variable SReqe : sring_eq_ext radd rmul req.
 
-   Add Morphism radd : radd_ext1.  exact (SRadd_ext SReqe). Qed.
-   Add Morphism rmul : rmul_ext1.  exact (SRmul_ext SReqe). Qed.
+   Add Morphism radd with signature (req ==> req ==> req) as radd_ext1.
+   Proof. exact (SRadd_ext SReqe). Qed.
+
+   Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext1.
+   Proof. exact (SRmul_ext SReqe). Qed.
+
  Variable SRth : semi_ring_theory 0 1 radd rmul req.
 
  (** Every semi ring can be seen as an almost ring, by taking :
-        -x = x and x - y = x + y *)
+        [-x = x] and [x - y = x + y] *)
  Definition SRopp (x:R) := x. Notation "- x" := (SRopp x).
 
  Definition SRsub x y := x + -y. Infix "-" := SRsub.
@@ -323,9 +327,15 @@ Section ALMOST_RING.
  Notation "- x" := (ropp x).
 
  Variable Reqe : ring_eq_ext radd rmul ropp req.
-   Add Morphism radd : radd_ext2.  exact (Radd_ext Reqe). Qed.
-   Add Morphism rmul : rmul_ext2.  exact (Rmul_ext Reqe). Qed.
-   Add Morphism ropp : ropp_ext2.  exact (Ropp_ext Reqe). Qed.
+
+   Add Morphism radd with signature (req ==> req ==> req) as radd_ext2.
+   Proof. exact (Radd_ext Reqe). Qed.
+
+   Add Morphism rmul with signature (req ==> req ==> req) as rmul_ext2.
+   Proof. exact (Rmul_ext Reqe). Qed.
+
+   Add Morphism ropp with signature (req ==> req) as ropp_ext2.
+   Proof. exact (Ropp_ext Reqe). Qed.
 
  Section RING.
  Variable Rth : ring_theory 0 1 radd rmul rsub ropp req.
@@ -393,14 +403,29 @@ Section ALMOST_RING.
   Notation "?=!" := ceqb. Notation "[ x ]" := (phi x).
  Variable Csth : Equivalence ceq.
  Variable Ceqe : ring_eq_ext cadd cmul copp ceq.
-   Add Setoid C ceq Csth as C_setoid.
-   Add Morphism cadd : cadd_ext.  exact (Radd_ext Ceqe). Qed.
-   Add Morphism cmul : cmul_ext.  exact (Rmul_ext Ceqe). Qed.
-   Add Morphism copp : copp_ext.  exact (Ropp_ext Ceqe). Qed.
+
+   Add Parametric Relation : C ceq
+     reflexivity  proved by Csth.(@Equivalence_Reflexive _ _)
+     symmetry     proved by Csth.(@Equivalence_Symmetric _ _)
+     transitivity proved by Csth.(@Equivalence_Transitive _ _)
+    as C_setoid.
+
+   Add Morphism cadd with signature (ceq ==> ceq ==> ceq) as cadd_ext.
+   Proof. exact (Radd_ext Ceqe). Qed.
+
+   Add Morphism cmul with signature (ceq ==> ceq ==> ceq) as cmul_ext.
+   Proof. exact (Rmul_ext Ceqe). Qed.
+
+   Add Morphism copp with signature (ceq ==> ceq) as copp_ext.
+   Proof. exact (Ropp_ext Ceqe). Qed.
+
  Variable Cth : ring_theory cO cI cadd cmul csub copp ceq.
  Variable Smorph : semi_morph 0 1 radd rmul req cO cI cadd cmul ceqb phi.
  Variable phi_ext : forall x y, ceq x y -> [x] == [y].
-   Add Morphism phi : phi_ext1.  exact phi_ext. Qed.
+
+   Add Morphism phi with signature (ceq ==> req) as phi_ext1.
+   Proof. exact phi_ext. Qed.
+
  Lemma Smorph_opp x : [-!x] == -[x].
  Proof.
   rewrite <-  (Rth.(Radd_0_l) [-!x]).
diff --git a/plugins/setoid_ring/g_newring.ml4 b/plugins/setoid_ring/g_newring.ml4
index 05ab8ab32..b34d12952 100644
--- a/plugins/setoid_ring/g_newring.ml4
+++ b/plugins/setoid_ring/g_newring.ml4
@@ -6,8 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Ltac_plugin
 open Pp
 open Util
@@ -82,10 +80,11 @@ VERNAC COMMAND EXTEND AddSetoidRing CLASSIFIED AS SIDEFF
   | [ "Print" "Rings" ] => [Vernac_classifier.classify_as_query] -> [
     Feedback.msg_notice (strbrk "The following ring structures have been declared:");
     Spmap.iter (fun fn fi ->
+      let sigma, env = Pfedit.get_current_context () in
       Feedback.msg_notice (hov 2
         (Ppconstr.pr_id (Libnames.basename fn)++spc()++
-          str"with carrier "++ pr_constr fi.ring_carrier++spc()++
-          str"and equivalence relation "++ pr_constr fi.ring_req))
+          str"with carrier "++ pr_constr_env env sigma fi.ring_carrier++spc()++
+          str"and equivalence relation "++ pr_constr_env env sigma fi.ring_req))
     ) !from_name ]
 END
 
@@ -117,10 +116,11 @@ VERNAC COMMAND EXTEND AddSetoidField CLASSIFIED AS SIDEFF
 | [ "Print" "Fields" ] => [Vernac_classifier.classify_as_query] -> [
     Feedback.msg_notice (strbrk "The following field structures have been declared:");
     Spmap.iter (fun fn fi ->
+      let sigma, env = Pfedit.get_current_context () in
       Feedback.msg_notice (hov 2
         (Ppconstr.pr_id (Libnames.basename fn)++spc()++
-          str"with carrier "++ pr_constr fi.field_carrier++spc()++
-          str"and equivalence relation "++ pr_constr fi.field_req))
+          str"with carrier "++ pr_constr_env env sigma fi.field_carrier++spc()++
+          str"and equivalence relation "++ pr_constr_env env sigma fi.field_req))
     ) !field_from_name ]
 END
 
diff --git a/plugins/setoid_ring/newring.ml b/plugins/setoid_ring/newring.ml
index 0f996c65a..125afb1a0 100644
--- a/plugins/setoid_ring/newring.ml
+++ b/plugins/setoid_ring/newring.ml
@@ -10,7 +10,7 @@ open Ltac_plugin
 open Pp
 open Util
 open Names
-open Term
+open Constr
 open EConstr
 open Vars
 open CClosure
@@ -58,13 +58,13 @@ let rec mk_clos_but f_map subs t =
   match f_map (global_of_constr_nofail t) with
     | Some map -> tag_arg (mk_clos_but f_map subs) map subs (-1) t
     | None ->
-        (match kind_of_term t with
+        (match Constr.kind t with
             App(f,args) -> mk_clos_app_but f_map subs f args 0
           | Prod _ -> mk_clos_deep (mk_clos_but f_map) subs t
           | _ -> mk_atom t)
 
 and mk_clos_app_but f_map subs f args n =
-  let open Term in
+  let open Constr in
   if n >= Array.length args then mk_atom(mkApp(f, args))
   else
     let fargs, args' = Array.chop n args in
@@ -131,7 +131,7 @@ let closed_term_ast l =
   let l = List.map (fun gr -> ArgArg(Loc.tag gr)) l in
   TacFun([Name(Id.of_string"t")],
   TacML(Loc.tag (tacname,
-  [TacGeneric (Genarg.in_gen (Genarg.glbwit Stdarg.wit_constr) (CAst.make @@ GVar(Id.of_string"t"),None));
+  [TacGeneric (Genarg.in_gen (Genarg.glbwit Stdarg.wit_constr) (DAst.make @@ GVar(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"
@@ -150,13 +150,14 @@ let ic_unsafe c = (*FIXME remove *)
   let sigma = Evd.from_env env in
     EConstr.of_constr (fst (Constrintern.interp_constr env sigma c))
 
-let decl_constant na ctx c =
-  let open Term in
-  let vars = Univops.universes_of_constr c in
-  let ctx = Univops.restrict_universe_context (Univ.ContextSet.of_context ctx) vars in
+let decl_constant na univs c =
+  let open Constr in
+  let env = Global.env () in
+  let vars = Univops.universes_of_constr env c in
+  let univs = Univops.restrict_universe_context univs vars in
+  let univs = Monomorphic_const_entry univs in
   mkConst(declare_constant (Id.of_string na) 
-	    (DefinitionEntry (definition_entry ~opaque:true
-				~univs:(Univ.ContextSet.to_context ctx) c),
+            (DefinitionEntry (definition_entry ~opaque:true ~univs c),
 	     IsProof Lemma))
 
 (* Calling a global tactic *)
@@ -165,12 +166,12 @@ let ltac_call tac (args:glob_tactic_arg list) =
 
 (* Calling a locally bound tactic *)
 let ltac_lcall tac args =
-  TacArg(Loc.tag @@ TacCall (Loc.tag (ArgVar(Loc.tag @@ Id.of_string tac),args)))
+  TacArg(Loc.tag @@ TacCall (Loc.tag (ArgVar CAst.(make @@ Id.of_string tac),args)))
 
 let ltac_apply (f : Value.t) (args: Tacinterp.Value.t list) =
   let fold arg (i, vars, lfun) =
     let id = Id.of_string ("x" ^ string_of_int i) in
-    let x = Reference (ArgVar (Loc.tag id)) in
+    let x = Reference (ArgVar CAst.(make id)) in
     (succ i, x :: vars, Id.Map.add id arg lfun)
   in
   let (_, args, lfun) = List.fold_right fold args (0, [], Id.Map.empty) in
@@ -205,7 +206,7 @@ let get_res =
 let exec_tactic env evd n f args =
   let fold arg (i, vars, lfun) =
     let id = Id.of_string ("x" ^ string_of_int i) in
-    let x = Reference (ArgVar (Loc.tag id)) in
+    let x = Reference (ArgVar CAst.(make id)) in
     (succ i, x :: vars, Id.Map.add id (Value.of_constr arg) lfun)
   in
   let (_, args, lfun) = List.fold_right fold args (0, [], Id.Map.empty) in
@@ -220,7 +221,7 @@ let exec_tactic env evd n f args =
   let gls = Proofview.V82.of_tactic (Tacinterp.eval_tactic_ist ist (ltac_call f (args@[getter]))) gl in
   let evd, nf = Evarutil.nf_evars_and_universes (Refiner.project gls) in
   let nf c = nf (constr_of c) in
-  Array.map nf !tactic_res, snd (Evd.universe_context evd)
+  Array.map nf !tactic_res, Evd.universe_context_set evd
 
 let stdlib_modules =
   [["Coq";"Setoids";"Setoid"];
@@ -344,13 +345,7 @@ let _ = add_map "ring"
 (****************************************************************************)
 (* Ring database *)
 
-let pr_constr c = pr_econstr c
-
-module M = struct
-  type t = Term.constr
-  let compare = Term.compare
-end
-module Cmap = Map.Make(M)
+module Cmap = Map.Make(Constr)
 
 let from_carrier = Summary.ref Cmap.empty ~name:"ring-tac-carrier-table"
 let from_name = Summary.ref Spmap.empty ~name:"ring-tac-name-table"
@@ -372,7 +367,7 @@ let find_ring_structure env sigma l =
         with Not_found ->
           CErrors.user_err ~hdr:"ring"
             (str"cannot find a declared ring structure over"++
-             spc()++str"\""++pr_constr ty++str"\""))
+             spc() ++ str"\"" ++ pr_econstr_env env sigma ty ++ str"\""))
     | [] -> assert false
 
 let add_entry (sp,_kn) e =
@@ -395,7 +390,7 @@ let subst_th (subst,th) =
   let posttac'= Tacsubst.subst_tactic subst th.ring_post_tac in
   if c' == th.ring_carrier &&
      eq' == th.ring_req &&
-     Term.eq_constr set' th.ring_setoid &&
+     Constr.equal set' th.ring_setoid &&
      ext' == th.ring_ext &&
      morph' == th.ring_morph &&
      th' == th.ring_th &&
@@ -533,19 +528,19 @@ let ring_equality env evd (r,add,mul,opp,req) =
 		  op_morph r add mul opp req add_m_lem mul_m_lem opp_m_lem in
 		  Flags.if_verbose
 		    Feedback.msg_info
-		    (str"Using setoid \""++pr_constr req++str"\""++spc()++
-			str"and morphisms \""++pr_constr add_m_lem ++
-			str"\","++spc()++ str"\""++pr_constr mul_m_lem++
-			str"\""++spc()++str"and \""++pr_constr opp_m_lem++
+                    (str"Using setoid \""++ pr_econstr_env env !evd req++str"\""++spc()++
+                        str"and morphisms \""++pr_econstr_env env !evd add_m_lem ++
+                        str"\","++spc()++ str"\""++pr_econstr_env env !evd mul_m_lem++
+                        str"\""++spc()++str"and \""++pr_econstr_env env !evd opp_m_lem++
 			str"\"");
 		  op_morph)
             | None ->
 		(Flags.if_verbose
 		    Feedback.msg_info
-		    (str"Using setoid \""++pr_constr req ++str"\"" ++ spc() ++
-			str"and morphisms \""++pr_constr add_m_lem ++
+                    (str"Using setoid \""++pr_econstr_env env !evd req ++str"\"" ++ spc() ++
+                        str"and morphisms \""++pr_econstr_env env !evd add_m_lem ++
 			str"\""++spc()++str"and \""++
-			pr_constr mul_m_lem++str"\"");
+                        pr_econstr_env env !evd mul_m_lem++str"\"");
 		 op_smorph r add mul req add_m_lem mul_m_lem) in
           (setoid,op_morph)
 
@@ -865,7 +860,7 @@ let find_field_structure env sigma l =
         with Not_found ->
           CErrors.user_err ~hdr:"field"
             (str"cannot find a declared field structure over"++
-             spc()++str"\""++pr_constr ty++str"\""))
+             spc()++str"\""++pr_econstr_env env sigma ty++str"\""))
     | [] -> assert false
 
 let add_field_entry (sp,_kn) e =
@@ -933,7 +928,7 @@ let field_equality evd r inv req =
 	  inv_m_lem
 
 let add_field_theory0 name fth eqth morphth cst_tac inj (pre,post) power sign odiv =
-  let open Term in
+  let open Constr in
   check_required_library (cdir@["Field_tac"]);
   let (sigma,fth) = ic fth in
   let env = Global.env() in
diff --git a/plugins/setoid_ring/newring_ast.mli b/plugins/setoid_ring/newring_ast.mli
index d37582bd7..c26fcc8d1 100644
--- a/plugins/setoid_ring/newring_ast.mli
+++ b/plugins/setoid_ring/newring_ast.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Term
+open Constr
 open Libnames
 open Constrexpr
 open Tacexpr
diff --git a/plugins/ssr/ssrbwd.ml b/plugins/ssr/ssrbwd.ml
index cc0e86684..c29a1fe7c 100644
--- a/plugins/ssr/ssrbwd.ml
+++ b/plugins/ssr/ssrbwd.ml
@@ -42,10 +42,10 @@ let interp_agen ist gl ((goclr, _), (k, gc as c)) (clr, rcs) =
   | Some ghyps ->
     let clr' = snd (interp_hyps ist gl ghyps) @ clr in
     if k <> xNoFlag then clr', rcs' else
-    let open CAst in
-    match rc with
-    | { loc; v = GVar id } when not_section_id id -> SsrHyp (Loc.tag ?loc id) :: clr', rcs'
-    | { loc; v = GRef (VarRef id, _) } when not_section_id id ->
+    let loc = rc.CAst.loc in
+    match DAst.get rc with
+    | GVar id when not_section_id id -> SsrHyp (Loc.tag ?loc id) :: clr', rcs'
+    | GRef (VarRef id, _) when not_section_id id ->
         SsrHyp (Loc.tag ?loc id) :: clr', rcs'
     | _ -> clr', rcs'
 
@@ -68,9 +68,8 @@ let pf_match = pf_apply (fun e s c t -> understand_tcc e s ~expected_type:t c)
 
 let apply_rconstr ?ist t gl =
 (* ppdebug(lazy(str"sigma@apply_rconstr=" ++ pr_evar_map None (project gl))); *)
-  let open CAst in
-  let n = match ist, t with
-    | None, { v = GVar id | GRef (VarRef id,_) } -> pf_nbargs gl (EConstr.mkVar id)
+  let n = match ist, DAst.get t with
+    | None, (GVar id | GRef (VarRef id,_)) -> pf_nbargs gl (EConstr.mkVar id)
     | Some ist, _ -> interp_nbargs ist gl t
     | _ -> anomaly "apply_rconstr without ist and not RVar" in
   let mkRlemma i = mkRApp t (mkRHoles i) in
diff --git a/plugins/ssr/ssrcommon.ml b/plugins/ssr/ssrcommon.ml
index 799e969ae..4ae746288 100644
--- a/plugins/ssr/ssrcommon.ml
+++ b/plugins/ssr/ssrcommon.ml
@@ -12,6 +12,7 @@ open Util
 open Names
 open Evd
 open Term
+open Constr
 open Termops
 open Printer
 open Locusops
@@ -176,24 +177,26 @@ open Globnames
 open Misctypes
 open Decl_kinds
 
-let mkRHole = CAst.make @@ GHole (Evar_kinds.InternalHole, IntroAnonymous, None)
+let mkRHole = DAst.make @@ GHole (Evar_kinds.InternalHole, IntroAnonymous, None)
 
 let rec mkRHoles n = if n > 0 then mkRHole :: mkRHoles (n - 1) else []
-let rec isRHoles = function { CAst.v = GHole _ } :: cl -> isRHoles cl | cl -> cl = []
-let mkRApp f args = if args = [] then f else CAst.make @@ GApp (f, args)
-let mkRVar id = CAst.make @@ GRef (VarRef id,None)
-let mkRltacVar id = CAst.make @@ GVar (id)
-let mkRCast rc rt =  CAst.make @@ GCast (rc, CastConv rt)
-let mkRType =  CAst.make @@ GSort (GType [])
-let mkRProp =  CAst.make @@ GSort (GProp)
-let mkRArrow rt1 rt2 = CAst.make @@ GProd (Anonymous, Explicit, rt1, rt2)
-let mkRConstruct c = CAst.make @@ GRef (ConstructRef c,None)
-let mkRInd mind = CAst.make @@ GRef (IndRef mind,None)
-let mkRLambda n s t = CAst.make @@ GLambda (n, Explicit, s, t)
+let rec isRHoles cl = match cl with
+| [] -> true
+| c :: l -> match DAst.get c with GHole _ -> isRHoles l | _ -> false
+let mkRApp f args = if args = [] then f else DAst.make @@ GApp (f, args)
+let mkRVar id = DAst.make @@ GRef (VarRef id,None)
+let mkRltacVar id = DAst.make @@ GVar (id)
+let mkRCast rc rt =  DAst.make @@ GCast (rc, CastConv rt)
+let mkRType =  DAst.make @@ GSort (GType [])
+let mkRProp =  DAst.make @@ GSort (GProp)
+let mkRArrow rt1 rt2 = DAst.make @@ GProd (Anonymous, Explicit, rt1, rt2)
+let mkRConstruct c = DAst.make @@ GRef (ConstructRef c,None)
+let mkRInd mind = DAst.make @@ GRef (IndRef mind,None)
+let mkRLambda n s t = DAst.make @@ GLambda (n, Explicit, s, t)
 
 let rec mkRnat n =
-  if n <= 0 then CAst.make @@ GRef (Coqlib.glob_O, None) else
-  mkRApp (CAst.make @@ GRef (Coqlib.glob_S, None)) [mkRnat (n - 1)]
+  if n <= 0 then DAst.make @@ GRef (Coqlib.glob_O, None) else
+  mkRApp (DAst.make @@ GRef (Coqlib.glob_S, None)) [mkRnat (n - 1)]
 
 let glob_constr ist genv = function
   | _, Some ce ->
@@ -225,7 +228,7 @@ let isAppInd gl c =
 let interp_refine ist gl rc =
   let constrvars = Tacinterp.extract_ltac_constr_values ist (pf_env gl) in
   let vars = { Glob_ops.empty_lvar with
-    Glob_term.ltac_constrs = constrvars; ltac_genargs = ist.Tacinterp.lfun
+    Ltac_pretype.ltac_constrs = constrvars; ltac_genargs = ist.Tacinterp.lfun
   } in
   let kind = Pretyping.OfType (pf_concl gl) in
   let flags = {
@@ -237,7 +240,7 @@ let interp_refine ist gl rc =
   in
   let sigma, c = Pretyping.understand_ltac flags (pf_env gl) (project gl) vars kind rc in
 (*   ppdebug(lazy(str"sigma@interp_refine=" ++ pr_evar_map None sigma)); *)
-  ppdebug(lazy(str"c@interp_refine=" ++ Printer.pr_econstr c));
+  ppdebug(lazy(str"c@interp_refine=" ++ Printer.pr_econstr_env (pf_env gl) sigma c));
   (sigma, (sigma, c))
 
 
@@ -265,7 +268,7 @@ let interp_wit wit ist gl x =
   sigma, Tacinterp.Value.cast (topwit wit) arg
 
 let interp_hyp ist gl (SsrHyp (loc, id)) =
-  let s, id' = interp_wit wit_var ist gl (loc, id) in
+  let s, id' = interp_wit wit_var ist gl CAst.(make ?loc id) in
   if not_section_id id' then s, SsrHyp (loc, id') else
   hyp_err ?loc "Can't clear section hypothesis " id'
 
@@ -463,7 +466,6 @@ let ssrevaltac ist gtac =
 (* but stripping global ones. We use the variable names to encode the    *)
 (* the number of dependencies, so that the transformation is reversible. *)
 
-open Term
 let env_size env = List.length (Environ.named_context env)
 
 let pf_concl gl = EConstr.Unsafe.to_constr (pf_concl gl)
@@ -489,23 +491,23 @@ let pf_abs_evars2 gl rigid (sigma, c0) =
     | NamedDecl.LocalAssum (x,t) -> mkNamedProd x t c in
     let t = Context.Named.fold_inside abs_dc ~init:evi.evar_concl dc in
     nf_evar sigma t in
-  let rec put evlist c = match kind_of_term c with
+  let rec put evlist c = match Constr.kind c with
   | Evar (k, a) ->  
     if List.mem_assoc k evlist || Evd.mem sigma0 k || List.mem k rigid then evlist else
     let n = max 0 (Array.length a - nenv) in
     let t = abs_evar n k in (k, (n, t)) :: put evlist t
-  | _ -> fold_constr put evlist c in
+  | _ -> Constr.fold put evlist c in
   let evlist = put [] c0 in
   if evlist = [] then 0, EConstr.of_constr c0,[], ucst else
   let rec lookup k i = function
     | [] -> 0, 0
     | (k', (n, _)) :: evl -> if k = k' then i, n else lookup k (i + 1) evl in
-  let rec get i c = match kind_of_term c with
+  let rec get i c = match Constr.kind c with
   | Evar (ev, a) ->
     let j, n = lookup ev i evlist in
-    if j = 0 then map_constr (get i) c else if n = 0 then mkRel j else
+    if j = 0 then Constr.map (get i) c else if n = 0 then mkRel j else
     mkApp (mkRel j, Array.init n (fun k -> get i a.(n - 1 - k)))
-  | _ -> map_constr_with_binders ((+) 1) get i c in
+  | _ -> Constr.map_with_binders ((+) 1) get i c in
   let rec loop c i = function
   | (_, (n, t)) :: evl ->
     loop (mkLambda (mk_evar_name n, get (i - 1) t, c)) (i - 1) evl
@@ -537,7 +539,7 @@ module Intset = Evar.Set
 
 let pf_abs_evars_pirrel gl (sigma, c0) =
   pp(lazy(str"==PF_ABS_EVARS_PIRREL=="));
-  pp(lazy(str"c0= " ++ Printer.pr_constr c0));
+  pp(lazy(str"c0= " ++ Printer.pr_constr_env (pf_env gl) sigma c0));
   let sigma0 = project gl in
   let c0 = nf_evar sigma0 (nf_evar sigma c0) in
   let nenv = env_size (pf_env gl) in
@@ -549,7 +551,7 @@ let pf_abs_evars_pirrel gl (sigma, c0) =
     | NamedDecl.LocalAssum (x,t) -> mkNamedProd x t c in
     let t = Context.Named.fold_inside abs_dc ~init:evi.evar_concl dc in
     nf_evar sigma0 (nf_evar sigma t) in
-  let rec put evlist c = match kind_of_term c with
+  let rec put evlist c = match Constr.kind c with
   | Evar (k, a) ->  
     if List.mem_assoc k evlist || Evd.mem sigma0 k then evlist else
     let n = max 0 (Array.length a - nenv) in
@@ -558,12 +560,12 @@ let pf_abs_evars_pirrel gl (sigma, c0) =
         (pf_env gl) sigma (EConstr.of_constr (Evd.evar_concl (Evd.find sigma k))) in
     let is_prop = k_ty = InProp in
     let t = abs_evar n k in (k, (n, t, is_prop)) :: put evlist t
-  | _ -> fold_constr put evlist c in
+  | _ -> Constr.fold put evlist c in
   let evlist = put [] c0 in
   if evlist = [] then 0, c0 else
-  let pr_constr t = Printer.pr_econstr (Reductionops.nf_beta (project gl) (EConstr.of_constr t)) in
+  let pr_constr t = Printer.pr_econstr_env (pf_env gl) sigma (Reductionops.nf_beta (pf_env gl) (project gl) (EConstr.of_constr t)) in
   pp(lazy(str"evlist=" ++ pr_list (fun () -> str";")
-    (fun (k,_) -> str(Evd.string_of_existential k)) evlist));
+    (fun (k,_) -> Evar.print k) evlist));
   let evplist = 
     let depev = List.fold_left (fun evs (_,(_,t,_)) -> 
         let t = EConstr.of_constr t in
@@ -586,17 +588,17 @@ let pf_abs_evars_pirrel gl (sigma, c0) =
   let rec lookup k i = function
     | [] -> 0, 0
     | (k', (n,_,_)) :: evl -> if k = k' then i,n else lookup k (i + 1) evl in
-  let rec get evlist i c = match kind_of_term c with
+  let rec get evlist i c = match Constr.kind c with
   | Evar (ev, a) ->
     let j, n = lookup ev i evlist in
-    if j = 0 then map_constr (get evlist i) c else if n = 0 then mkRel j else
+    if j = 0 then Constr.map (get evlist i) c else if n = 0 then mkRel j else
     mkApp (mkRel j, Array.init n (fun k -> get evlist i a.(n - 1 - k)))
-  | _ -> map_constr_with_binders ((+) 1) (get evlist) i c in
+  | _ -> Constr.map_with_binders ((+) 1) (get evlist) i c in
   let rec app extra_args i c = match decompose_app c with
   | hd, args when isRel hd && destRel hd = i ->
       let j = destRel hd in
       mkApp (mkRel j, Array.of_list (List.map (Vars.lift (i-1)) extra_args @ args))
-  | _ -> map_constr_with_binders ((+) 1) (app extra_args) i c in
+  | _ -> Constr.map_with_binders ((+) 1) (app extra_args) i c in
   let rec loopP evlist c i = function
   | (_, (n, t, _)) :: evl ->
     let t = get evlist (i - 1) t in
@@ -643,7 +645,7 @@ let pf_abs_cterm gl n c0 =
   let c0 = EConstr.Unsafe.to_constr c0 in
   let noargs = [|0|] in
   let eva = Array.make n noargs in
-  let rec strip i c = match kind_of_term c with
+  let rec strip i c = match Constr.kind c with
   | App (f, a) when isRel f ->
     let j = i - destRel f in
     if j >= n || eva.(j) = noargs then mkApp (f, Array.map (strip i) a) else
@@ -651,8 +653,8 @@ let pf_abs_cterm gl n c0 =
     let nd = Array.length dp - 1 in
     let mkarg k = strip i a.(if k < nd then dp.(k + 1) - j else k + dp.(0)) in
     mkApp (f, Array.init (Array.length a - dp.(0)) mkarg)
-  | _ -> map_constr_with_binders ((+) 1) strip i c in
-  let rec strip_ndeps j i c = match kind_of_term c with
+  | _ -> Constr.map_with_binders ((+) 1) strip i c in
+  let rec strip_ndeps j i c = match Constr.kind c with
   | Prod (x, t, c1) when i < j ->
     let dl, c2 = strip_ndeps j (i + 1) c1 in
     if Vars.noccurn 1 c2 then dl, Vars.lift (-1) c2 else
@@ -663,7 +665,7 @@ let pf_abs_cterm gl n c0 =
     if Vars.noccurn 1 c2 then dl, Vars.lift (-1) c2 else
     i :: dl, mkLetIn (x, strip i b, strip i t, c2)
   | _ -> [], strip i c in
-  let rec strip_evars i c = match kind_of_term c with
+  let rec strip_evars i c = match Constr.kind c with
     | Lambda (x, t1, c1) when i < n ->
       let na = nb_evar_deps x in
       let dl, t2 = strip_ndeps (i + na) i t1 in
@@ -710,7 +712,7 @@ let mkSsrRef name =
   try locate_reference (ssrqid name) with Not_found ->
   try locate_reference (ssrtopqid name) with Not_found ->
   CErrors.user_err (Pp.str "Small scale reflection library not loaded")
-let mkSsrRRef name = (CAst.make @@ GRef (mkSsrRef name,None)), None
+let mkSsrRRef name = (DAst.make @@ GRef (mkSsrRef name,None)), None
 let mkSsrConst name env sigma =
   EConstr.fresh_global env sigma (mkSsrRef name)
 let pf_mkSsrConst name gl =
@@ -743,7 +745,7 @@ let discharge_hyp (id', (id, mode)) gl =
   let cl' = Vars.subst_var id (pf_concl gl) in
   match pf_get_hyp gl id, mode with
   | NamedDecl.LocalAssum (_, t), _ | NamedDecl.LocalDef (_, _, t), "(" ->
-     Proofview.V82.of_tactic (Tactics.apply_type (EConstr.of_constr (mkProd (Name id', t, cl')))
+     Proofview.V82.of_tactic (Tactics.apply_type ~typecheck:false (EConstr.of_constr (mkProd (Name id', t, cl')))
        [EConstr.of_constr (mkVar id)]) gl
   | NamedDecl.LocalDef (_, v, t), _ ->
      Proofview.V82.of_tactic
@@ -758,7 +760,7 @@ let clear_with_wilds wilds clr0 gl =
     let id = NamedDecl.get_id nd in
     if List.mem id clr || not (List.mem id wilds) then clr else
     let vars = Termops.global_vars_set_of_decl (pf_env gl) (project gl) nd in
-    let occurs id' = Idset.mem id' vars in
+    let occurs id' = Id.Set.mem id' vars in
     if List.exists occurs clr then id :: clr else clr in
   Proofview.V82.of_tactic (Tactics.clear (Context.Named.fold_inside extend_clr ~init:clr0 (Tacmach.pf_hyps gl))) gl
 
@@ -812,8 +814,8 @@ let ssr_n_tac seed n gl =
   let name = if n = -1 then seed else ("ssr" ^ seed ^ string_of_int n) in
   let fail msg = CErrors.user_err (Pp.str msg) in
   let tacname = 
-    try Nametab.locate_tactic (Libnames.qualid_of_ident (Id.of_string name))
-    with Not_found -> try Nametab.locate_tactic (ssrqid name)
+    try Tacenv.locate_tactic (Libnames.qualid_of_ident (Id.of_string name))
+    with Not_found -> try Tacenv.locate_tactic (ssrqid name)
     with Not_found ->
       if n = -1 then fail "The ssreflect library was not loaded"
       else fail ("The tactic "^name^" was not found") in
@@ -833,9 +835,9 @@ let rec mkCHoles ?loc n =
   if n <= 0 then [] else (CAst.make ?loc @@ CHole (None, IntroAnonymous, None)) :: mkCHoles ?loc (n - 1)
 let mkCHole loc = CAst.make ?loc @@ CHole (None, IntroAnonymous, None)
 let mkCLambda ?loc name ty t =  CAst.make ?loc @@
-   CLambdaN ([[loc, name], Default Explicit, ty], t)
+   CLambdaN ([CLocalAssum([CAst.make ?loc name], Default Explicit, ty)], t)
 let mkCArrow ?loc ty t = CAst.make ?loc @@
-   CProdN ([[Loc.tag Anonymous], Default Explicit, ty], t)
+   CProdN ([CLocalAssum([CAst.make Anonymous], Default Explicit, ty)], t)
 let mkCCast ?loc t ty = CAst.make ?loc @@ CCast (t, CastConv ty)
 
 let rec isCHoles = function { CAst.v = CHole _ } :: cl -> isCHoles cl | cl -> cl = []
@@ -845,15 +847,15 @@ let pf_interp_ty ?(resolve_typeclasses=false) ist gl ty =
    let n_binders = ref 0 in
    let ty = match ty with
    | a, (t, None) ->
-    let rec force_type ty = CAst.(map (function
+    let rec force_type ty = DAst.(map (function
      | GProd (x, k, s, t) -> incr n_binders; GProd (x, k, s, force_type t)
      | GLetIn (x, v, oty, t) -> incr n_binders; GLetIn (x, v, oty, force_type t)
-     | _ -> (mkRCast ty mkRType).v)) ty in
+     | _ -> DAst.get (mkRCast ty mkRType))) ty in
      a, (force_type t, None)
    | _, (_, Some ty) ->
     let rec force_type ty = CAst.(map (function
      | CProdN (abs, t) ->
-       n_binders := !n_binders +  List.length (List.flatten (List.map pi1 abs));
+       n_binders := !n_binders + List.length (List.flatten (List.map (function CLocalAssum (nal,_,_) -> nal | CLocalDef (na,_,_) -> [na] | CLocalPattern _ -> (* We count a 'pat for 1; TO BE CHECKED *) [CAst.make Name.Anonymous]) abs));
        CProdN (abs, force_type t)
      | CLetIn (n, v, oty, t) -> incr n_binders; CLetIn (n, v, oty, force_type t)
      | _ -> (mkCCast ty (mkCType None)).v)) ty in
@@ -892,7 +894,7 @@ let saturate ?(beta=false) ?(bi_types=false) env sigma c ?(ty=Retyping.get_type_
       let sigma = create_evar_defs sigma in
       let (sigma, x) =
         Evarutil.new_evar env sigma
-          (if bi_types then Reductionops.nf_betaiota sigma src else src) in
+          (if bi_types then Reductionops.nf_betaiota env sigma src else src) in
       loop (EConstr.Vars.subst1 x tgt) ((m - n,x) :: args) sigma (n-1)
   | CastType (t, _) -> loop t args sigma n 
   | LetInType (_, v, _, t) -> loop (EConstr.Vars.subst1 v t) args sigma n
@@ -957,7 +959,7 @@ let applyn ~with_evars ?beta ?(with_shelve=false) n t gl =
               loop (meta_declare m (EConstr.Unsafe.to_constr ty) sigma) bo ((EConstr.mkMeta m)::args) (n-1)
           | _ -> assert false
       in loop sigma t [] n in
-    pp(lazy(str"Refiner.refiner " ++ Printer.pr_econstr t));
+    pp(lazy(str"Refiner.refiner " ++ Printer.pr_econstr_env (pf_env gl) (project gl) t));
     Tacmach.refine_no_check t gl
 
 let refine_with ?(first_goes_last=false) ?beta ?(with_evars=true) oc gl =
@@ -971,7 +973,7 @@ let refine_with ?(first_goes_last=false) ?beta ?(with_evars=true) oc gl =
     compose_lam (let xs,y = List.chop (n-1) l in y @ xs) 
       (mkApp (compose_lam l c, Array.of_list (mkRel 1 :: mkRels n)))
   in
-  pp(lazy(str"after: " ++ Printer.pr_constr oc));
+  pp(lazy(str"after: " ++ Printer.pr_constr_env (pf_env gl) (project gl) oc));
   try applyn ~with_evars ~with_shelve:true ?beta n (EConstr.of_constr oc) gl
   with e when CErrors.noncritical e -> raise dependent_apply_error
 
@@ -1059,7 +1061,7 @@ let () = CLexer.set_keyword_state frozen_lexer ;;
 (** Basic tactics *)
 
 let rec fst_prod red tac = Proofview.Goal.nf_enter begin fun gl ->
-  let concl = Proofview.Goal.concl (Proofview.Goal.assume gl) in
+  let concl = Proofview.Goal.concl gl in
   match EConstr.kind (Proofview.Goal.sigma gl) concl with
   | Prod (id,_,tgt) | LetIn(id,_,_,tgt) -> tac id
   | _ -> if red then Tacticals.New.tclZEROMSG (str"No product even after head-reduction.")
@@ -1157,6 +1159,7 @@ let pf_interp_gen_aux ist gl to_ind ((oclr, occ), t) =
   let (c, ucst), cl = 
     try fill_occ_pattern ~raise_NoMatch:true env sigma (EConstr.Unsafe.to_constr cl) pat occ 1
     with NoMatch -> redex_of_pattern env pat, (EConstr.Unsafe.to_constr cl) in
+  let gl = pf_merge_uc ucst gl in
   let c = EConstr.of_constr c in
   let cl = EConstr.of_constr cl in
   let clr = interp_clr sigma (oclr, (tag_of_cpattern t, c)) in
@@ -1176,7 +1179,7 @@ let pf_interp_gen_aux ist gl to_ind ((oclr, occ), t) =
     false, pat, EConstr.mkProd (constr_name (project gl) c, pty, Tacmach.pf_concl gl), p, clr,ucst,gl
   else CErrors.user_err ?loc:(loc_of_cpattern t) (str "generalized term didn't match")
 
-let apply_type x xs = Proofview.V82.of_tactic (Tactics.apply_type x xs)
+let apply_type x xs = Proofview.V82.of_tactic (Tactics.apply_type ~typecheck:false x xs)
 
 let genclrtac cl cs clr =
   let tclmyORELSE tac1 tac2 gl =
@@ -1200,7 +1203,7 @@ let genclrtac cl cs clr =
 let gentac ist gen gl =
 (*   ppdebug(lazy(str"sigma@gentac=" ++ pr_evar_map None (project gl))); *)
   let conv, _, cl, c, clr, ucst,gl = pf_interp_gen_aux ist gl false gen in
-  ppdebug(lazy(str"c@gentac=" ++ pr_econstr c));
+  ppdebug(lazy(str"c@gentac=" ++ pr_econstr_env (pf_env gl) (project gl) c));
   let gl = pf_merge_uc ucst gl in
   if conv
   then tclTHEN (Proofview.V82.of_tactic (convert_concl cl)) (cleartac clr) gl
diff --git a/plugins/ssr/ssrcommon.mli b/plugins/ssr/ssrcommon.mli
index 2eadd5f26..c39945194 100644
--- a/plugins/ssr/ssrcommon.mli
+++ b/plugins/ssr/ssrcommon.mli
@@ -190,7 +190,7 @@ val pf_merge_uc_of :
 val constr_name : evar_map -> EConstr.t -> Name.t
 val pf_type_of :
            Goal.goal Evd.sigma ->
-           Term.constr -> Goal.goal Evd.sigma * Term.types
+           Constr.constr -> Goal.goal Evd.sigma * Constr.types
 val pfe_type_of :
            Goal.goal Evd.sigma ->
            EConstr.t -> Goal.goal Evd.sigma * EConstr.types
@@ -220,7 +220,7 @@ val new_wild_id : tac_ctx -> Names.Id.t * tac_ctx
 val pf_fresh_global :
            Globnames.global_reference ->
            Goal.goal Evd.sigma ->
-           Term.constr * Goal.goal Evd.sigma
+           Constr.constr * Goal.goal Evd.sigma
 
 val is_discharged_id : Id.t -> bool
 val mk_discharged_id : Id.t -> Id.t
@@ -232,7 +232,7 @@ val new_tmp_id :
 val mk_anon_id : string -> Goal.goal Evd.sigma -> Id.t
 val pf_abs_evars_pirrel :
            Goal.goal Evd.sigma ->
-           evar_map * Term.constr -> int * Term.constr
+           evar_map * Constr.constr -> int * Constr.constr
 val pf_nbargs : Goal.goal Evd.sigma -> EConstr.t -> int
 val gen_tmp_ids : 
            ?ist:Geninterp.interp_sign ->
diff --git a/plugins/ssr/ssrelim.ml b/plugins/ssr/ssrelim.ml
index 832044909..5782a7621 100644
--- a/plugins/ssr/ssrelim.ml
+++ b/plugins/ssr/ssrelim.ml
@@ -28,7 +28,7 @@ module RelDecl = Context.Rel.Declaration
 
 (** The "case" and "elim" tactic *)
 
-let apply_type x xs = Proofview.V82.of_tactic (Tactics.apply_type x xs)
+let apply_type x xs = Proofview.V82.of_tactic (Tactics.apply_type ~typecheck:false x xs)
 
 (* TASSI: given the type of an elimination principle, it finds the higher order
  * argument (index), it computes it's arity and the arity of the eliminator and
@@ -46,7 +46,7 @@ let analyze_eliminator elimty env sigma =
     if not (EConstr.eq_constr sigma t t') then loop ctx t' else
       errorstrm Pp.(str"The eliminator has the wrong shape."++spc()++
       str"A (applied) bound variable was expected as the conclusion of "++
-      str"the eliminator's"++Pp.cut()++str"type:"++spc()++pr_econstr elimty) in
+      str"the eliminator's"++Pp.cut()++str"type:"++spc()++pr_econstr_env env' sigma elimty) in
   let ctx, pred_id, elim_is_dep, n_pred_args,concl = loop [] elimty in
   let n_elim_args = Context.Rel.nhyps ctx in
   let is_rec_elim = 
@@ -126,7 +126,7 @@ let ssrelim ?(ind=ref None) ?(is_case=false) ?ist deps what ?elim eqid elim_intr
     ppdebug(lazy Pp.(str"matching: " ++ pr_occ occ ++ pp_pattern p));
     let (c,ucst), cl =
       fill_occ_pattern ~raise_NoMatch:true env sigma0 (EConstr.Unsafe.to_constr cl) p occ h in
-    ppdebug(lazy Pp.(str"     got: " ++ pr_constr c));
+    ppdebug(lazy Pp.(str"     got: " ++ pr_constr_env env sigma0 c));
     c, EConstr.of_constr cl, ucst in
   let mkTpat gl t = (* takes a term, refreshes it and makes a T pattern *)
     let n, t, _, ucst = pf_abs_evars orig_gl (project gl, fire_subst gl t) in 
@@ -239,8 +239,8 @@ let ssrelim ?(ind=ref None) ?(is_case=false) ?ist deps what ?elim eqid elim_intr
       | Some (c, _, _,gl) -> true, gl
       | None ->
         errorstrm Pp.(str"Unable to apply the eliminator to the term"++
-          spc()++pr_econstr c++spc()++str"or to unify it's type with"++
-          pr_econstr inf_arg_ty) in
+          spc()++pr_econstr_env env (project gl) c++spc()++str"or to unify it's type with"++
+          pr_econstr_env env (project gl) inf_arg_ty) in
   ppdebug(lazy Pp.(str"c_is_head_p= " ++ bool c_is_head_p));
   let gl, predty = pfe_type_of gl pred in
   (* Patterns for the inductive types indexes to be bound in pred are computed
@@ -396,7 +396,7 @@ let revtoptac n0 gl =
 
 let equality_inj l b id c gl =
   let msg = ref "" in
-  try Proofview.V82.of_tactic (Equality.inj l b None c) gl
+  try Proofview.V82.of_tactic (Equality.inj None l b None c) gl
   with
     | Ploc.Exc(_,CErrors.UserError (_,s))
     | CErrors.UserError (_,s)
diff --git a/plugins/ssr/ssrequality.ml b/plugins/ssr/ssrequality.ml
index ab6a60f4e..11ebe4337 100644
--- a/plugins/ssr/ssrequality.ml
+++ b/plugins/ssr/ssrequality.ml
@@ -11,13 +11,14 @@
 open Ltac_plugin
 open Util
 open Names
+open Term
+open Constr
 open Vars
 open Locus
 open Printer
 open Globnames
 open Termops
 open Tacinterp
-open Term
 
 open Ssrmatching_plugin
 open Ssrmatching
@@ -76,7 +77,7 @@ let interp_congrarg_at ist gl n rf ty m =
     if i + n > m then None else
     try
       let rt = mkRApp congrn (args1 @  mkRApp rf (mkRHoles i) :: args2) in
-      ppdebug(lazy Pp.(str"rt=" ++ Printer.pr_glob_constr rt));
+      ppdebug(lazy Pp.(str"rt=" ++ Printer.pr_glob_constr_env (pf_env gl) rt));
       Some (interp_refine ist gl rt)
     with _ -> loop (i + 1) in
   loop 0
@@ -85,7 +86,7 @@ let pattern_id = mk_internal_id "pattern value"
 
 let congrtac ((n, t), ty) ist gl =
   ppdebug(lazy (Pp.str"===congr==="));
-  ppdebug(lazy Pp.(str"concl=" ++ Printer.pr_econstr (Tacmach.pf_concl gl)));
+  ppdebug(lazy Pp.(str"concl=" ++ Printer.pr_econstr_env (pf_env gl) (project gl) (Tacmach.pf_concl gl)));
   let sigma, _ as it = interp_term ist gl t in
   let gl = pf_merge_uc_of sigma gl in
   let _, f, _, _ucst = pf_abs_evars gl it in
@@ -108,7 +109,7 @@ let congrtac ((n, t), ty) ist gl =
 
 let newssrcongrtac arg ist gl =
   ppdebug(lazy Pp.(str"===newcongr==="));
-  ppdebug(lazy Pp.(str"concl=" ++ Printer.pr_econstr (pf_concl gl)));
+  ppdebug(lazy Pp.(str"concl=" ++ Printer.pr_econstr_env (pf_env gl) (project gl) (pf_concl gl)));
   (* utils *)
   let fs gl t = Reductionops.nf_evar (project gl) t in
   let tclMATCH_GOAL (c, gl_c) proj t_ok t_fail gl =
@@ -129,7 +130,7 @@ let newssrcongrtac arg ist gl =
     let eq, gl = pf_fresh_global (Coqlib.build_coq_eq ()) gl in
     pf_saturate gl (EConstr.of_constr eq) 3 in
   tclMATCH_GOAL (equality, gl') (fun gl' -> fs gl' (List.assoc 0 eq_args))
-  (fun ty -> congrtac (arg, Detyping.detype false [] (pf_env gl) (project gl) ty) ist)
+  (fun ty -> congrtac (arg, Detyping.detype Detyping.Now false Id.Set.empty (pf_env gl) (project gl) ty) ist)
   (fun () ->
     let lhs, gl' = mk_evar gl EConstr.mkProp in let rhs, gl' = mk_evar gl' EConstr.mkProp in
     let arrow = EConstr.mkArrow lhs (EConstr.Vars.lift 1 rhs) in
@@ -142,14 +143,14 @@ let newssrcongrtac arg ist gl =
 
 (** Coq rewrite compatibility flag *)
 
-let ssr_strict_match = ref false
 
 let _ =
-  Goptions.declare_bool_option 
+  let ssr_strict_match = ref false in
+  Goptions.declare_bool_option
     { Goptions.optname  = "strict redex matching";
       Goptions.optkey   = ["Match"; "Strict"];
       Goptions.optread  = (fun () -> !ssr_strict_match);
-      Goptions.optdepr  = false;
+      Goptions.optdepr  = true; (* noop *)
       Goptions.optwrite = (fun b -> ssr_strict_match := b) }
 
 (** Rewrite rules *)
@@ -246,7 +247,7 @@ let unfoldintac occ rdx t (kt,_) gl =
       try find_T env c h ~k:(fun env c _ _ -> EConstr.Unsafe.to_constr (body env t (EConstr.of_constr c)))
       with NoMatch when easy -> c
       | NoMatch | NoProgress -> errorstrm Pp.(str"No occurrence of "
-        ++ pr_constr_pat (EConstr.Unsafe.to_constr t) ++ spc() ++ str "in " ++ Printer.pr_constr c)),
+        ++ pr_constr_pat (EConstr.Unsafe.to_constr t) ++ spc() ++ str "in " ++ Printer.pr_constr_env env sigma c)),
     (fun () -> try end_T () with 
       | NoMatch when easy -> fake_pmatcher_end () 
       | NoMatch -> anomaly "unfoldintac")
@@ -266,13 +267,13 @@ let unfoldintac occ rdx t (kt,_) gl =
             | Proj _ when same_proj sigma0 c t -> body env t c
             | Const f -> aux (body env c c)
             | App (f, a) -> aux (EConstr.mkApp (body env f f, a))
-            | _ -> errorstrm Pp.(str "The term "++pr_constr orig_c++
-                str" contains no " ++ pr_econstr t ++ str" even after unfolding")
+            | _ -> errorstrm Pp.(str "The term "++ pr_constr_env env sigma orig_c++
+                str" contains no " ++ pr_econstr_env env sigma t ++ str" even after unfolding")
           in EConstr.Unsafe.to_constr @@ aux (EConstr.of_constr c)
       else
         try EConstr.Unsafe.to_constr @@ body env t (fs (unify_HO env sigma (EConstr.of_constr c) t) t)
         with _ -> errorstrm Pp.(str "The term " ++
-          pr_constr c ++spc()++ str "does not unify with " ++ pr_constr_pat (EConstr.Unsafe.to_constr t))),
+          pr_constr_env env sigma c ++spc()++ str "does not unify with " ++ pr_constr_pat (EConstr.Unsafe.to_constr t))),
     fake_pmatcher_end in
   let concl = 
     let concl0 = EConstr.Unsafe.to_constr concl0 in
@@ -316,7 +317,7 @@ let rw_progress rhs lhs ise = not (EConstr.eq_constr ise lhs (Evarutil.nf_evar i
 (* such a generic Leibnitz equation -- short of inspecting the type  *)
 (* of the elimination lemmas.                                        *)
 
-let rec strip_prod_assum c = match Term.kind_of_term c with
+let rec strip_prod_assum c = match Constr.kind c with
   | Prod (_, _, c') -> strip_prod_assum c'
   | LetIn (_, v, _, c') -> strip_prod_assum (subst1 v c)
   | Cast (c', _, _) -> strip_prod_assum c'
@@ -341,7 +342,7 @@ let pirrel_rewrite pred rdx rdx_ty new_rdx dir (sigma, c) c_ty gl =
     let sort = elimination_sort_of_goal gl in
     let elim, gl = pf_fresh_global (Indrec.lookup_eliminator ind sort) gl in
     if dir = R2L then elim, gl else (* taken from Coq's rewrite *)
-    let elim, _ = Term.destConst elim in          
+    let elim, _ = destConst elim in
     let mp,dp,l = Constant.repr3 (Constant.make1 (Constant.canonical elim)) in
     let l' = Label.of_id (Nameops.add_suffix (Label.to_id l) "_r")  in 
     let c1' = Global.constant_of_delta_kn (Constant.canonical (Constant.make3 mp dp l')) in
@@ -351,7 +352,7 @@ let pirrel_rewrite pred rdx rdx_ty new_rdx dir (sigma, c) c_ty gl =
   (* We check the proof is well typed *)
   let sigma, proof_ty =
     try Typing.type_of env sigma proof with _ -> raise PRtype_error in
-  ppdebug(lazy Pp.(str"pirrel_rewrite proof term of type: " ++ pr_econstr proof_ty));
+  ppdebug(lazy Pp.(str"pirrel_rewrite proof term of type: " ++ pr_econstr_env env sigma proof_ty));
   try refine_with 
     ~first_goes_last:(not !ssroldreworder) ~with_evars:false (sigma, proof) gl
   with _ -> 
@@ -373,15 +374,15 @@ let pirrel_rewrite pred rdx rdx_ty new_rdx dir (sigma, c) c_ty gl =
           if open_evs <> [] then Some name else None)
           (List.combine (Array.to_list args) names)
     | _ -> anomaly "rewrite rule not an application" in
-    errorstrm Pp.(Himsg.explain_refiner_error (Logic.UnresolvedBindings miss)++
-      (Pp.fnl()++str"Rule's type:" ++ spc() ++ pr_econstr hd_ty))
+    errorstrm Pp.(Himsg.explain_refiner_error env sigma (Logic.UnresolvedBindings miss)++
+      (Pp.fnl()++str"Rule's type:" ++ spc() ++ pr_econstr_env env sigma hd_ty))
 ;;
 
 let is_construct_ref sigma c r =
   EConstr.isConstruct sigma c && eq_gr (ConstructRef (fst(EConstr.destConstruct sigma c))) r
 let is_ind_ref sigma c r = EConstr.isInd sigma c && eq_gr (IndRef (fst(EConstr.destInd sigma c))) r
 
-let apply_type x xs = Proofview.V82.of_tactic (Tactics.apply_type x xs)
+let apply_type x xs = Proofview.V82.of_tactic (Tactics.apply_type ~typecheck:false x xs)
 
 let rwcltac cl rdx dir sr gl =
   let n, r_n,_, ucst = pf_abs_evars gl sr in
@@ -390,12 +391,12 @@ let rwcltac cl rdx dir sr gl =
   let gl = pf_unsafe_merge_uc ucst gl in
   let rdxt = Retyping.get_type_of (pf_env gl) (fst sr) rdx in
 (*         ppdebug(lazy(str"sigma@rwcltac=" ++ pr_evar_map None (fst sr))); *)
-        ppdebug(lazy Pp.(str"r@rwcltac=" ++ pr_econstr (snd sr)));
+        ppdebug(lazy Pp.(str"r@rwcltac=" ++ pr_econstr_env (pf_env gl) (project gl) (snd sr)));
   let cvtac, rwtac, gl =
     if EConstr.Vars.closed0 (project gl) r' then 
       let env, sigma, c, c_eq = pf_env gl, fst sr, snd sr, Coqlib.build_coq_eq () in
       let sigma, c_ty = Typing.type_of env sigma c in
-        ppdebug(lazy Pp.(str"c_ty@rwcltac=" ++ pr_econstr c_ty));
+        ppdebug(lazy Pp.(str"c_ty@rwcltac=" ++ pr_econstr_env env sigma c_ty));
       match EConstr.kind_of_type sigma (Reductionops.whd_all env sigma c_ty) with
       | AtomicType(e, a) when is_ind_ref sigma e c_eq ->
           let new_rdx = if dir = L2R then a.(2) else a.(1) in
@@ -410,7 +411,7 @@ let rwcltac cl rdx dir sr gl =
       let r3, _, r3t  = 
         try EConstr.destCast (project gl) r2 with _ ->
         errorstrm Pp.(str "no cast from " ++ pr_constr_pat (EConstr.Unsafe.to_constr (snd sr))
-                    ++ str " to " ++ pr_econstr r2) in
+                    ++ str " to " ++ pr_econstr_env (pf_env gl) (project gl) r2) in
       let cl' = EConstr.mkNamedProd rule_id (EConstr.it_mkProd_or_LetIn r3t dc) (EConstr.Vars.lift 1 cl) in
       let cl'' = EConstr.mkNamedProd pattern_id rdxt cl' in
       let itacs = [introid pattern_id; introid rule_id] in
@@ -604,7 +605,7 @@ let ssrinstancesofrule ist dir arg gl =
       sigma, pats @ [pat] in
     let rpats = List.fold_left (rpat env0 sigma0) (r_sigma,[]) rules in
     mk_tpattern_matcher ~all_instances:true ~raise_NoMatch:true sigma0 None ~upats_origin rpats in
-  let print env p c _ = Feedback.msg_info Pp.(hov 1 (str"instance:" ++ spc() ++ pr_constr p ++ spc() ++ str "matches:" ++ spc() ++ pr_constr c)); c in
+  let print env p c _ = Feedback.msg_info Pp.(hov 1 (str"instance:" ++ spc() ++ pr_constr_env env r_sigma p ++ spc() ++ str "matches:" ++ spc() ++ pr_constr_env env r_sigma c)); c in
   Feedback.msg_info Pp.(str"BEGIN INSTANCES");
   try
     while true do
diff --git a/plugins/ssr/ssrfwd.ml b/plugins/ssr/ssrfwd.ml
index 8e6329a15..5c1b399a8 100644
--- a/plugins/ssr/ssrfwd.ml
+++ b/plugins/ssr/ssrfwd.ml
@@ -8,11 +8,12 @@
 
 (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
 
+open Pp
 open Names
+open Constr
 open Tacmach
 
 open Ssrmatching_plugin.Ssrmatching
-
 open Ssrprinters
 open Ssrcommon
 open Ssrtacticals
@@ -30,9 +31,6 @@ let ssrposetac ist (id, (_, t)) gl =
   let sigma, t, ucst, _ = pf_abs_ssrterm ist gl t in
   posetac id t (pf_merge_uc ucst gl)
 
-open Pp
-open Term
-
 let ssrsettac ist id ((_, (pat, pty)), (_, occ)) gl =
   let pat = interp_cpattern ist gl pat (Option.map snd pty) in
   let cl, sigma, env = pf_concl gl, project gl, pf_env gl in
@@ -59,10 +57,10 @@ let rec is_Evar_or_CastedMeta sigma x =
   (EConstr.isCast sigma x && is_Evar_or_CastedMeta sigma (pi1 (EConstr.destCast sigma x)))
 
 let occur_existential_or_casted_meta c =
-  let rec occrec c = match kind_of_term c with
+  let rec occrec c = match Constr.kind c with
     | Evar _ -> raise Not_found
     | Cast (m,_,_) when isMeta m -> raise Not_found
-    | _ -> iter_constr occrec c
+    | _ -> Constr.iter occrec c
   in try occrec c; false with Not_found -> true
 
 open Printer
@@ -71,29 +69,30 @@ let examine_abstract id gl =
   let gl, tid = pfe_type_of gl id in
   let abstract, gl = pf_mkSsrConst "abstract" gl in
   let sigma = project gl in
+  let env = pf_env gl in
   if not (EConstr.isApp sigma tid) || not (EConstr.eq_constr sigma (fst(EConstr.destApp sigma tid)) abstract) then
-    errorstrm(strbrk"not an abstract constant: "++pr_econstr id);
+    errorstrm(strbrk"not an abstract constant: "++ pr_econstr_env env sigma id);
   let _, args_id = EConstr.destApp sigma tid in
   if Array.length args_id <> 3 then
-    errorstrm(strbrk"not a proper abstract constant: "++pr_econstr id);
+    errorstrm(strbrk"not a proper abstract constant: "++ pr_econstr_env env sigma id);
   if not (is_Evar_or_CastedMeta sigma args_id.(2)) then
-    errorstrm(strbrk"abstract constant "++pr_econstr id++str" already used");
+    errorstrm(strbrk"abstract constant "++ pr_econstr_env env sigma id++str" already used");
   tid, args_id
 
 let pf_find_abstract_proof check_lock gl abstract_n = 
   let fire gl t = EConstr.Unsafe.to_constr (Reductionops.nf_evar (project gl) (EConstr.of_constr t)) in
   let abstract, gl = pf_mkSsrConst "abstract" gl in
   let l = Evd.fold_undefined (fun e ei l ->
-    match kind_of_term ei.Evd.evar_concl with
+    match Constr.kind ei.Evd.evar_concl with
     | App(hd, [|ty; n; lock|])
       when (not check_lock || 
                  (occur_existential_or_casted_meta  (fire gl ty) &&
                   is_Evar_or_CastedMeta (project gl) (EConstr.of_constr @@ fire gl lock))) &&
-      Term.eq_constr hd (EConstr.Unsafe.to_constr abstract) && Term.eq_constr n abstract_n -> e::l
+      Constr.equal hd (EConstr.Unsafe.to_constr abstract) && Constr.equal n abstract_n -> e::l
     | _ -> l) (project gl) [] in
   match l with
   | [e] -> e
-  | _ -> errorstrm(strbrk"abstract constant "++pr_constr abstract_n++
+  | _ -> errorstrm(strbrk"abstract constant "++ pr_constr_env (pf_env gl) (project gl) abstract_n ++
            strbrk" not found in the evar map exactly once. "++
            strbrk"Did you tamper with it?")
 
@@ -184,9 +183,13 @@ let havetac ist
       mkt ct, mkt cty, mkt (mkCHole None), loc
     | _, (_, Some ct) ->
       mkt ct, mkt (mkCHole None), mkt (mkCHole None), None
-    | _, ({ loc; v = GCast (ct, CastConv cty) }, None) ->
-      mkl ct, mkl cty, mkl mkRHole, loc
-    | _, (t, None) -> mkl t, mkl mkRHole, mkl mkRHole, None in
+    | _, (t, None) ->
+      begin match DAst.get t with
+      | GCast (ct, CastConv cty) ->
+        mkl ct, mkl cty, mkl mkRHole, t.CAst.loc
+      | _ -> mkl t, mkl mkRHole, mkl mkRHole, None
+      end
+  in
   let gl, cut, sol, itac1, itac2 =
    match fk, namefst, suff with
    | FwdHave, true, true ->
@@ -200,7 +203,7 @@ let havetac ist
      let assert_is_conv gl =
        try Proofview.V82.of_tactic (convert_concl (EConstr.it_mkProd_or_LetIn concl ctx)) gl
        with _ -> errorstrm (str "Given proof term is not of type " ++
-         pr_econstr (EConstr.mkArrow (EConstr.mkVar (Id.of_string "_")) concl)) in
+         pr_econstr_env (pf_env gl) (project gl) (EConstr.mkArrow (EConstr.mkVar (Id.of_string "_")) concl)) in
      gl, ty, Tacticals.tclTHEN assert_is_conv (Proofview.V82.of_tactic (Tactics.apply t)), id, itac_c
    | FwdHave, false, false ->
      let skols = List.flatten (List.map (function
@@ -266,7 +269,7 @@ let ssrabstract ist gens (*last*) gl =
     let gl, proof =
       let pf_unify_HO gl a b =
         try pf_unify_HO gl a b
-        with _ -> errorstrm(strbrk"The abstract variable "++pr_econstr id++
+        with _ -> errorstrm(strbrk"The abstract variable "++ pr_econstr_env env (project gl) id++
           strbrk" cannot abstract this goal.  Did you generalize it?") in
       let find_hole p t =
         match EConstr.kind (project gl) t with
@@ -282,10 +285,10 @@ let ssrabstract ist gens (*last*) gl =
             let p = mkApp (proj2,[|ty;concl;p|]) in
             let concl = mkApp(prod,[|ty; concl|]) in
             pf_unify_HO gl concl t, p
-        | App(hd, [|left; right|]) when Term.eq_constr hd prod ->
+        | App(hd, [|left; right|]) when Term.Constr.equal hd prod ->
             find_hole (mkApp (proj1,[|left;right;p|])) left
 *)
-        | _ -> errorstrm(strbrk"abstract constant "++pr_econstr abstract_n++
+        | _ -> errorstrm(strbrk"abstract constant "++ pr_econstr_env env (project gl) abstract_n++
                strbrk" has an unexpected shape. Did you tamper with it?")
       in
         find_hole
@@ -323,11 +326,18 @@ let wlogtac ist (((clr0, pats),_),_) (gens, ((_, ct))) hint suff ghave gl =
   let mkpats = function
   | _, Some ((x, _), _) -> fun pats -> IPatId (hoi_id x) :: pats
   | _ -> fun x -> x in
-  let open CAst in
   let ct = match ct with
-  | (a, (b, Some { v = CCast (_, CastConv cty)})) -> a, (b, Some cty)
-  | (a, ({ v = GCast (_, CastConv cty) }, None)) -> a, (cty, None)
-  | _ -> anomaly "wlog: ssr cast hole deleted by typecheck" in
+  | (a, (b, Some ct)) ->
+    begin match ct.CAst.v with
+    | CCast (_, CastConv cty) -> a, (b, Some cty)
+    | _ -> anomaly "wlog: ssr cast hole deleted by typecheck"
+    end
+  | (a, (t, None)) ->
+    begin match DAst.get t with
+    | GCast (_, CastConv cty) -> a, (cty, None)
+    | _ -> anomaly "wlog: ssr cast hole deleted by typecheck"
+    end
+  in
   let cut_implies_goal = not (suff || ghave <> `NoGen) in
   let c, args, ct, gl =
     let gens = List.filter (function _, Some _ -> true | _ -> false) gens in
@@ -349,14 +359,14 @@ let wlogtac ist (((clr0, pats),_),_) (gens, ((_, ct))) hint suff ghave gl =
       | Sort _, [] -> EConstr.Vars.subst_vars s ct
       | LetIn(Name id as n,b,ty,c), _::g -> EConstr.mkLetIn (n,b,ty,var2rel c g (id::s))
       | Prod(Name id as n,ty,c), _::g -> EConstr.mkProd (n,ty,var2rel c g (id::s))
-      | _ -> CErrors.anomaly(str"SSR: wlog: var2rel: " ++ pr_econstr c) in
+      | _ -> CErrors.anomaly(str"SSR: wlog: var2rel: " ++ pr_econstr_env env sigma c) in
     let c = var2rel c gens [] in
     let rec pired c = function
       | [] -> c
       | t::ts as args -> match EConstr.kind sigma c with
          | Prod(_,_,c) -> pired (EConstr.Vars.subst1 t c) ts
          | LetIn(id,b,ty,c) -> EConstr.mkLetIn (id,b,ty,pired c args)
-         | _ -> CErrors.anomaly(str"SSR: wlog: pired: " ++ pr_econstr c) in
+         | _ -> CErrors.anomaly(str"SSR: wlog: pired: " ++ pr_econstr_env env sigma c) in
     c, args, pired c args, pf_merge_uc uc gl in
   let tacipat pats = introstac ~ist pats in
   let tacigens = 
@@ -384,8 +394,8 @@ let wlogtac ist (((clr0, pats),_),_) (gens, ((_, ct))) hint suff ghave gl =
       | Some id ->
         if pats = [] then Tacticals.tclIDTAC else
         let args = Array.of_list args in
-        ppdebug(lazy(str"specialized="++pr_econstr EConstr.(mkApp (mkVar id,args))));
-        ppdebug(lazy(str"specialized_ty="++pr_econstr ct));
+        ppdebug(lazy(str"specialized="++ pr_econstr_env (pf_env gl) (project gl) EConstr.(mkApp (mkVar id,args))));
+        ppdebug(lazy(str"specialized_ty="++ pr_econstr_env (pf_env gl) (project gl) ct));
         Tacticals.tclTHENS (basecuttac "ssr_have" ct)
           [Proofview.V82.of_tactic (Tactics.apply EConstr.(mkApp (mkVar id,args))); Tacticals.tclIDTAC] in
       "ssr_have",
@@ -398,11 +408,18 @@ let wlogtac ist (((clr0, pats),_),_) (gens, ((_, ct))) hint suff ghave gl =
 
 let sufftac ist ((((clr, pats),binders),simpl), ((_, c), hint)) =
   let htac = Tacticals.tclTHEN (introstac ~ist pats) (hinttac ist true hint) in
-  let open CAst in
   let c = match c with
-  | (a, (b, Some { v = CCast (_, CastConv cty)})) -> a, (b, Some cty)
-  | (a, ({ v = GCast (_, CastConv cty) }, None)) -> a, (cty, None)
-  | _ -> anomaly "suff: ssr cast hole deleted by typecheck" in
+  | (a, (b, Some ct)) ->
+    begin match ct.CAst.v with
+    | CCast (_, CastConv cty) -> a, (b, Some cty)
+    | _ -> anomaly "suff: ssr cast hole deleted by typecheck"
+    end
+  | (a, (t, None)) ->
+    begin match DAst.get t with
+    | GCast (_, CastConv cty) -> a, (cty, None)
+    | _ -> anomaly "suff: ssr cast hole deleted by typecheck"
+    end
+  in
   let ctac gl =
     let _,ty,_,uc = pf_interp_ty ist gl c in let gl = pf_merge_uc uc gl in
     basecuttac "ssr_suff" ty gl in
diff --git a/plugins/ssr/ssripats.ml b/plugins/ssr/ssripats.ml
index 023778fdb..b3be31b7b 100644
--- a/plugins/ssr/ssripats.ml
+++ b/plugins/ssr/ssripats.ml
@@ -41,7 +41,7 @@ module RelDecl = Context.Rel.Declaration
 (* They require guessing the view hints and the number of      *)
 (* implicits, respectively, which we do by brute force.        *)
 
-let apply_type x xs = Proofview.V82.of_tactic (apply_type x xs)
+let apply_type x xs = Proofview.V82.of_tactic (apply_type ~typecheck:false x xs)
 
 let new_tac = Proofview.V82.of_tactic
 
@@ -272,7 +272,7 @@ let (introstac : ?ist:Tacinterp.interp_sign -> ssripats -> Tacmach.tactic),
 let elim_intro_tac ipats ?ist what eqid ssrelim is_rec clr gl =
   (* Utils of local interest only *)
   let iD s ?t gl = let t = match t with None -> pf_concl gl | Some x -> x in
-                   ppdebug(lazy Pp.(str s ++ pr_econstr t)); Tacticals.tclIDTAC gl in
+                   ppdebug(lazy Pp.(str s ++ pr_econstr_env (pf_env gl) (project gl) t)); Tacticals.tclIDTAC gl in
   let protectC, gl = pf_mkSsrConst "protect_term" gl in
   let eq, gl = pf_fresh_global (Coqlib.build_coq_eq ()) gl in
   let eq = EConstr.of_constr eq in
diff --git a/plugins/ssr/ssrparser.ml4 b/plugins/ssr/ssrparser.ml4
index db1981228..0d8044f19 100644
--- a/plugins/ssr/ssrparser.ml4
+++ b/plugins/ssr/ssrparser.ml4
@@ -130,7 +130,7 @@ let pr_ssrhyp _ _ _ = pr_hyp
 let wit_ssrhyprep = add_genarg "ssrhyprep" pr_hyp
 
 let intern_hyp ist (SsrHyp (loc, id) as hyp) =
-  let _ = Tacintern.intern_genarg ist (in_gen (rawwit wit_var) (loc, id)) in
+  let _ = Tacintern.intern_genarg ist (in_gen (rawwit wit_var) CAst.(make ?loc id)) in
   if not_section_id id then hyp else
   hyp_err ?loc "Can't clear section hypothesis " id
 
@@ -316,7 +316,7 @@ END
 
 
 let pr_index = function
-  | Misctypes.ArgVar (_, id) -> pr_id id
+  | Misctypes.ArgVar {CAst.v=id} -> pr_id id
   | Misctypes.ArgArg n when n > 0 -> int n
   | _ -> mt ()
 let pr_ssrindex _ _ _ = pr_index
@@ -330,19 +330,19 @@ let mk_index ?loc = function
   | iv -> iv
 
 let interp_index ist gl idx =
-  Tacmach.project gl, 
+  Tacmach.project gl,
   match idx with
   | Misctypes.ArgArg _ -> idx
-  | Misctypes.ArgVar (loc, id) ->
+  | Misctypes.ArgVar id ->
     let i =
       try
-        let v = Id.Map.find id ist.Tacinterp.lfun in
+        let v = Id.Map.find id.CAst.v ist.Tacinterp.lfun in
         begin match Tacinterp.Value.to_int v with
         | Some i -> i
         | None ->
         begin match Tacinterp.Value.to_constr v with
         | Some c ->
-          let rc = Detyping.detype false [] (pf_env gl) (project gl) c in
+          let rc = Detyping.detype Detyping.Now false Id.Set.empty (pf_env gl) (project gl) c in
           begin match Notation.uninterp_prim_token rc with
           | _, Constrexpr.Numeral (s,b) ->
              let n = int_of_string s in if b then n else -n
@@ -350,8 +350,8 @@ let interp_index ist gl idx =
           end
         | None -> raise Not_found
         end end
-    with _ -> CErrors.user_err ?loc (str"Index not a number") in
-    Misctypes.ArgArg (check_index ?loc i)
+    with _ -> CErrors.user_err ?loc:id.CAst.loc (str"Index not a number") in
+    Misctypes.ArgArg (check_index ?loc:id.CAst.loc i)
 
 open Pltac
 
@@ -1014,22 +1014,22 @@ let rec mkBstruct i = function
   | [] -> []
 
 let rec format_local_binders h0 bl0 = match h0, bl0 with
-  | BFvar :: h, CLocalAssum ([_, x], _,  _) :: bl ->
+  | BFvar :: h, CLocalAssum ([{CAst.v=x}], _,  _) :: bl ->
     Bvar x :: format_local_binders h bl
   | BFdecl _ :: h, CLocalAssum (lxs, _, t) :: bl ->
-    Bdecl (List.map snd lxs, t) :: format_local_binders h bl
-  | BFdef :: h, CLocalDef ((_, x), v, oty) :: bl ->
+    Bdecl (List.map (fun x -> x.CAst.v) lxs, t) :: format_local_binders h bl
+  | BFdef :: h, CLocalDef ({CAst.v=x}, v, oty) :: bl ->
     Bdef (x, oty, v) :: format_local_binders h bl
   | _ -> []
   
 let rec format_constr_expr h0 c0 = let open CAst in match h0, c0 with
-  | BFvar :: h, { v = CLambdaN ([[_, x], _, _], c) } ->
+  | BFvar :: h, { v = CLambdaN ([CLocalAssum([{CAst.v=x}], _, _)], c) } ->
     let bs, c' = format_constr_expr h c in
     Bvar x :: bs, c'
-  | BFdecl _:: h, { v = CLambdaN ([lxs, _, t], c) } ->
+  | BFdecl _:: h, { v = CLambdaN ([CLocalAssum(lxs, _, t)], c) } ->
     let bs, c' = format_constr_expr h c in
-    Bdecl (List.map snd lxs, t) :: bs, c'
-  | BFdef :: h, { v = CLetIn((_, x), v, oty, c) } ->
+    Bdecl (List.map (fun x -> x.CAst.v) lxs, t) :: bs, c'
+  | BFdef :: h, { v = CLetIn({CAst.v=x}, v, oty, c) } ->
     let bs, c' = format_constr_expr h c in
     Bdef (x, oty, v) :: bs, c'
   | [BFcast], { v = CCast (c, CastConv t) } ->
@@ -1037,7 +1037,7 @@ let rec format_constr_expr h0 c0 = let open CAst in match h0, c0 with
   | BFrec (has_str, has_cast) :: h, 
     { v = CFix ( _, [_, (Some locn, CStructRec), bl, t, c]) } ->
     let bs = format_local_binders h bl in
-    let bstr = if has_str then [Bstruct (Name (snd locn))] else [] in
+    let bstr = if has_str then [Bstruct (Name locn.CAst.v)] else [] in
     bs @ bstr @ (if has_cast then [Bcast t] else []), c 
   | BFrec (_, has_cast) :: h, { v = CCoFix ( _, [_, bl, t, c]) } ->
     format_local_binders h bl @ (if has_cast then [Bcast t] else []), c
@@ -1062,32 +1062,32 @@ let rec format_glob_decl h0 d0 = match h0, d0 with
      Bdef (x, None, v) :: format_glob_decl [] d
   | _, [] -> []
 
-let rec format_glob_constr h0 c0 = let open CAst in match h0, c0 with
-  | BFvar :: h, { v = GLambda (x, _, _, c) } ->
+let rec format_glob_constr h0 c0 = match h0, DAst.get c0 with
+  | BFvar :: h, GLambda (x, _, _, c) ->
     let bs, c' = format_glob_constr h c in
     Bvar x :: bs, c'
-  | BFdecl 1 :: h, { v = GLambda (x, _, t, c) } ->
+  | BFdecl 1 :: h, GLambda (x, _, t, c) ->
     let bs, c' = format_glob_constr h c in
     Bdecl ([x], t) :: bs, c'
-  | BFdecl n :: h, { v = GLambda (x, _, t, c) } when n > 1 ->
+  | BFdecl n :: h, GLambda (x, _, t, c) when n > 1 ->
     begin match format_glob_constr (BFdecl (n - 1) :: h) c with
     | Bdecl (xs, _) :: bs, c' -> Bdecl (x :: xs, t) :: bs, c'
     | _ -> [Bdecl ([x], t)], c
     end
-  | BFdef :: h, { v = GLetIn(x, v, oty, c) } ->
+  | BFdef :: h, GLetIn(x, v, oty, c) ->
     let bs, c' = format_glob_constr h c in
     Bdef (x, oty, v) :: bs, c'
-  | [BFcast], { v = GCast (c, CastConv t) } ->
+  | [BFcast], GCast (c, CastConv t) ->
     [Bcast t], c
-  | BFrec (has_str, has_cast) :: h, { v = GRec (f, _, bl, t, c) }
+  | BFrec (has_str, has_cast) :: h, GRec (f, _, bl, t, c)
       when Array.length c = 1 ->
     let bs = format_glob_decl h bl.(0) in
     let bstr = match has_str, f with
     | true, GFix ([|Some i, GStructRec|], _) -> mkBstruct i bs
     | _ -> [] in
     bs @ bstr @ (if has_cast then [Bcast t.(0)] else []), c.(0)
-  | _, c ->
-    [], c
+  | _, _ ->
+    [], c0
 
 (** Forward chaining argument *)
 
@@ -1131,7 +1131,7 @@ let pr_fwd_guarded prval prval' = function
 | (fk, h), (_, (_, Some c)) ->
   pr_gen_fwd prval pr_constr_expr prl_constr_expr fk (format_constr_expr h c)
 | (fk, h), (_, (c, None)) ->
-  pr_gen_fwd prval' pr_glob_constr prl_glob_constr fk (format_glob_constr h c)
+  pr_gen_fwd prval' pr_glob_constr_env prl_glob_constr fk (format_glob_constr h c)
 
 let pr_unguarded prc prlc = prlc
 
@@ -1156,29 +1156,29 @@ ARGUMENT EXTEND ssrbvar TYPED AS constr PRINTED BY pr_ssrbvar
 END
 
 let bvar_lname = let open CAst in function
-  | { v = CRef (Ident (loc, id), _) } -> Loc.tag ?loc @@ Name id
-  | { loc = loc } -> Loc.tag ?loc Anonymous
+  | { v = CRef (Ident (loc, id), _) } -> CAst.make ?loc @@ Name id
+  | { loc = loc } -> CAst.make ?loc Anonymous
 
 let pr_ssrbinder prc _ _ (_, c) = prc c
 
 ARGUMENT EXTEND ssrbinder TYPED AS ssrfwdfmt * constr PRINTED BY pr_ssrbinder
  | [ ssrbvar(bv) ] ->
-   [ let xloc, _ as x = bvar_lname bv in
+   [ let { CAst.loc=xloc } as x = bvar_lname bv in
      (FwdPose, [BFvar]),
-     CAst.make ~loc @@ CLambdaN ([[x],Default Explicit,mkCHole xloc],mkCHole (Some loc)) ]
+     CAst.make ~loc @@ CLambdaN ([CLocalAssum([x],Default Explicit,mkCHole xloc)],mkCHole (Some loc)) ]
  | [ "(" ssrbvar(bv) ")" ] ->
-   [ let xloc, _ as x = bvar_lname bv in
+   [ let { CAst.loc=xloc } as x = bvar_lname bv in
      (FwdPose, [BFvar]),
-     CAst.make ~loc @@ CLambdaN ([[x],Default Explicit,mkCHole xloc],mkCHole (Some loc)) ]
+     CAst.make ~loc @@ CLambdaN ([CLocalAssum([x],Default Explicit,mkCHole xloc)],mkCHole (Some loc)) ]
  | [ "(" ssrbvar(bv) ":" lconstr(t) ")" ] ->
    [ let x = bvar_lname bv in
      (FwdPose, [BFdecl 1]),
-     CAst.make ~loc @@ CLambdaN ([[x], Default Explicit, t], mkCHole (Some loc)) ]
+     CAst.make ~loc @@ CLambdaN ([CLocalAssum([x], Default Explicit, t)], mkCHole (Some loc)) ]
  | [ "(" ssrbvar(bv) ne_ssrbvar_list(bvs) ":" lconstr(t) ")" ] ->
    [ let xs = List.map bvar_lname (bv :: bvs) in
      let n = List.length xs in
      (FwdPose, [BFdecl n]),
-     CAst.make ~loc @@ CLambdaN ([xs, Default Explicit, t], mkCHole (Some loc)) ]
+     CAst.make ~loc @@ CLambdaN ([CLocalAssum (xs, Default Explicit, t)], mkCHole (Some loc)) ]
  | [ "(" ssrbvar(id) ":" lconstr(t) ":=" lconstr(v) ")" ] ->
    [ (FwdPose,[BFdef]), CAst.make ~loc @@ CLetIn (bvar_lname id, v, Some t, mkCHole (Some loc)) ]
  | [ "(" ssrbvar(id) ":=" lconstr(v) ")" ] ->
@@ -1191,7 +1191,7 @@ GEXTEND Gram
   [  ["of" | "&"]; c = operconstr LEVEL "99" ->
      let loc = !@loc in
      (FwdPose, [BFvar]),
-     CAst.make ~loc @@ CLambdaN ([[Loc.tag ~loc Anonymous],Default Explicit,c],mkCHole (Some loc)) ]
+     CAst.make ~loc @@ CLambdaN ([CLocalAssum ([CAst.make ~loc Anonymous],Default Explicit,c)],mkCHole (Some loc)) ]
   ];
 END
 
@@ -1217,7 +1217,7 @@ let push_binders c2 bs =
   | ct -> loop false ct bs
 
 let rec fix_binders = let open CAst in function
-  | (_, { v = CLambdaN ([xs, _, t], _) } ) :: bs ->
+  | (_, { v = CLambdaN ([CLocalAssum(xs, _, t)], _) } ) :: bs ->
       CLocalAssum (xs, Default Explicit, t) :: fix_binders bs
   | (_, { v = CLetIn (x, v, oty, _) } ) :: bs ->
     CLocalDef (x, v, oty) :: fix_binders bs
@@ -1250,13 +1250,13 @@ END
 let pr_ssrfixfwd _ _ _ (id, fwd) = str " fix " ++ pr_id id ++ pr_fwd fwd
 
 let bvar_locid = function
-  | { CAst.v = CRef (Ident (loc, id), _) } -> loc, id
+  | { CAst.v = CRef (Ident (loc, id), _) } -> CAst.make ?loc id
   | _ -> CErrors.user_err (Pp.str "Missing identifier after \"(co)fix\"")
 
 
 ARGUMENT EXTEND ssrfixfwd TYPED AS ident * ssrfwd PRINTED BY pr_ssrfixfwd
   | [ "fix" ssrbvar(bv) ssrbinder_list(bs) ssrstruct(sid) ssrfwd(fwd) ] ->
-    [ let (_, id) as lid = bvar_locid bv in
+    [ let { CAst.v=id } as lid = bvar_locid bv in
       let (fk, h), (ck, (rc, oc)) = fwd in
       let c = Option.get oc in
       let has_cast, t', c' = match format_constr_expr h c with
@@ -1265,8 +1265,10 @@ ARGUMENT EXTEND ssrfixfwd TYPED AS ident * ssrfwd PRINTED BY pr_ssrfixfwd
       let lb = fix_binders bs in
       let has_struct, i =
         let rec loop = function
-          (l', Name id') :: _ when Option.equal Id.equal sid (Some id') -> true, (l', id')
-          | [l', Name id'] when sid = None -> false, (l', id')
+          | {CAst.loc=l'; v=Name id'} :: _ when Option.equal Id.equal sid (Some id') ->
+            true, CAst.make ?loc:l' id'
+          | [{CAst.loc=l';v=Name id'}] when sid = None ->
+            false, CAst.make ?loc:l' id'
           | _ :: bn -> loop bn
           | [] -> CErrors.user_err (Pp.str "Bad structural argument") in
         loop (names_of_local_assums lb) in
@@ -1282,7 +1284,7 @@ let pr_ssrcofixfwd _ _ _ (id, fwd) = str " cofix " ++ pr_id id ++ pr_fwd fwd
 
 ARGUMENT EXTEND ssrcofixfwd TYPED AS ssrfixfwd PRINTED BY pr_ssrcofixfwd
   | [ "cofix" ssrbvar(bv) ssrbinder_list(bs) ssrfwd(fwd) ] ->
-    [ let _, id as lid = bvar_locid bv in
+    [ let { CAst.v=id } as lid = bvar_locid bv in
       let (fk, h), (ck, (rc, oc)) = fwd in
       let c = Option.get oc in
       let has_cast, t', c' = match format_constr_expr h c with
@@ -1323,18 +1325,18 @@ END
 
 let intro_id_to_binder = List.map (function 
   | IPatId id ->
-      let xloc, _ as x = bvar_lname (mkCVar id) in
+      let { CAst.loc=xloc } as x = bvar_lname (mkCVar id) in
       (FwdPose, [BFvar]),
-        CAst.make @@ CLambdaN ([[x], Default Explicit, mkCHole xloc],
+        CAst.make @@ CLambdaN ([CLocalAssum([x], Default Explicit, mkCHole xloc)],
           mkCHole None)
   | _ -> anomaly "non-id accepted as binder")
 
 let binder_to_intro_id = CAst.(List.map (function
-  | (FwdPose, [BFvar]), { v = CLambdaN ([ids,_,_],_) }
-  | (FwdPose, [BFdecl _]), { v = CLambdaN ([ids,_,_],_) } ->
-      List.map (function (_, Name id) -> IPatId id | _ -> IPatAnon One) ids
-  | (FwdPose, [BFdef]), { v = CLetIn ((_,Name id),_,_,_) } -> [IPatId id]
-  | (FwdPose, [BFdef]), { v = CLetIn ((_,Anonymous),_,_,_) } -> [IPatAnon One]
+  | (FwdPose, [BFvar]), { v = CLambdaN ([CLocalAssum(ids,_,_)],_) }
+  | (FwdPose, [BFdecl _]), { v = CLambdaN ([CLocalAssum(ids,_,_)],_) } ->
+      List.map (function {v=Name id} -> IPatId id | _ -> IPatAnon One) ids
+  | (FwdPose, [BFdef]), { v = CLetIn ({v=Name id},_,_,_) } -> [IPatId id]
+  | (FwdPose, [BFdef]), { v = CLetIn ({v=Anonymous},_,_,_) } -> [IPatAnon One]
   | _ -> anomaly "ssrbinder is not a binder"))
 
 let pr_ssrhavefwdwbinders _ _ prt (tr,((hpats, (fwd, hint)))) =
@@ -1405,7 +1407,7 @@ let ssrorelse = Gram.entry_create "ssrorelse"
 GEXTEND Gram
   GLOBAL: ssrorelse ssrseqarg;
   ssrseqidx: [
-    [ test_ssrseqvar; id = Prim.ident -> ArgVar (Loc.tag ~loc:!@loc id)
+    [ test_ssrseqvar; id = Prim.ident -> ArgVar (CAst.make ~loc:!@loc id)
     | n = Prim.natural -> ArgArg (check_index ~loc:!@loc n)
     ] ];
   ssrswap: [[ IDENT "first" -> !@loc, true | IDENT "last" -> !@loc, false ]];
@@ -1554,8 +1556,8 @@ END
 let ssrautoprop gl =
   try 
     let tacname = 
-      try Nametab.locate_tactic (qualid_of_ident (Id.of_string "ssrautoprop"))
-      with Not_found -> Nametab.locate_tactic (ssrqid "ssrautoprop") in
+      try Tacenv.locate_tactic (qualid_of_ident (Id.of_string "ssrautoprop"))
+      with Not_found -> Tacenv.locate_tactic (ssrqid "ssrautoprop") in
     let tacexpr = Loc.tag @@ Tacexpr.Reference (ArgArg (Loc.tag @@ tacname)) in
     Proofview.V82.of_tactic (eval_tactic (Tacexpr.TacArg tacexpr)) gl
   with Not_found -> Proofview.V82.of_tactic (Auto.full_trivial []) gl
diff --git a/plugins/ssr/ssrprinters.ml b/plugins/ssr/ssrprinters.ml
index e865ef706..4b2fab6d1 100644
--- a/plugins/ssr/ssrprinters.ml
+++ b/plugins/ssr/ssrprinters.ml
@@ -24,7 +24,7 @@ let pp_concat hd ?(sep=str", ") = function [] -> hd | x :: xs ->
   hd ++ List.fold_left (fun acc x -> acc ++ sep ++ x) x xs
 
 let pp_term gl t =
-  let t = Reductionops.nf_evar (project gl) t in pr_econstr t
+  let t = Reductionops.nf_evar (project gl) t in pr_econstr_env (pf_env gl) (project gl) t
 
 (* FIXME *)
 (* terms are pre constr, the kind is parsing/printing flag to distinguish
diff --git a/plugins/ssr/ssrtacticals.ml b/plugins/ssr/ssrtacticals.ml
index 5e43c8374..6514b186e 100644
--- a/plugins/ssr/ssrtacticals.ml
+++ b/plugins/ssr/ssrtacticals.ml
@@ -122,7 +122,7 @@ let endclausestac id_map clseq gl_id cl0 gl =
   if List.for_all not_hyp' all_ids && not c_hidden then mktac [] gl else
   CErrors.user_err (Pp.str "tampering with discharged assumptions of \"in\" tactical")
 
-let apply_type x xs = Proofview.V82.of_tactic (Tactics.apply_type x xs)
+let apply_type x xs = Proofview.V82.of_tactic (Tactics.apply_type ~typecheck:false x xs)
 
 let tclCLAUSES ist tac (gens, clseq) gl =
   if clseq = InGoal || clseq = InSeqGoal then tac gl else
diff --git a/plugins/ssr/ssrvernac.ml4 b/plugins/ssr/ssrvernac.ml4
index 9c59d83d4..8e6e0347f 100644
--- a/plugins/ssr/ssrvernac.ml4
+++ b/plugins/ssr/ssrvernac.ml4
@@ -9,7 +9,8 @@
 (* This file is (C) Copyright 2006-2015 Microsoft Corporation and Inria. *)
 
 open Names
-open Term
+module CoqConstr = Constr
+open CoqConstr
 open Termops
 open Constrexpr
 open Constrexpr_ops
@@ -73,34 +74,36 @@ let frozen_lexer = CLexer.get_keyword_state () ;;
 
 let no_ct = None, None and no_rt = None in 
 let aliasvar = function
-  | [_, [{ CAst.v = CPatAlias (_, id); loc }]] -> Some (loc,Name id)
+  | [[{ CAst.v = CPatAlias (_, na); loc }]] -> Some na
   | _ -> None in
 let mk_cnotype mp = aliasvar mp, None in
 let mk_ctype mp t = aliasvar mp, Some t in
 let mk_rtype t = Some t in
-let mk_dthen ?loc (mp, ct, rt) c = (Loc.tag ?loc (mp, c)), ct, rt in
+let mk_dthen ?loc (mp, ct, rt) c = (CAst.make ?loc (mp, c)), ct, rt in
 let mk_let ?loc rt ct mp c1 =
-  CAst.make ?loc @@ CCases (LetPatternStyle, rt, ct, [Loc.tag ?loc (mp, c1)]) in
+  CAst.make ?loc @@ CCases (LetPatternStyle, rt, ct, [CAst.make ?loc (mp, c1)]) in
 let mk_pat c (na, t) = (c, na, t) in
 GEXTEND Gram
   GLOBAL: binder_constr;
   ssr_rtype: [[ "return"; t = operconstr LEVEL "100" -> mk_rtype t ]];
-  ssr_mpat: [[ p = pattern -> [Loc.tag ~loc:!@loc [p]] ]];
+  ssr_mpat: [[ p = pattern -> [[p]] ]];
   ssr_dpat: [
     [ mp = ssr_mpat; "in"; t = pattern; rt = ssr_rtype -> mp, mk_ctype mp t, rt
     | mp = ssr_mpat; rt = ssr_rtype -> mp, mk_cnotype mp, rt
     | mp = ssr_mpat -> mp, no_ct, no_rt
   ] ];
   ssr_dthen: [[ dp = ssr_dpat; "then"; c = lconstr -> mk_dthen ~loc:!@loc dp c ]];
-  ssr_elsepat: [[ "else" -> [Loc.tag ~loc:!@loc [CAst.make ~loc:!@loc @@ CPatAtom None]] ]];
-  ssr_else: [[ mp = ssr_elsepat; c = lconstr -> Loc.tag ~loc:!@loc (mp, c) ]];
+  ssr_elsepat: [[ "else" -> [[CAst.make ~loc:!@loc @@ CPatAtom None]] ]];
+  ssr_else: [[ mp = ssr_elsepat; c = lconstr -> CAst.make ~loc:!@loc (mp, c) ]];
   binder_constr: [
     [ "if"; c = operconstr LEVEL "200"; "is"; db1 = ssr_dthen; b2 = ssr_else ->
       let b1, ct, rt = db1 in CAst.make ~loc:!@loc @@ CCases (MatchStyle, rt, [mk_pat c ct], [b1; b2])
     | "if"; c = operconstr LEVEL "200";"isn't";db1 = ssr_dthen; b2 = ssr_else ->
       let b1, ct, rt = db1 in 
-      let b1, b2 = 
-        let (l1, (p1, r1)), (l2, (p2, r2)) = b1, b2 in (l1, (p1, r2)), (l2, (p2, r1)) in
+      let b1, b2 = let open CAst in
+        let {loc=l1; v=(p1, r1)}, {loc=l2; v=(p2, r2)} = b1, b2 in
+        (make ?loc:l1 (p1, r2), make ?loc:l2 (p2, r1))
+      in
       CAst.make ~loc:!@loc @@ CCases (MatchStyle, rt, [mk_pat c ct], [b1; b2])
     | "let"; ":"; mp = ssr_mpat; ":="; c = lconstr; "in"; c1 = lconstr ->
       mk_let ~loc:!@loc no_rt [mk_pat c no_ct] mp c1
@@ -117,7 +120,7 @@ GEXTEND Gram
   GLOBAL: closed_binder;
   closed_binder: [
     [ ["of" | "&"]; c = operconstr LEVEL "99" ->
-      [CLocalAssum ([Loc.tag ~loc:!@loc Anonymous], Default Explicit, c)]
+      [CLocalAssum ([CAst.make ~loc:!@loc Anonymous], Default Explicit, c)]
   ] ];
 END
 (* }}} *)
@@ -157,11 +160,14 @@ let declare_one_prenex_implicit locality f =
   | impls ->
     Impargs.declare_manual_implicits locality fref ~enriching:false [impls]
 
-VERNAC COMMAND EXTEND Ssrpreneximplicits CLASSIFIED AS SIDEFF
+VERNAC COMMAND FUNCTIONAL EXTEND Ssrpreneximplicits CLASSIFIED AS SIDEFF
   | [ "Prenex" "Implicits" ne_global_list(fl) ]
-  -> [ let locality =
-         Locality.make_section_locality (Locality.LocalityFixme.consume ()) in
-       List.iter (declare_one_prenex_implicit locality) fl ]
+  -> [ fun ~atts ~st ->
+         let open Vernacinterp in
+         let locality = Locality.make_section_locality atts.locality in
+         List.iter (declare_one_prenex_implicit locality) fl;
+         st
+     ]
 END
 
 (* Vernac grammar visibility patch *)
@@ -292,9 +298,9 @@ let interp_search_notation ?loc tag okey =
     err (pr_ntn ntn ++ str " is an n-ary notation");
   let nvars = List.filter (fun (_,(_,typ)) -> typ = NtnTypeConstr) nvars in
   let rec sub () = function
-  | NVar x when List.mem_assoc x nvars -> CAst.make ?loc @@ GPatVar (FirstOrderPatVar x)
+  | NVar x when List.mem_assoc x nvars -> DAst.make ?loc @@ GPatVar (FirstOrderPatVar x)
   | c ->
-    glob_constr_of_notation_constr_with_binders ?loc (fun _ x -> (), x) sub () c in
+    glob_constr_of_notation_constr_with_binders ?loc (fun _ x -> (), None, x) sub () c in
   let _, npat = Patternops.pattern_of_glob_constr (sub () body) in
   Search.GlobSearchSubPattern npat
 
@@ -342,7 +348,7 @@ let coerce_search_pattern_to_sort hpat =
   let hpat' = if np = na then hpat else mkPApp hpat (np - na) [||] in
   let warn () =
     Feedback.msg_warning (str "Listing only lemmas with conclusion matching " ++ 
-      pr_constr_pattern hpat') in
+      pr_constr_pattern_env env sigma hpat') in
   if EConstr.isSort sigma ht then begin warn (); true, hpat' end else
   let filter_head, coe_path =
     try 
@@ -358,13 +364,13 @@ let coerce_search_pattern_to_sort hpat =
       let n_imps = Option.get (Classops.hide_coercion coe_ref) in
       mkPApp (Pattern.PRef coe_ref) n_imps [|hp|]
     with _ ->
-    errorstrm (str "need explicit coercion " ++ pr_constr coe ++ spc ()
+    errorstrm (str "need explicit coercion " ++ pr_constr_env env sigma coe ++ spc ()
             ++ str "to interpret head search pattern as type") in
   filter_head, List.fold_left coerce hpat' coe_path
 
 let interp_head_pat hpat =
   let filter_head, p = coerce_search_pattern_to_sort hpat in
-  let rec loop c = match kind_of_term c with
+  let rec loop c = match CoqConstr.kind c with
   | Cast (c', _, _) -> loop c'
   | Prod (_, _, c') -> loop c'
   | LetIn (_, _, _, c') -> loop c'
@@ -467,10 +473,12 @@ let pr_raw_ssrhintref prc _ _ = let open CAst in function
     prc c ++ str "|" ++ int (List.length args)
   | c -> prc c
 
-let pr_rawhintref = let open CAst in function
-  | { v = GApp (f, args) } when isRHoles args ->
-    pr_glob_constr f ++ str "|" ++ int (List.length args)
-  | c -> pr_glob_constr c
+let pr_rawhintref c =
+  let _, env = Pfedit.get_current_context () in
+  match DAst.get c with
+  | GApp (f, args) when isRHoles args ->
+    pr_glob_constr_env env f ++ str "|" ++ int (List.length args)
+  | _ -> pr_glob_constr_env env c
 
 let pr_glob_ssrhintref _ _ _ (c, _) = pr_rawhintref c
 
@@ -545,9 +553,9 @@ GEXTEND Gram
       | IDENT "Canonical"; qid = Constr.global;
           d = G_vernac.def_body ->
           let s = coerce_reference_to_id qid in
-	  Vernacexpr.VernacDefinition
-	    ((Some Decl_kinds.Global,Decl_kinds.CanonicalStructure),
-             ((Loc.tag s),None),(d  ))
+    Vernacexpr.VernacDefinition
+      ((Decl_kinds.NoDischarge,Decl_kinds.CanonicalStructure),
+          ((CAst.make (Name s)),None), d)
   ]];
 END
 
@@ -578,10 +586,10 @@ END
 GEXTEND Gram
   GLOBAL: hloc;
 hloc: [
-  [ "in"; "("; "Type"; "of"; id = ident; ")" -> 
-    Tacexpr.HypLocation ((Loc.tag id), Locus.InHypTypeOnly)
-  | "in"; "("; IDENT "Value"; "of"; id = ident; ")" -> 
-    Tacexpr.HypLocation ((Loc.tag id), Locus.InHypValueOnly)
+  [ "in"; "("; "Type"; "of"; id = ident; ")" ->
+    Tacexpr.HypLocation (CAst.make id, Locus.InHypTypeOnly)
+  | "in"; "("; IDENT "Value"; "of"; id = ident; ")" ->
+    Tacexpr.HypLocation (CAst.make id, Locus.InHypValueOnly)
   ] ];
 END
 
diff --git a/plugins/ssr/ssrview.ml b/plugins/ssr/ssrview.ml
index 338ecccc2..61b65e347 100644
--- a/plugins/ssr/ssrview.ml
+++ b/plugins/ssr/ssrview.ml
@@ -59,13 +59,13 @@ let glob_view_hints lvh =
 
 let add_view_hints lvh i = Lib.add_anonymous_leaf (in_viewhint (i, lvh))
 
-let interp_view ist si env sigma gv v rid =
-  let open CAst in
-  match v with
-  | { v = GApp ( { v = GHole _ } , rargs); loc } ->
-    let rv = make ?loc @@ GApp (rid, rargs) in
+let interp_view ist si env sigma gv rv rid =
+  match DAst.get rv with
+  | GApp (h, rargs) when (match DAst.get h with GHole _ -> true | _ -> false) ->
+    let loc = rv.CAst.loc in
+    let rv = DAst.make ?loc @@ GApp (rid, rargs) in
     snd (interp_open_constr ist (re_sig si sigma) (rv, None))
-  | rv ->
+  | _ ->
   let interp rc rargs =
     interp_open_constr ist (re_sig si sigma) (mkRApp rc rargs, None) in
   let rec simple_view rargs n =
diff --git a/plugins/ssrmatching/ssrmatching.ml4 b/plugins/ssrmatching/ssrmatching.ml4
index f6300ab7e..73e212365 100644
--- a/plugins/ssrmatching/ssrmatching.ml4
+++ b/plugins/ssrmatching/ssrmatching.ml4
@@ -12,16 +12,16 @@
  * we thus save the lexer to restore it at the end of the file *)
 let frozen_lexer = CLexer.get_keyword_state () ;;
 
-(*i camlp4use: "pa_extend.cmo" i*)
-(*i camlp4deps: "grammar/grammar.cma" i*)
-
 open Ltac_plugin
 open Names
 open Pp
-open Pcoq
 open Genarg
 open Stdarg
 open Term
+module CoqConstr = Constr
+open CoqConstr
+open Pcoq
+open Pcoq.Constr
 open Vars
 open Libnames
 open Tactics
@@ -35,10 +35,8 @@ open Evd
 open Tacexpr
 open Tacinterp
 open Pretyping
-open Constr
 open Ppconstr
 open Printer
-
 open Globnames
 open Misctypes
 open Decl_kinds
@@ -73,7 +71,7 @@ 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, [| |]
+  match kind c with App (f, a) -> f, a | _ -> c, [| |]
 (* Toplevel constr must be globalized twice ! *)
 let glob_constr ist genv = function
   | _, Some ce ->
@@ -99,7 +97,6 @@ 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
@@ -134,17 +131,21 @@ let dC t = CastConv t
 let isCVar   = function { CAst.v = CRef (Ident _, _) } -> true | _ -> false
 let destCVar = function { CAst.v = CRef (Ident (_, id), _) } -> id | _ ->
   CErrors.anomaly (str"not a CRef.")
+let isGLambda c = match DAst.get c with GLambda (Name _, _, _, _) -> true | _ -> false
+let destGLambda c = match DAst.get c with GLambda (Name id, _, _, c) -> (id, c)
+  | _ -> CErrors.anomaly (str "not a GLambda")
+let isGHole c = match DAst.get c with GHole _ -> true | _ -> false
 let mkCHole ~loc = CAst.make ?loc @@ CHole (None, IntroAnonymous, None)
 let mkCLambda ?loc name ty t = CAst.make ?loc @@
-   CLambdaN ([[Loc.tag ?loc name], Default Explicit, ty], t)
+   CLambdaN ([CLocalAssum([CAst.make ?loc name], Default Explicit, ty)], t)
 let mkCLetIn ?loc name bo t = CAst.make ?loc @@
-   CLetIn ((Loc.tag ?loc name), bo, None, t)
+   CLetIn ((CAst.make ?loc name), bo, None, t)
 let mkCCast ?loc t ty = CAst.make ?loc @@ CCast (t, dC ty)
 (** Constructors for rawconstr *)
-let mkRHole = CAst.make @@ GHole (InternalHole, IntroAnonymous, None)
-let mkRApp f args = if args = [] then f else CAst.make @@ GApp (f, args)
-let mkRCast rc rt =  CAst.make @@ GCast (rc, dC rt)
-let mkRLambda n s t = CAst.make @@ GLambda (n, Explicit, s, t)
+let mkRHole = DAst.make @@ GHole (InternalHole, IntroAnonymous, None)
+let mkRApp f args = if args = [] then f else DAst.make @@ GApp (f, args)
+let mkRCast rc rt =  DAst.make @@ GCast (rc, dC rt)
+let mkRLambda n s t = DAst.make @@ GLambda (n, Explicit, s, t)
 
 (* ssrterm conbinators *)
 let combineCG t1 t2 f g = match t1, t2 with
@@ -321,7 +322,7 @@ let unif_FO env ise p c =
 let nf_open_term sigma0 ise c =
   let c = EConstr.Unsafe.to_constr c in
   let s = ise and s' = ref sigma0 in
-  let rec nf c' = match kind_of_term c' with
+  let rec nf c' = match kind c' with
   | Evar ex ->
     begin try nf (existential_value s ex) with _ ->
     let k, a = ex in let a' = Array.map nf a in
@@ -329,7 +330,7 @@ let nf_open_term sigma0 ise c =
       s' := Evd.add !s' k (Evarutil.nf_evar_info s (Evd.find s k));
     mkEvar (k, a')
     end
-  | _ -> map_constr nf c' in
+  | _ -> map 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
@@ -361,7 +362,7 @@ let pf_unify_HO gl t1 t2 =
   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
+let iter_constr_LR f c = match kind 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
@@ -392,7 +393,7 @@ let inv_dir = function L2R -> R2L | R2L -> L2R
 type pattern_class =
   | KpatFixed
   | KpatConst
-  | KpatEvar of existential_key
+  | KpatEvar of Evar.t
   | KpatLet
   | KpatLam
   | KpatRigid
@@ -414,26 +415,27 @@ let all_ok _ _ = true
 let proj_nparams c =
   try 1 + Recordops.find_projection_nparams (ConstRef c) with _ -> 0
 
-let isRigid c = match kind_of_term c with
+let isRigid c = match kind c with
   | Prod _ | Sort _ | Lambda _ | Case _ | Fix _ | CoFix _ -> true
   | _ -> false
 
 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)
+    if isEvar c then hole_var else map wipe_evar c in
+  let sigma, env = Pfedit.get_current_context () in
+  pr_constr_env env sigma (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
+  let rec put c = match kind 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
+    if Evd.mem sigma0 k then map 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
@@ -448,7 +450,7 @@ let evars_for_FO ~hack env sigma0 (ise0:evar_map) c0 =
     sigma := Evd.define k (applistc (mkMeta m) a) !sigma;
     put (existential_value !sigma ex)
     end
-  | _ -> map_constr put c in
+  | _ -> map put c in
   let c1 = put c0 in !ise, c1
 
 (* Compile a match pattern from a term; t is the term to fill. *)
@@ -458,7 +460,7 @@ let mk_tpattern ?p_origin ?(hack=false) env sigma0 (ise, t) ok dir p =
     let f, a = Reductionops.whd_betaiota_stack ise (EConstr.of_constr p) in
     let f = EConstr.Unsafe.to_constr f in
     let a = List.map EConstr.Unsafe.to_constr a in
-    match kind_of_term f with
+    match kind f with
     | Const (p,_) ->
       let np = proj_nparams p in
       if np = 0 || np > List.length a then KpatConst, f, a else
@@ -486,7 +488,7 @@ let mk_tpattern ?p_origin ?(hack=false) env sigma0 (ise, t) ok dir p =
 (* 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
+  let k = match kind f with
   | Var _ | Ind _ | Construct _ -> KpatFixed
   | Const _ -> KpatConst
   | Evar (k, _) -> if is_defined sigma k then raise NoMatch else KpatEvar k
@@ -498,37 +500,37 @@ let ungen_upat lhs (sigma, uc, t) u =
 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
+  let nargs_of_proj t = match kind t 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
+      | _ -> assert false in
+  try match kind f with
+  | Prod _ -> na Prod_cs
+  | Sort s -> na (Sort_cs (Sorts.family s))
+  | Const (c',_) when Constant.equal c' pc -> nargs_of_proj u.up_f 
+  | Proj (c',_) when Constant.equal (Projection.constant c') pc -> nargs_of_proj u.up_f
   | 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
+  match kind f with Evar (k', _) -> k = k' | _ -> false
 
 let nb_args c =
-  match kind_of_term c with App (_, a) -> Array.length a | _ -> 0
+  match kind 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
+  let rec loop c a = match kind 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
+  fun c -> match kind c with
   | App (f, a) -> loop f a
   | Cast _ | Evar _ -> loop c [| |]
   | _ -> c, [| |]
@@ -537,8 +539,8 @@ 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 
+  | KpatConst when equal u.up_f f -> na
+  | KpatFixed when equal u.up_f f -> na 
   | KpatEvar k when isEvar_k k f -> na
   | KpatLet when isLetIn f -> na
   | KpatLam when isLambda f -> na
@@ -550,7 +552,7 @@ let filter_upat i0 f n u fpats =
   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
+let eq_prim_proj c t = match kind t with
   | Proj(p,_) -> Constant.equal (Projection.constant p) c
   | _ -> false
 
@@ -558,13 +560,13 @@ 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 
+  | KpatConst -> equal u.up_f f 
+  | KpatFixed -> equal 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
+  | KpatProj pc -> equal 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
 
@@ -737,13 +739,13 @@ let mk_tpattern_matcher ?(all_instances=false)
       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
+      let match_let f = match kind 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
+    | KpatFixed -> equal u.up_f
+    | KpatConst -> equal u.up_f
     | KpatLam -> fun c ->
-       (match kind_of_term c with
+       (match kind c with
        | Lambda _ -> unif_EQ env sigma u.up_f c
        | _ -> false)
     | _ -> unif_EQ env sigma u.up_f in
@@ -774,8 +776,8 @@ let rec uniquize = function
       let t1 = nf_evar sigma1 t1 in
       let f1 = nf_evar sigma1 f1 in
       let a1 = Array.map (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
+      not (equal t t1 &&
+           equal f f1 && CArray.for_all2 equal a a1) in
     x :: uniquize (List.filter neq xs) in
 
 ((fun env c h ~k -> 
@@ -914,7 +916,7 @@ let glob_cpattern gs p =
   | k, (v, Some t) as orig ->
      if k = 'x' then glob_ssrterm gs ('(', (v, Some t)) else
      match t.CAst.v with
-     | CNotation("( _ in _ )", ([t1; t2], [], [])) ->
+     | 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 ->
@@ -922,11 +924,11 @@ let glob_cpattern gs p =
          | (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], [], [])) ->
+     | CNotation("( _ in _ in _ )", ([t1; t2; t3], [], [], [])) ->
          check_var t2; encode k "In" [fst (glob t1); bind_in t2 t3]
-     | CNotation("( _ as _ )", ([t1; t2], [], [])) ->
+     | CNotation("( _ as _ )", ([t1; t2], [], [], [])) ->
          encode k "As" [fst (glob t1); fst (glob t2)]
-     | CNotation("( _ as _ in _ )", ([t1; t2; t3], [], [])) ->
+     | CNotation("( _ as _ in _ )", ([t1; t2; t3], [], [], [])) ->
          check_var t2; encode k "As" [fst (glob t1); bind_in t2 t3]
      | _ -> glob_ssrterm gs orig
 ;;
@@ -980,11 +982,10 @@ let pr_rpattern = pr_pattern
 
 type pattern = Evd.evar_map * (constr, constr) ssrpattern
 
-
-let id_of_cpattern = let open CAst in function
-  | _,(_,Some { v = CRef (Ident (_, x), _) } ) -> Some x
-  | _,(_,Some { v = CAppExpl ((_, Ident (_, x), _), []) } ) -> Some x
-  | _,({ v = GRef (VarRef x, _)} ,None) -> Some x
+let id_of_cpattern (_, (c1, c2)) = let open CAst in match DAst.get c1, c2 with
+  | _, Some { v = CRef (Ident (_, x), _) } -> Some x
+  | _, Some { v = 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
@@ -1015,7 +1016,7 @@ let input_ssrtermkind strm = match stream_nth 0 strm with
   | Tok.KEYWORD "(" -> '('
   | Tok.KEYWORD "@" -> '@'
   | _ -> ' '
-let ssrtermkind = Gram.Entry.of_parser "ssrtermkind" input_ssrtermkind
+let ssrtermkind = Pcoq.Gram.Entry.of_parser "ssrtermkind" input_ssrtermkind
 
 let interp_ssrterm _ gl t = Tacmach.project gl, t
 
@@ -1082,10 +1083,11 @@ let interp_pattern ?wit_ssrpatternarg ist gl red redty =
   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 =
-    let open CAst in
-    try match (pf_intern_term ist gl t) with
-    | { v = GCast({ v = GHole _},CastConv({ v = GLambda(Name x,_,_,c)})) } -> f x (' ',(c,None))
-    | { v = GVar id }
+    try match DAst.get (pf_intern_term ist gl t) with
+    | GCast(t,CastConv c) when isGHole t && isGLambda c->
+      let (x, c) = destGLambda c in
+      f x (' ',(c,None))
+    | GVar id
       when Id.Map.mem id ist.lfun &&
            not(Option.is_empty reccall) &&
            not(Option.is_empty wit_ssrpatternarg) ->
@@ -1096,7 +1098,7 @@ let interp_pattern ?wit_ssrpatternarg ist gl red redty =
   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++str".") in
   let cleanup_XinE h x rp sigma =
-    let h_k = match kind_of_term h with Evar (k,_) -> k | _ -> assert false in
+    let h_k = match kind 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
@@ -1111,11 +1113,11 @@ let interp_pattern ?wit_ssrpatternarg ist gl red redty =
       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
+      let rec aux acc t = match kind 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 
+      | _ -> CoqConstr.fold aux acc t in 
       aux [] (nf_evar sigma rp) in
     let sigma = 
       List.fold_left (fun sigma e ->
@@ -1126,19 +1128,27 @@ let interp_pattern ?wit_ssrpatternarg ist gl red redty =
         thin name sigma e)
       sigma new_evars in
     sigma in
-  let red = let rec decode_red (ist,red) = let open CAst in match red with
-    | T(k,({ v = GCast ({ v = GHole _ },CastConv({ v = GLambda (Name id,_,_,t)}))},None))
-        when let id = Id.to_string id in let len = String.length id in
+  let red = let rec decode_red (ist,red) = match red with
+    | T(k,(t,None)) ->
+      begin match DAst.get t with
+      | GCast (c,CastConv t)
+        when isGHole c &&
+          let (id, t) = destGLambda t in
+          let id = Id.to_string id in let len = String.length id in
         (len > 8 && String.sub id 0 8 = "_ssrpat_") ->
+        let (id, t) = destGLambda t in
         let id = Id.to_string id in let len = String.length id in
-        (match String.sub id 8 (len - 8), t with
-        | "In", { v = GApp( _, [t]) } -> decodeG t xInT (fun x -> T x)
-        | "In", { v = GApp( _, [e; t]) } -> decodeG t (eInXInT (mkG e)) (bad_enc id)
-        | "In", { v = GApp( _, [e; t; e_in_t]) } ->
+        (match String.sub id 8 (len - 8), DAst.get 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", { v = GApp(_, [e; t]) } -> decodeG t (eAsXInT (mkG e)) (bad_enc id)
+        | "As", GApp(_, [e; t]) -> decodeG t (eAsXInT (mkG e)) (bad_enc id)
         | _ -> bad_enc id ())
+      | _ ->
+        decode ist ~reccall:decode_red (k, (t, None)) xInT (fun x -> T x)
+      end
     | 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)
@@ -1163,7 +1173,7 @@ let interp_pattern ?wit_ssrpatternarg ist gl red redty =
   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,(CAst.make ?loc @@ GLetIn (x, CAst.make ?loc @@ GHole (BinderType x, IntroAnonymous, None), None, g), None) in
+  | None -> a,(DAst.make ?loc @@ GLetIn (x, DAst.make ?loc @@ GHole (BinderType x, IntroAnonymous, None), 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
@@ -1190,7 +1200,7 @@ 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)
+  | _, T t -> (match kind t with Var id -> Some id | _ -> None)
   | _ -> None
 
 (* The full occurrence set *)
@@ -1202,7 +1212,7 @@ let eval_pattern ?raise_NoMatch env0 sigma0 concl0 pattern occ do_subst =
   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 ++
+    | _ -> errorstrm (str "Matching the pattern " ++ pr_constr_env env0 sigma0 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
@@ -1210,12 +1220,12 @@ let eval_pattern ?raise_NoMatch env0 sigma0 concl0 pattern occ do_subst =
       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
+    match kind 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
+  | None -> do_subst env0 concl0 concl0 1, Evd.empty_evar_universe_context
   | Some (sigma, (T rp | In_T rp)) -> 
     let rp = fs sigma rp in
     let ise = create_evar_defs sigma in
@@ -1223,8 +1233,8 @@ let eval_pattern ?raise_NoMatch env0 sigma0 concl0 pattern occ do_subst =
     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 ~k:do_subst in
-    let _ = end_T () in
-    concl
+    let _, _, (_, us, _) = end_T () in
+    concl, us
   | 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
@@ -1239,8 +1249,8 @@ let eval_pattern ?raise_NoMatch env0 sigma0 concl0 pattern occ do_subst =
       let sigma, e_body = pop_evar p_sigma ex p in
       fs p_sigma (find_X env (fs sigma p) h 
         ~k:(fun env _ -> do_subst env e_body))) in
-    let _ = end_X () in let _ = end_T () in 
-    concl
+    let _ = end_X () in let _, _, (_, us, _) = end_T () in
+    concl, us
   | 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
@@ -1255,8 +1265,9 @@ let eval_pattern ?raise_NoMatch env0 sigma0 concl0 pattern occ do_subst =
       let sigma, e_body = pop_evar p_sigma ex p in
       fs p_sigma (find_X env (fs sigma p) h ~k:(fun env c _ h ->
         find_E env e_body h ~k:do_subst))) in
-    let _ = end_E () in let _ = end_X () in let _ = end_T () in
-    concl
+    let _,_,(_,us,_) = end_E () in
+    let _ = end_X () in let _ = end_T () in
+    concl, us
   | 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
@@ -1274,8 +1285,8 @@ let eval_pattern ?raise_NoMatch env0 sigma0 concl0 pattern occ do_subst =
         let e_sigma = unify_HO env sigma (EConstr.of_constr e_body) (EConstr.of_constr 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 _ = end_X () in let _,_,(_,us,_) = end_TE () in
+    concl, us
 ;;
 
 let redex_of_pattern ?(resolve_typeclasses=false) env (sigma, p) =
@@ -1293,12 +1304,14 @@ let fill_occ_pattern ?raise_NoMatch env sigma cl pat occ h =
   let find_R, conclude =
     let r = ref None in
     (fun env c _ h' ->
-       do_once r (fun () -> c, Evd.empty_evar_universe_context);
+       do_once r (fun () -> c);
        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
+    (fun _ -> if !r = None then fst(redex_of_pattern env pat)
+                           else assert_done r) in
+  let cl, us =
+    eval_pattern ?raise_NoMatch env sigma cl (Some pat) occ find_R in
   let e = conclude cl in
-  e, cl
+  (e, us), cl
 ;;
 
 (* clenup interface for external use *)
@@ -1306,6 +1319,10 @@ let mk_tpattern ?p_origin env sigma0 sigma_t f dir c =
   mk_tpattern ?p_origin env sigma0 sigma_t f dir c
 ;;
 
+let eval_pattern ?raise_NoMatch env0 sigma0 concl0 pattern occ do_subst =
+  fst (eval_pattern ?raise_NoMatch env0 sigma0 concl0 pattern occ do_subst)
+;;
+
 let pf_fill_occ env concl occ sigma0 p (sigma, t) ok h =
  let p = EConstr.Unsafe.to_constr p in
  let concl = EConstr.Unsafe.to_constr concl in
@@ -1336,10 +1353,10 @@ let pf_fill_occ_term gl occ t =
   let cl,(_,t) = fill_occ_term env concl occ sigma0 t in
   cl, t
 
-let cpattern_of_id id = ' ', (CAst.make @@ GRef (VarRef  id, None), None)
+let cpattern_of_id id = ' ', (DAst.make @@ GRef (VarRef  id, None), None)
 
-let is_wildcard : cpattern -> bool = function
-  | _,(_,Some { CAst.v = CHole _ } | { CAst.v = GHole _ } ,None) -> true
+let is_wildcard ((_, (l, r)) : cpattern) : bool = match DAst.get l, r with
+  | _, Some { CAst.v = CHole _ } | GHole _, None -> true
   | _ -> false
 
 (* "ssrpattern" *)
@@ -1395,7 +1412,7 @@ let () =
 
 let ssrinstancesof ist arg gl =
   let ok rhs lhs ise = true in
-(*   not (Term.eq_constr lhs (Evarutil.nf_evar ise rhs)) in *)
+(*   not (equal lhs (Evarutil.nf_evar ise rhs)) in *)
   let env, sigma, concl = pf_env gl, project gl, pf_concl gl in
   let concl = EConstr.Unsafe.to_constr concl in
   let sigma0, cpat = interp_cpattern ist gl arg None in
@@ -1404,7 +1421,8 @@ let ssrinstancesof ist arg gl =
   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
+  let print env p c _ = ppnl (hov 1 (str"instance:" ++ spc() ++ pr_constr_env (pf_env gl) (gl.sigma) p ++ spc()
+                                     ++ str "matches:" ++ spc() ++ pr_constr_env (pf_env gl) (gl.sigma)  c)); c in
   ppnl (str"BEGIN INSTANCES");
   try
     while true do
diff --git a/plugins/ssrmatching/ssrmatching.mli b/plugins/ssrmatching/ssrmatching.mli
index 8e2a1a717..8ab666f7e 100644
--- a/plugins/ssrmatching/ssrmatching.mli
+++ b/plugins/ssrmatching/ssrmatching.mli
@@ -6,7 +6,7 @@ open Genarg
 open Tacexpr
 open Environ
 open Evd
-open Term
+open Constr
 
 (** ******** Small Scale Reflection pattern matching facilities ************* *)
 
diff --git a/plugins/syntax/ascii_syntax.ml b/plugins/syntax/ascii_syntax.ml
index c41ec39cb..b299ff853 100644
--- a/plugins/syntax/ascii_syntax.ml
+++ b/plugins/syntax/ascii_syntax.ml
@@ -25,6 +25,10 @@ let make_dir l = DirPath.make (List.rev_map Id.of_string l)
 let make_kn dir id = Globnames.encode_mind (make_dir dir) (Id.of_string id)
 let make_path dir id = Libnames.make_path (make_dir dir) (Id.of_string id)
 
+let is_gr c gr = match DAst.get c with
+| GRef (r, _) -> Globnames.eq_gr r gr
+| _ -> false
+
 let ascii_module = ["Coq";"Strings";"Ascii"]
 
 let ascii_path = make_path ascii_module "ascii"
@@ -42,9 +46,9 @@ let interp_ascii ?loc p =
   let rec aux n p =
      if Int.equal n 0 then [] else
      let mp = p mod 2 in
-     (CAst.make ?loc @@ GRef ((if Int.equal mp 0 then glob_false else glob_true),None))
+     (DAst.make ?loc @@ GRef ((if Int.equal mp 0 then glob_false else glob_true),None))
      :: (aux (n-1) (p/2)) in
-  CAst.make ?loc @@ GApp (CAst.make ?loc @@ GRef(force glob_Ascii,None), aux 8 p)
+  DAst.make ?loc @@ GApp (DAst.make ?loc @@ GRef(force glob_Ascii,None), aux 8 p)
 
 let interp_ascii_string ?loc s =
   let p =
@@ -60,12 +64,12 @@ let interp_ascii_string ?loc s =
 let uninterp_ascii r =
   let rec uninterp_bool_list n = function
     | [] when Int.equal n 0 -> 0
-    | { CAst.v = GRef (k,_)}::l when Globnames.eq_gr k glob_true  -> 1+2*(uninterp_bool_list (n-1)  l)
-    | { CAst.v = GRef (k,_)}::l when Globnames.eq_gr k glob_false -> 2*(uninterp_bool_list (n-1) l)
+    | r::l when is_gr r glob_true  -> 1+2*(uninterp_bool_list (n-1)  l)
+    | r::l when is_gr r glob_false -> 2*(uninterp_bool_list (n-1) l)
     | _ -> raise Non_closed_ascii in
   try
-    let aux = function
-    | { CAst.v = GApp ({ CAst.v = GRef (k,_)},l) } when Globnames.eq_gr k (force glob_Ascii) -> uninterp_bool_list 8 l
+    let aux c = match DAst.get c with
+    | GApp (r, l) when is_gr r (force glob_Ascii) -> uninterp_bool_list 8 l
     | _ -> raise Non_closed_ascii in
     Some (aux r)
   with
@@ -75,10 +79,10 @@ let make_ascii_string n =
   if n>=32 && n<=126 then String.make 1 (char_of_int n)
   else Printf.sprintf "%03d" n
 
-let uninterp_ascii_string r = Option.map make_ascii_string (uninterp_ascii r)
+let uninterp_ascii_string (AnyGlobConstr r) = Option.map make_ascii_string (uninterp_ascii r)
 
 let _ =
   Notation.declare_string_interpreter "char_scope"
     (ascii_path,ascii_module)
     interp_ascii_string
-    ([CAst.make @@ GRef (static_glob_Ascii,None)], uninterp_ascii_string, true)
+    ([DAst.make @@ GRef (static_glob_Ascii,None)], uninterp_ascii_string, true)
diff --git a/plugins/syntax/int31_syntax.ml b/plugins/syntax/int31_syntax.ml
index af64b1479..0dff047a3 100644
--- a/plugins/syntax/int31_syntax.ml
+++ b/plugins/syntax/int31_syntax.ml
@@ -23,6 +23,10 @@ open Glob_term
 let make_dir l = DirPath.make (List.rev_map Id.of_string l)
 let make_path dir id = Libnames.make_path (make_dir dir) (Id.of_string id)
 
+let is_gr c gr = match DAst.get c with
+| GRef (r, _) -> Globnames.eq_gr r gr
+| _ -> false
+
 let make_mind mp id = Names.MutInd.make2 mp (Label.make id)
 let make_mind_mpfile dir id = make_mind (ModPath.MPfile (make_dir dir)) id
 let make_mind_mpdot dir modname id =
@@ -49,9 +53,9 @@ exception Non_closed
 (* parses a *non-negative* integer (from bigint.ml) into an int31
    wraps modulo 2^31 *)
 let int31_of_pos_bigint ?loc n =
-  let ref_construct = CAst.make ?loc (GRef (int31_construct, None)) in
-  let ref_0 = CAst.make ?loc (GRef (int31_0, None)) in
-  let ref_1 = CAst.make ?loc (GRef (int31_1, None)) in
+  let ref_construct = DAst.make ?loc (GRef (int31_construct, None)) in
+  let ref_0 = DAst.make ?loc (GRef (int31_0, None)) in
+  let ref_1 = DAst.make ?loc (GRef (int31_1, None)) in
   let rec args counter n =
     if counter <= 0 then
       []
@@ -59,7 +63,7 @@ let int31_of_pos_bigint ?loc n =
       let (q,r) = div2_with_rest n in
 	(if r then ref_1 else ref_0)::(args (counter-1) q)
   in
-  CAst.make ?loc (GApp (ref_construct, List.rev (args 31 n)))
+  DAst.make ?loc (GApp (ref_construct, List.rev (args 31 n)))
 
 let error_negative ?loc =
   CErrors.user_err ?loc ~hdr:"interp_int31" (Pp.str "int31 are only non-negative numbers.")
@@ -76,15 +80,15 @@ let bigint_of_int31 =
   let rec args_parsing args cur =
     match args with
       | [] -> cur
-      | { CAst.v = GRef (b,_) }::l when eq_gr b int31_0 -> args_parsing l (mult_2 cur)
-      | { CAst.v = GRef (b,_) }::l when eq_gr b int31_1 -> args_parsing l (add_1 (mult_2 cur))
+      | r::l when is_gr r int31_0 -> args_parsing l (mult_2 cur)
+      | r::l when is_gr r int31_1 -> args_parsing l (add_1 (mult_2 cur))
       | _ -> raise Non_closed
   in
-  function
-  | { CAst.v = GApp ({ CAst.v = GRef (c, _) }, args) } when eq_gr c int31_construct -> args_parsing args zero
+  fun c -> match DAst.get c with
+  | GApp (r, args) when is_gr r int31_construct -> args_parsing args zero
   | _ -> raise Non_closed
 
-let uninterp_int31 i =
+let uninterp_int31 (AnyGlobConstr i) =
   try
     Some (bigint_of_int31 i)
   with Non_closed ->
@@ -94,6 +98,6 @@ let uninterp_int31 i =
 let _ = Notation.declare_numeral_interpreter int31_scope
   (int31_path, int31_module)
   interp_int31
-  ([CAst.make (GRef (int31_construct, None))],
+  ([DAst.make (GRef (int31_construct, None))],
    uninterp_int31,
    true)
diff --git a/plugins/syntax/nat_syntax.ml b/plugins/syntax/nat_syntax.ml
index 524a5c522..2f9870cf9 100644
--- a/plugins/syntax/nat_syntax.ml
+++ b/plugins/syntax/nat_syntax.ml
@@ -37,11 +37,11 @@ let warn_large_nat =
 let nat_of_int ?loc n =
   if is_pos_or_zero n then begin
       if less_than threshold n then warn_large_nat ();
-      let ref_O = CAst.make ?loc @@ GRef (glob_O, None) in
-      let ref_S = CAst.make ?loc @@ GRef (glob_S, None) in
+      let ref_O = DAst.make ?loc @@ GRef (glob_O, None) in
+      let ref_S = DAst.make ?loc @@ GRef (glob_S, None) in
       let rec mk_nat acc n =
 	if n <> zero then
-	  mk_nat (CAst.make ?loc @@ GApp (ref_S, [acc])) (sub_1 n)
+	  mk_nat (DAst.make ?loc @@ GApp (ref_S, [acc])) (sub_1 n)
 	else
 	  acc
       in
@@ -56,13 +56,17 @@ let nat_of_int ?loc n =
 
 exception Non_closed_number
 
-let rec int_of_nat x = CAst.with_val (function
-  | GApp ({ CAst.v = GRef (s,_) } ,[a]) when Globnames.eq_gr s glob_S -> add_1 (int_of_nat a)
+let rec int_of_nat x = DAst.with_val (function
+  | GApp (r, [a]) ->
+    begin match DAst.get r with
+    | GRef (s,_) when Globnames.eq_gr s glob_S -> add_1 (int_of_nat a)
+    | _ -> raise Non_closed_number
+    end
   | GRef (z,_) when Globnames.eq_gr z glob_O -> zero
   | _ -> raise Non_closed_number
   ) x
 
-let uninterp_nat p =
+let uninterp_nat (AnyGlobConstr p) =
   try
     Some (int_of_nat p)
   with
@@ -75,4 +79,4 @@ let _ =
   Notation.declare_numeral_interpreter "nat_scope"
     (nat_path,datatypes_module_name)
     nat_of_int
-    ([CAst.make @@ GRef (glob_S,None); CAst.make @@ GRef (glob_O,None)], uninterp_nat, true)
+    ([DAst.make @@ GRef (glob_S,None); DAst.make @@ GRef (glob_O,None)], uninterp_nat, true)
diff --git a/plugins/syntax/r_syntax.ml b/plugins/syntax/r_syntax.ml
index 06117de79..88ff38c6d 100644
--- a/plugins/syntax/r_syntax.ml
+++ b/plugins/syntax/r_syntax.ml
@@ -27,6 +27,10 @@ let binnums = ["Coq";"Numbers";"BinNums"]
 let make_dir l = DirPath.make (List.rev_map Id.of_string l)
 let make_path dir id = Libnames.make_path (make_dir dir) (Id.of_string id)
 
+let is_gr c gr = match DAst.get c with
+| GRef (r, _) -> Globnames.eq_gr r gr
+| _ -> false
+
 let positive_path = make_path binnums "positive"
 
 (* TODO: temporary hack *)
@@ -42,13 +46,13 @@ let glob_xO = ConstructRef path_of_xO
 let glob_xH = ConstructRef path_of_xH
 
 let pos_of_bignat ?loc x =
-  let ref_xI = CAst.make @@ GRef (glob_xI, None) in
-  let ref_xH = CAst.make @@ GRef (glob_xH, None) in
-  let ref_xO = CAst.make @@ GRef (glob_xO, None) in
+  let ref_xI = DAst.make @@ GRef (glob_xI, None) in
+  let ref_xH = DAst.make @@ GRef (glob_xH, None) in
+  let ref_xO = DAst.make @@ GRef (glob_xO, None) in
   let rec pos_of x =
     match div2_with_rest x with
-      | (q,false) -> CAst.make @@ GApp (ref_xO,[pos_of q])
-      | (q,true) when not (Bigint.equal q zero) -> CAst.make @@ GApp (ref_xI,[pos_of q])
+      | (q,false) -> DAst.make @@ GApp (ref_xO,[pos_of q])
+      | (q,true) when not (Bigint.equal q zero) -> DAst.make @@ GApp (ref_xI,[pos_of q])
       | (q,true) -> ref_xH
   in
   pos_of x
@@ -57,10 +61,10 @@ let pos_of_bignat ?loc x =
 (* Printing positive via scopes                                       *)
 (**********************************************************************)
 
-let rec bignat_of_pos = function
-  | { CAst.v = GApp ({ CAst.v = GRef (b,_)},[a]) } when Globnames.eq_gr b glob_xO -> mult_2(bignat_of_pos a)
-  | { CAst.v = GApp ({ CAst.v = GRef (b,_)},[a]) } when Globnames.eq_gr b glob_xI -> add_1(mult_2(bignat_of_pos a))
-  | { CAst.v = GRef (a, _) } when Globnames.eq_gr a glob_xH -> Bigint.one
+let rec bignat_of_pos c = match DAst.get c with
+  | GApp (r, [a]) when is_gr r glob_xO -> mult_2(bignat_of_pos a)
+  | GApp (r, [a]) when is_gr r glob_xI -> add_1(mult_2(bignat_of_pos a))
+  | GRef (a, _) when Globnames.eq_gr a glob_xH -> Bigint.one
   | _ -> raise Non_closed_number
 
 (**********************************************************************)
@@ -81,18 +85,18 @@ let z_of_int ?loc n =
   if not (Bigint.equal n zero) then
     let sgn, n =
       if is_pos_or_zero n then glob_POS, n else glob_NEG, Bigint.neg n in
-    CAst.make @@ GApp(CAst.make @@ GRef (sgn,None), [pos_of_bignat ?loc n])
+    DAst.make @@ GApp(DAst.make @@ GRef (sgn,None), [pos_of_bignat ?loc n])
   else
-    CAst.make @@ GRef (glob_ZERO, None)
+    DAst.make @@ GRef (glob_ZERO, None)
 
 (**********************************************************************)
 (* Printing Z via scopes                                              *)
 (**********************************************************************)
 
-let bigint_of_z = function
-  | { CAst.v = GApp ({ CAst.v = GRef (b,_)},[a]) } when Globnames.eq_gr b glob_POS -> bignat_of_pos a
-  | { CAst.v = GApp ({ CAst.v = GRef (b,_)},[a]) } when Globnames.eq_gr b glob_NEG -> Bigint.neg (bignat_of_pos a)
-  | { CAst.v = GRef (a, _) } when Globnames.eq_gr a glob_ZERO -> Bigint.zero
+let bigint_of_z c = match DAst.get c with
+  | GApp (r,[a]) when is_gr r glob_POS -> bignat_of_pos a
+  | GApp (r,[a]) when is_gr r glob_NEG -> Bigint.neg (bignat_of_pos a)
+  | GRef (a, _) when Globnames.eq_gr a glob_ZERO -> Bigint.zero
   | _ -> raise Non_closed_number
 
 (**********************************************************************)
@@ -108,18 +112,18 @@ let make_path dir id = Globnames.encode_con dir (Id.of_string id)
 let glob_IZR = ConstRef (make_path (make_dir rdefinitions) "IZR")
 
 let r_of_int ?loc z =
-  CAst.make @@ GApp (CAst.make @@ GRef(glob_IZR,None), [z_of_int ?loc z])
+  DAst.make @@ GApp (DAst.make @@ GRef(glob_IZR,None), [z_of_int ?loc z])
 
 (**********************************************************************)
 (* Printing R via scopes                                              *)
 (**********************************************************************)
 
-let bigint_of_r = function
-  | { CAst.v = GApp ({ CAst.v = GRef (o,_) }, [a]) } when Globnames.eq_gr o glob_IZR ->
+let bigint_of_r c = match DAst.get c with
+  | GApp (r, [a]) when is_gr r glob_IZR ->
       bigint_of_z a
   | _ -> raise Non_closed_number
 
-let uninterp_r p =
+let uninterp_r (AnyGlobConstr p) =
   try
     Some (bigint_of_r p)
   with Non_closed_number ->
@@ -128,6 +132,6 @@ let uninterp_r p =
 let _ = Notation.declare_numeral_interpreter "R_scope"
   (r_path,["Coq";"Reals";"Rdefinitions"])
   r_of_int
-  ([CAst.make @@ GRef (glob_IZR, None)],
+  ([DAst.make @@ GRef (glob_IZR, None)],
     uninterp_r,
     false)
diff --git a/plugins/syntax/string_syntax.ml b/plugins/syntax/string_syntax.ml
index b7f13b040..cc82fc94c 100644
--- a/plugins/syntax/string_syntax.ml
+++ b/plugins/syntax/string_syntax.ml
@@ -31,25 +31,29 @@ let make_reference id = find_reference "String interpretation" string_module id
 let glob_String = lazy (make_reference "String")
 let glob_EmptyString = lazy (make_reference "EmptyString")
 
+let is_gr c gr = match DAst.get c with
+| GRef (r, _) -> Globnames.eq_gr r gr
+| _ -> false
+
 open Lazy
 
 let interp_string ?loc s =
   let le = String.length s in
   let rec aux n =
-     if n = le then CAst.make ?loc @@ GRef (force glob_EmptyString, None) else
-     CAst.make ?loc @@ GApp (CAst.make ?loc @@ GRef (force glob_String, None),
+     if n = le then DAst.make ?loc @@ GRef (force glob_EmptyString, None) else
+     DAst.make ?loc @@ GApp (DAst.make ?loc @@ GRef (force glob_String, None),
        [interp_ascii ?loc (int_of_char s.[n]); aux (n+1)])
   in aux 0
 
-let uninterp_string r =
+let uninterp_string (AnyGlobConstr r) =
   try
     let b = Buffer.create 16 in
-    let rec aux = function
-    | { CAst.v = GApp ({ CAst.v = GRef (k,_) },[a;s]) } when eq_gr k (force glob_String) ->
+    let rec aux c = match DAst.get c with
+    | GApp (k,[a;s]) when is_gr k (force glob_String) ->
 	(match uninterp_ascii a with
 	  | Some c -> Buffer.add_char b (Char.chr c); aux s
 	  | _ -> raise Non_closed_string)
-    | { CAst.v = GRef (z,_) } when eq_gr z (force glob_EmptyString) ->
+    | GRef (z,_) when eq_gr z (force glob_EmptyString) ->
 	Some (Buffer.contents b)
     | _ ->
 	raise Non_closed_string
@@ -61,6 +65,6 @@ let _ =
   Notation.declare_string_interpreter "string_scope"
     (string_path,["Coq";"Strings";"String"])
     interp_string
-    ([CAst.make @@ GRef (static_glob_String,None);
-      CAst.make @@ GRef (static_glob_EmptyString,None)],
+    ([DAst.make @@ GRef (static_glob_String,None);
+      DAst.make @@ GRef (static_glob_EmptyString,None)],
      uninterp_string, true)
diff --git a/plugins/syntax/z_syntax.ml b/plugins/syntax/z_syntax.ml
index af3df2889..0d743a2b5 100644
--- a/plugins/syntax/z_syntax.ml
+++ b/plugins/syntax/z_syntax.ml
@@ -45,13 +45,13 @@ let glob_xO = ConstructRef path_of_xO
 let glob_xH = ConstructRef path_of_xH
 
 let pos_of_bignat ?loc x = 
-  let ref_xI = CAst.make ?loc @@ GRef (glob_xI, None) in
-  let ref_xH = CAst.make ?loc @@ GRef (glob_xH, None) in
-  let ref_xO = CAst.make ?loc @@ GRef (glob_xO, None) in
+  let ref_xI = DAst.make ?loc @@ GRef (glob_xI, None) in
+  let ref_xH = DAst.make ?loc @@ GRef (glob_xH, None) in
+  let ref_xO = DAst.make ?loc @@ GRef (glob_xO, None) in
   let rec pos_of x =
     match div2_with_rest x with
-      | (q,false) -> CAst.make ?loc @@ GApp (ref_xO,[pos_of q])
-      | (q,true) when not (Bigint.equal q zero) -> CAst.make ?loc @@ GApp (ref_xI,[pos_of q])
+      | (q,false) -> DAst.make ?loc @@ GApp (ref_xO,[pos_of q])
+      | (q,true) when not (Bigint.equal q zero) -> DAst.make ?loc @@ GApp (ref_xI,[pos_of q])
       | (q,true) -> ref_xH
   in
   pos_of x
@@ -68,14 +68,18 @@ let interp_positive ?loc n =
 (* Printing positive via scopes                                       *)
 (**********************************************************************)
 
-let rec bignat_of_pos x = CAst.with_val (function
-  | GApp ({ CAst.v = GRef (b,_) },[a]) when Globnames.eq_gr b glob_xO -> mult_2(bignat_of_pos a)
-  | GApp ({ CAst.v = GRef (b,_) },[a]) when Globnames.eq_gr b glob_xI -> add_1(mult_2(bignat_of_pos a))
+let is_gr c gr = match DAst.get c with
+| GRef (r, _) -> Globnames.eq_gr r gr
+| _ -> false
+
+let rec bignat_of_pos x = DAst.with_val (function
+  | GApp (r ,[a]) when is_gr r glob_xO -> mult_2(bignat_of_pos a)
+  | GApp (r ,[a]) when is_gr r glob_xI -> add_1(mult_2(bignat_of_pos a))
   | GRef (a, _)                when Globnames.eq_gr a glob_xH -> Bigint.one
   | _ -> raise Non_closed_number
   ) x
 
-let uninterp_positive p =
+let uninterp_positive (AnyGlobConstr p) =
   try
     Some (bignat_of_pos p)
   with Non_closed_number ->
@@ -88,9 +92,9 @@ let uninterp_positive p =
 let _ = Notation.declare_numeral_interpreter "positive_scope"
   (positive_path,binnums)
   interp_positive
-  ([CAst.make @@ GRef (glob_xI, None);
-    CAst.make @@ GRef (glob_xO, None);
-    CAst.make @@ GRef (glob_xH, None)],
+  ([DAst.make @@ GRef (glob_xI, None);
+    DAst.make @@ GRef (glob_xO, None);
+    DAst.make @@ GRef (glob_xH, None)],
    uninterp_positive,
    true)
 
@@ -107,9 +111,9 @@ let glob_Npos = ConstructRef path_of_Npos
 
 let n_path = make_path binnums "N"
 
-let n_of_binnat ?loc pos_or_neg n = CAst.make ?loc @@
+let n_of_binnat ?loc pos_or_neg n = DAst.make ?loc @@
   if not (Bigint.equal n zero) then
-    GApp(CAst.make @@ GRef (glob_Npos,None), [pos_of_bignat ?loc n])
+    GApp(DAst.make @@ GRef (glob_Npos,None), [pos_of_bignat ?loc n])
   else
     GRef(glob_N0, None)
 
@@ -124,13 +128,13 @@ let n_of_int ?loc n =
 (* Printing N via scopes                                              *)
 (**********************************************************************)
 
-let bignat_of_n = CAst.with_val (function
-  | GApp ({ CAst.v = GRef (b,_)},[a]) when Globnames.eq_gr b glob_Npos -> bignat_of_pos a
+let bignat_of_n n = DAst.with_val (function
+  | GApp (r, [a]) when is_gr r glob_Npos -> bignat_of_pos a
   | GRef (a,_) when Globnames.eq_gr a glob_N0 -> Bigint.zero
   | _ -> raise Non_closed_number
-  )
+  ) n
 
-let uninterp_n p =
+let uninterp_n (AnyGlobConstr p) =
   try Some (bignat_of_n p)
   with Non_closed_number -> None
 
@@ -140,8 +144,8 @@ let uninterp_n p =
 let _ = Notation.declare_numeral_interpreter "N_scope"
   (n_path,binnums)
   n_of_int
-  ([CAst.make @@ GRef (glob_N0, None);
-    CAst.make @@ GRef (glob_Npos, None)],
+  ([DAst.make @@ GRef (glob_N0, None);
+    DAst.make @@ GRef (glob_Npos, None)],
   uninterp_n,
   true)
 
@@ -163,22 +167,22 @@ let z_of_int ?loc n =
   if not (Bigint.equal n zero) then
     let sgn, n =
       if is_pos_or_zero n then glob_POS, n else glob_NEG, Bigint.neg n in
-    CAst.make ?loc @@ GApp(CAst.make ?loc @@ GRef(sgn,None), [pos_of_bignat ?loc n])
+    DAst.make ?loc @@ GApp(DAst.make ?loc @@ GRef(sgn,None), [pos_of_bignat ?loc n])
   else
-    CAst.make ?loc @@ GRef(glob_ZERO, None)
+    DAst.make ?loc @@ GRef(glob_ZERO, None)
 
 (**********************************************************************)
 (* Printing Z via scopes                                              *)
 (**********************************************************************)
 
-let bigint_of_z = CAst.with_val (function
-  | GApp ({ CAst.v = GRef (b,_)},[a]) when Globnames.eq_gr b glob_POS -> bignat_of_pos a
-  | GApp ({ CAst.v = GRef (b,_)},[a]) when Globnames.eq_gr b glob_NEG -> Bigint.neg (bignat_of_pos a)
+let bigint_of_z z = DAst.with_val (function
+  | GApp (r, [a]) when is_gr r glob_POS -> bignat_of_pos a
+  | GApp (r, [a]) when is_gr r glob_NEG -> Bigint.neg (bignat_of_pos a)
   | GRef (a, _) when Globnames.eq_gr a glob_ZERO -> Bigint.zero
   | _ -> raise Non_closed_number
-  )
+  ) z
 
-let uninterp_z p =
+let uninterp_z (AnyGlobConstr p) =
   try
     Some (bigint_of_z p)
   with Non_closed_number -> None
@@ -189,8 +193,8 @@ let uninterp_z p =
 let _ = Notation.declare_numeral_interpreter "Z_scope"
   (z_path,binnums)
   z_of_int
-  ([CAst.make @@ GRef (glob_ZERO, None);
-    CAst.make @@ GRef (glob_POS, None);
-    CAst.make @@ GRef (glob_NEG, None)],
+  ([DAst.make @@ GRef (glob_ZERO, None);
+    DAst.make @@ GRef (glob_POS, None);
+    DAst.make @@ GRef (glob_NEG, None)],
   uninterp_z,
   true)
diff --git a/pretyping/arguments_renaming.ml b/pretyping/arguments_renaming.ml
index ea33f1c0d..8ac471404 100644
--- a/pretyping/arguments_renaming.ml
+++ b/pretyping/arguments_renaming.ml
@@ -10,6 +10,7 @@
 open Names
 open Globnames
 open Term
+open Constr
 open Environ
 open Util
 open Libobject
@@ -39,16 +40,10 @@ let subst_rename_args (subst, (_, (r, names as orig))) =
   let r' = fst (subst_global subst r) in 
   if r==r' then orig else (r', names)
 
-let section_segment_of_reference = function
-  | ConstRef con -> Lib.section_segment_of_constant con
-  | IndRef (kn,_) | ConstructRef ((kn,_),_) ->
-      Lib.section_segment_of_mutual_inductive kn
-  | _ -> [], Univ.LMap.empty, Univ.AUContext.empty
-
 let discharge_rename_args = function
   | _, (ReqGlobal (c, names), _ as req) ->
      (try 
-       let vars,_,_ = section_segment_of_reference c in
+       let vars = Lib.variable_section_segment_of_reference c in
        let c' = pop_global_reference c in
        let var_names = List.map (fst %> NamedDecl.get_id %> Name.mk_name) vars in
        let names' = var_names @ names in
@@ -103,7 +98,7 @@ let rename_type_of_constructor env cstruct =
 let rename_typing env c =
   let j = Typeops.infer env c in
   let j' =
-    match kind_of_term c with
+    match kind c with
     | Const (c,u) -> { j with uj_type = rename_type j.uj_type (ConstRef c) }
     | Ind (i,u) -> { j with uj_type = rename_type j.uj_type (IndRef i) }
     | Construct (k,u) -> { j with uj_type = rename_type j.uj_type (ConstructRef k) }
diff --git a/pretyping/arguments_renaming.mli b/pretyping/arguments_renaming.mli
index 804e38216..b499da3ab 100644
--- a/pretyping/arguments_renaming.mli
+++ b/pretyping/arguments_renaming.mli
@@ -9,7 +9,7 @@
 open Names
 open Globnames
 open Environ
-open Term
+open Constr
 
 val rename_arguments : bool -> global_reference -> Name.t list -> unit
 
diff --git a/pretyping/cases.ml b/pretyping/cases.ml
index 63775d737..a0434f927 100644
--- a/pretyping/cases.ml
+++ b/pretyping/cases.ml
@@ -13,7 +13,7 @@ open CErrors
 open Util
 open Names
 open Nameops
-open Term
+open Constr
 open Termops
 open Environ
 open EConstr
@@ -33,6 +33,7 @@ open Evarsolve
 open Evarconv
 open Evd
 open Context.Rel.Declaration
+open Ltac_pretype
 
 module RelDecl = Context.Rel.Declaration
 module NamedDecl = Context.Named.Declaration
@@ -94,7 +95,7 @@ let msg_may_need_inversion () =
 
 (* Utils *)
 let make_anonymous_patvars n =
-  List.make n (CAst.make @@ PatVar Anonymous)
+  List.make n (DAst.make @@ PatVar Anonymous)
 
 (* We have x1:t1...xn:tn,xi':ti,y1..yk |- c and re-generalize
    over xi:ti to get x1:t1...xn:tn,xi':ti,y1..yk |- c[xi:=xi'] *)
@@ -113,8 +114,8 @@ let rec relocate_index sigma n1 n2 k t =
 
 type 'a rhs =
     { rhs_env    : env;
-      rhs_vars   : Id.t list;
-      avoid_ids  : Id.t list;
+      rhs_vars   : Id.Set.t;
+      avoid_ids  : Id.Set.t;
       it         : 'a option}
 
 type 'a equation =
@@ -177,7 +178,7 @@ and build_glob_pattern args = function
   | Top -> args
   | MakeConstructor (pci, rh) ->
       glob_pattern_of_partial_history
-	[CAst.make @@ PatCstr (pci, args, Anonymous)] rh
+	[DAst.make @@ PatCstr (pci, args, Anonymous)] rh
 
 let complete_history = glob_pattern_of_partial_history []
 
@@ -187,12 +188,12 @@ let pop_history_pattern = function
   | Continuation (0, l, Top) ->
       Result (List.rev l)
   | Continuation (0, l, MakeConstructor (pci, rh)) ->
-      feed_history (CAst.make @@ PatCstr (pci,List.rev l,Anonymous)) rh
+      feed_history (DAst.make @@ PatCstr (pci,List.rev l,Anonymous)) rh
   | _ ->
       anomaly (Pp.str "Constructor not yet filled with its arguments.")
 
 let pop_history h =
-  feed_history (CAst.make @@ PatVar Anonymous) h
+  feed_history (DAst.make @@ PatVar Anonymous) h
 
 (* Builds a continuation expecting [n] arguments and building [ci] applied
    to this [n] arguments *)
@@ -245,7 +246,7 @@ let push_history_pattern n pci cont =
 
 type 'a pattern_matching_problem =
     { env       : env;
-      lvar      : Glob_term.ltac_var_map;
+      lvar      : Ltac_pretype.ltac_var_map;
       evdref    : evar_map ref;
       pred      : constr;
       tomatch   : tomatch_stack;
@@ -273,8 +274,10 @@ type 'a pattern_matching_problem =
 
 let rec find_row_ind = function
     [] -> None
-  | { CAst.v = PatVar _ } :: l -> find_row_ind l
-  | { CAst.v = PatCstr(c,_,_) ; loc } :: _ -> Some (loc,c)
+  | p :: l ->
+    match DAst.get p with
+    | PatVar _ -> find_row_ind l
+    | PatCstr(c,_,_) -> Some (p.CAst.loc,c)
 
 let inductive_template evdref env tmloc ind =
   let indu = evd_comb1 (Evd.fresh_inductive_instance env) evdref ind in
@@ -348,7 +351,7 @@ let find_tomatch_tycon evdref env loc = function
       empty_tycon,None
 
 let make_return_predicate_ltac_lvar sigma na tm c lvar =
-  match na, tm.CAst.v with
+  match na, DAst.get tm with
   | Name id, (GVar id' | GRef (Globnames.VarRef id', _)) when Id.equal id id' ->
      if Id.Map.mem id lvar.ltac_genargs then
        let ltac_genargs = Id.Map.remove id lvar.ltac_genargs in
@@ -447,11 +450,6 @@ let current_pattern eqn =
     | pat::_ -> pat
     | [] -> anomaly (Pp.str "Empty list of patterns.")
 
-let alias_of_pat = CAst.with_val (function
-  | PatVar name -> name
-  | PatCstr(_,_,name) -> name
-  )
-
 let remove_current_pattern eqn =
   match eqn.patterns with
     | pat::pats ->
@@ -493,13 +491,14 @@ let rec adjust_local_defs ?loc = function
   | (pat :: pats, LocalAssum _ :: decls) ->
       pat :: adjust_local_defs ?loc (pats,decls)
   | (pats, LocalDef _ :: decls) ->
-      (CAst.make ?loc @@ PatVar Anonymous) :: adjust_local_defs ?loc (pats,decls)
+      (DAst.make ?loc @@ PatVar Anonymous) :: adjust_local_defs ?loc (pats,decls)
   | [], [] -> []
   | _ -> raise NotAdjustable
 
-let check_and_adjust_constructor env ind cstrs = function
-  | { CAst.v = PatVar _ } as pat -> pat
-  | { CAst.v = PatCstr (((_,i) as cstr),args,alias) ; loc } as pat ->
+let check_and_adjust_constructor env ind cstrs pat = match DAst.get pat with
+  | PatVar _ -> pat
+  | PatCstr (((_,i) as cstr),args,alias) ->
+      let loc = pat.CAst.loc in
       (* Check it is constructor of the right type *)
       let ind' = inductive_of_constructor cstr in
       if eq_ind ind' ind then
@@ -510,7 +509,7 @@ let check_and_adjust_constructor env ind cstrs = function
 	else
 	  try
 	    let args' = adjust_local_defs ?loc (args, List.rev ci.cs_args)
-	    in CAst.make ?loc @@ PatCstr (cstr, args', alias)
+	    in DAst.make ?loc @@ PatCstr (cstr, args', alias)
 	  with NotAdjustable ->
 	    error_wrong_numarg_constructor ?loc env cstr nb_args_constr
       else
@@ -522,9 +521,12 @@ let check_and_adjust_constructor env ind cstrs = function
 
 let check_all_variables env sigma typ mat =
   List.iter
-    (fun eqn -> match current_pattern eqn with
-       | { CAst.v = PatVar id } -> ()
-       | { CAst.v = PatCstr (cstr_sp,_,_); loc } ->
+    (fun eqn ->
+      let pat = current_pattern eqn in
+      match DAst.get pat with
+       | PatVar id -> ()
+       | PatCstr (cstr_sp,_,_) ->
+          let loc = pat.CAst.loc in
 	   error_bad_pattern ?loc env sigma cstr_sp typ)
     mat
 
@@ -547,11 +549,11 @@ let extract_rhs pb =
 let occur_in_rhs na rhs =
   match na with
     | Anonymous -> false
-    | Name id -> Id.List.mem id rhs.rhs_vars
+    | Name id -> Id.Set.mem id rhs.rhs_vars
 
-let is_dep_patt_in eqn = function
-  | { CAst.v = PatVar name } -> Flags.is_program_mode () || occur_in_rhs name eqn.rhs
-  | { CAst.v = PatCstr _ } -> true
+let is_dep_patt_in eqn pat = match DAst.get pat with
+  | PatVar name -> Flags.is_program_mode () || occur_in_rhs name eqn.rhs
+  | PatCstr _ -> true
 
 let mk_dep_patt_row (pats,_,eqn) =
   List.map (is_dep_patt_in eqn) pats
@@ -741,8 +743,8 @@ let get_names env sigma sign eqns =
   (* Otherwise, we take names from the parameters of the constructor but
      avoiding conflicts with user ids *)
   let allvars =
-    List.fold_left (fun l (_,_,eqn) -> List.union Id.equal l eqn.rhs.avoid_ids)
-      [] eqns in
+    List.fold_left (fun l (_,_,eqn) -> Id.Set.union l eqn.rhs.avoid_ids)
+      Id.Set.empty eqns in
   let names3,_ =
     List.fold_left2
       (fun (l,avoid) d na ->
@@ -751,7 +753,7 @@ let get_names env sigma sign eqns =
 	     (fun (LocalAssum (na,t) | LocalDef (na,_,t)) -> Name (next_name_away (named_hd env sigma t na) avoid))
 	     d na
 	 in
-         (na::l,(Name.get_id na)::avoid))
+         (na::l,Id.Set.add (Name.get_id na) avoid))
       ([],allvars) (List.rev sign) names2 in
   names3,aliasname
 
@@ -771,7 +773,7 @@ let recover_and_adjust_alias_names names sign =
   | x::names, LocalAssum (_,t)::sign ->
       (x, LocalAssum (alias_of_pat x,t)) :: aux (names,sign)
   | names, (LocalDef (na,_,_) as decl)::sign ->
-      (CAst.make @@ PatVar na, decl) :: aux (names,sign)
+      (DAst.make @@ PatVar na, decl) :: aux (names,sign)
   | _ -> assert false
   in
   List.split (aux (names,sign))
@@ -987,14 +989,14 @@ let use_unit_judge evd =
     evd', j
 
 let add_assert_false_case pb tomatch =
-  let pats = List.map (fun _ -> CAst.make @@ PatVar Anonymous) tomatch in
+  let pats = List.map (fun _ -> DAst.make @@ PatVar Anonymous) tomatch in
   let aliasnames =
     List.map_filter (function Alias _ | NonDepAlias -> Some Anonymous | _ -> None) tomatch
   in
   [ { patterns = pats;
       rhs = { rhs_env = pb.env;
-	      rhs_vars = [];
-	      avoid_ids = [];
+	      rhs_vars = Id.Set.empty;
+	      avoid_ids = Id.Set.empty;
 	      it = None };
       alias_stack = Anonymous::aliasnames;
       eqn_loc = None;
@@ -1007,7 +1009,7 @@ let adjust_impossible_cases pb pred tomatch submat =
         this means that the Evd.define below may redefine an already defined
         evar. See e.g. first definition of test for bug #3388. *)
     let pred = EConstr.Unsafe.to_constr pred in
-    begin match kind_of_term pred with
+    begin match Constr.kind pred with
     | Evar (evk,_) when snd (evar_source evk !(pb.evdref)) == Evar_kinds.ImpossibleCase ->
         if not (Evd.is_defined !(pb.evdref) evk) then begin
 	  let evd, default = use_unit_judge !(pb.evdref) in
@@ -1184,9 +1186,9 @@ let postprocess_dependencies evd tocheck brs tomatch pred deps cs =
 (************************************************************************)
 (* Sorting equations by constructor *)
 
-let rec irrefutable env = function
-  | { CAst.v = PatVar name } -> true
-  | { CAst.v = PatCstr (cstr,args,_) } ->
+let rec irrefutable env pat = match DAst.get pat with
+  | PatVar name -> true
+  | PatCstr (cstr,args,_) ->
       let ind = inductive_of_constructor cstr in
       let (_,mip) = Inductive.lookup_mind_specif env ind in
       let one_constr = Int.equal (Array.length mip.mind_user_lc) 1 in
@@ -1206,15 +1208,15 @@ let group_equations pb ind current cstrs mat =
       (fun eqn () ->
 	 let rest = remove_current_pattern eqn in
 	 let pat = current_pattern eqn in
-	 match check_and_adjust_constructor pb.env ind cstrs pat with
-	   | { CAst.v = PatVar name } ->
+	 match DAst.get (check_and_adjust_constructor pb.env ind cstrs pat) with
+	   | PatVar name ->
 	       (* This is a default clause that we expand *)
 	       for i=1 to Array.length cstrs do
 		 let args = make_anonymous_patvars cstrs.(i-1).cs_nargs in
 		 brs.(i-1) <- (args, name, rest) :: brs.(i-1)
 	       done;
 	       if !only_default == None then only_default := Some true
-	   | { CAst.v = PatCstr (((_,i)),args,name) ; loc } ->
+	   | PatCstr (((_,i)),args,name) ->
 	       (* This is a regular clause *)
 	       only_default := Some false;
 	       brs.(i-1) <- (args, name, rest) :: brs.(i-1)) mat () in
@@ -1269,7 +1271,7 @@ let build_branch initial current realargs deps (realnames,curname) pb arsign eqn
   (* This is a bit too strong I think, in the sense that what we would *)
   (* really like is to have beta-iota reduction only at the positions where *)
   (* parameters are substituted *)
-  let typs = List.map (map_type (nf_betaiota !(pb.evdref))) typs in
+  let typs = List.map (map_type (nf_betaiota pb.env !(pb.evdref))) typs in
 
   (* We build the matrix obtained by expanding the matching on *)
   (* "C x1..xn as x" followed by a residual matching on eqn into *)
@@ -1419,7 +1421,7 @@ and match_current pb (initial,tomatch) =
 	    find_predicate pb.caseloc pb.env pb.evdref
 	      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 pred = nf_betaiota pb.env !(pb.evdref) pred in
 	  let case =
 	    make_case_or_project pb.env !(pb.evdref) indf ci pred current brvals
 	  in
@@ -1559,15 +1561,15 @@ substituer après par les initiaux *)
 
 (* builds the matrix of equations testing that each eqn has n patterns
  * and linearizing the _ patterns.
- * Syntactic correctness has already been done in astterm *)
+ * Syntactic correctness has already been done in constrintern *)
 let matx_of_eqns env eqns =
-  let build_eqn (loc,(ids,lpat,rhs)) =
-    let initial_lpat,initial_rhs = lpat,rhs in
-    let initial_rhs = rhs in
+  let build_eqn (loc,(ids,initial_lpat,initial_rhs)) =
+    let avoid = ids_of_named_context_val (named_context_val env) in
+    let avoid = List.fold_left (fun accu id -> Id.Set.add id accu) avoid ids in
     let rhs =
       { rhs_env = env;
         rhs_vars = free_glob_vars initial_rhs;
-	avoid_ids = ids@(ids_of_named_context (named_context env));
+	avoid_ids = avoid;
 	it = Some initial_rhs } in
     { patterns = initial_lpat;
       alias_stack = [];
@@ -1656,7 +1658,7 @@ let rec list_assoc_in_triple x = function
 *)
 
 let abstract_tycon ?loc env evdref subst tycon extenv t =
-  let t = nf_betaiota !evdref t in (* it helps in some cases to remove K-redex*)
+  let t = nf_betaiota env !evdref t in (* it helps in some cases to remove K-redex*)
   let src = match EConstr.kind !evdref t with
     | Evar (evk,_) -> (Loc.tag ?loc @@ Evar_kinds.SubEvar evk)
     | _ -> (Loc.tag ?loc @@ Evar_kinds.CasesType true) in
@@ -1745,16 +1747,16 @@ let build_tycon ?loc env tycon_env s subst tycon extenv evdref t =
 let build_inversion_problem loc env sigma tms t =
   let make_patvar t (subst,avoid) =
     let id = next_name_away (named_hd env sigma t Anonymous) avoid in
-    CAst.make @@ PatVar (Name id), ((id,t)::subst, id::avoid) in
+    DAst.make @@ PatVar (Name id), ((id,t)::subst, Id.Set.add id avoid) in
   let rec reveal_pattern t (subst,avoid as acc) =
     match EConstr.kind sigma (whd_all env sigma t) with
-    | Construct (cstr,u) -> CAst.make (PatCstr (cstr,[],Anonymous)), acc
+    | Construct (cstr,u) -> DAst.make (PatCstr (cstr,[],Anonymous)), acc
     | App (f,v) when isConstruct sigma f ->
 	let cstr,u = destConstruct sigma f in
 	let n = constructor_nrealargs_env env cstr in
 	let l = List.lastn n (Array.to_list v) in
 	let l,acc = List.fold_right_map reveal_pattern l acc in
-	CAst.make (PatCstr (cstr,l,Anonymous)), acc
+	DAst.make (PatCstr (cstr,l,Anonymous)), acc
     | _ -> make_patvar t acc in
   let rec aux n env acc_sign tms acc =
     match tms with
@@ -1775,7 +1777,7 @@ let build_inversion_problem loc env sigma tms t =
       let d = LocalAssum (alias_of_pat pat,typ) in
       let patl,acc_sign,acc = aux (n+1) (push_rel d env) (d::acc_sign) tms acc in
       pat::patl,acc_sign,acc in
-  let avoid0 = ids_of_context env in
+  let avoid0 = vars_of_env env in
   (* [patl] is a list of patterns revealing the substructure of
      constructors present in the constraints on the type of the
      multiple terms t1..tn that are matched in the original problem;
@@ -1817,7 +1819,7 @@ let build_inversion_problem loc env sigma tms t =
       rhs = { rhs_env = pb_env;
               (* we assume all vars are used; in practice we discard dependent
 		 vars so that the field rhs_vars is normally not used *)
-              rhs_vars = List.map fst subst;
+              rhs_vars = List.fold_left (fun accu (id, _) -> Id.Set.add id accu) Id.Set.empty subst;
               avoid_ids = avoid;
 	      it = Some (lift n t) } } in
   (* [catch_all] is a catch-all default clause of the auxiliary
@@ -1830,12 +1832,12 @@ let build_inversion_problem loc env sigma tms t =
       (* No need for a catch all clause *)
       []
     else
-      [ { patterns = List.map (fun _ -> CAst.make @@ PatVar Anonymous) patl;
+      [ { patterns = List.map (fun _ -> DAst.make @@ PatVar Anonymous) patl;
           alias_stack = [];
           eqn_loc = None;
           used = ref false;
           rhs = { rhs_env = pb_env;
-                  rhs_vars = [];
+                  rhs_vars = Id.Set.empty;
 	          avoid_ids = avoid0;
 	          it = None } } ] in
   (* [pb] is the auxiliary pattern-matching serving as skeleton for the
@@ -2079,7 +2081,7 @@ let prime avoid name =
 
 let make_prime avoid prevname =
   let previd, id = prime !avoid prevname in
-    avoid := id :: !avoid;
+    avoid := Id.Set.add id !avoid;
     previd, id
 
 let eq_id avoid id =
@@ -2094,22 +2096,22 @@ let mk_JMeq evdref typ x typ' y =
 let mk_JMeq_refl evdref typ x = 
   papp evdref coq_JMeq_refl [| typ; x |]
 
-let hole na = CAst.make @@
+let hole na = DAst.make @@
   GHole (Evar_kinds.QuestionMark (Evar_kinds.Define false,na),
          Misctypes.IntroAnonymous, None)
 
 let constr_of_pat env evdref arsign pat avoid =
   let rec typ env (ty, realargs) pat avoid =
     let loc = pat.CAst.loc in
-    match pat.CAst.v with
+    match DAst.get pat with
     | PatVar name ->
 	let name, avoid = match name with
 	    Name n -> name, avoid
 	  | Anonymous ->
 	      let previd, id = prime avoid (Name (Id.of_string "wildcard")) in
-		Name id, id :: avoid
+		Name id, Id.Set.add id avoid
 	in
-	  ((CAst.make ?loc @@ PatVar name), [LocalAssum (name, ty)] @ realargs, mkRel 1, ty,
+	  ((DAst.make ?loc @@ PatVar name), [LocalAssum (name, ty)] @ realargs, mkRel 1, ty,
 	   (List.map (fun x -> mkRel 1) realargs), 1, avoid)
     | PatCstr (((_, i) as cstr),args,alias) ->
 	let cind = inductive_of_constructor cstr in
@@ -2140,7 +2142,7 @@ let constr_of_pat env evdref arsign pat avoid =
 	in
 	let args = List.rev args in
 	let patargs = List.rev patargs in
-	let pat' = CAst.make ?loc @@ PatCstr (cstr, patargs, alias) in
+	let pat' = DAst.make ?loc @@ PatCstr (cstr, patargs, alias) in
 	let cstr = mkConstructU (on_snd EInstance.make ci.cs_cstr) in
 	let app = applist (cstr, List.map (lift (List.length sign)) params) in
 	let app = applist (app, args) in
@@ -2151,7 +2153,7 @@ let constr_of_pat env evdref arsign pat avoid =
 		pat', sign, app, apptype, realargs, n, avoid
 	    | Name id ->
 		let sign = LocalAssum (alias, lift m ty) :: sign in
-		let avoid = id :: avoid in
+		let avoid = Id.Set.add id avoid in
 		let sign, i, avoid =
 		  try
 		    let env = push_rel_context sign env in
@@ -2162,7 +2164,7 @@ let constr_of_pat env evdref arsign pat avoid =
 		      (lift 1 app) (* aliased term *)
 		    in
 		    let neq = eq_id avoid id in
-		      LocalDef (Name neq, mkRel 0, eq_t) :: sign, 2, neq :: avoid
+		      LocalDef (Name neq, mkRel 0, eq_t) :: sign, 2, Id.Set.add neq avoid
 		  with Reduction.NotConvertible -> sign, 1, avoid
 		in
 		  (* Mark the equality as a hole *)
@@ -2176,7 +2178,7 @@ let constr_of_pat env evdref arsign pat avoid =
 let eq_id avoid id =
   let hid = Id.of_string ("Heq_" ^ Id.to_string id) in
   let hid' = next_ident_away hid !avoid in
-    avoid := hid' :: !avoid;
+    avoid := Id.Set.add hid' !avoid;
     hid'
 
 let is_topvar sigma t =
@@ -2196,18 +2198,18 @@ let vars_of_ctx sigma ctx =
       match decl with
 	| LocalDef (na,t',t) when is_topvar sigma t' ->
 	    prev,
-	    (CAst.make @@ GApp (
-		(CAst.make @@ GRef (delayed_force coq_eq_refl_ref, None)), 
-		   [hole na; CAst.make @@ GVar prev])) :: vars
+	    (DAst.make @@ GApp (
+		(DAst.make @@ GRef (delayed_force coq_eq_refl_ref, None)), 
+		   [hole na; DAst.make @@ GVar prev])) :: vars
 	| _ ->
 	    match RelDecl.get_name decl with
 		Anonymous -> invalid_arg "vars_of_ctx"
-	      | Name n -> n, (CAst.make @@ GVar n) :: vars)
+	      | Name n -> n, (DAst.make @@ GVar n) :: vars)
       ctx (Id.of_string "vars_of_ctx_error", [])
   in List.rev y
 
 let rec is_included x y =
-  match CAst.(x.v, y.v) with
+  match DAst.get x, DAst.get y with
     | PatVar _, _ -> true
     | _, PatVar _ -> true
     | PatCstr ((_, i), args, alias), PatCstr ((_, i'), args', alias')  ->
@@ -2272,7 +2274,7 @@ let constrs_of_pats typing_fun env evdref eqns tomatchs sign neqs arity =
 	     (fun (idents, newpatterns, pats) pat arsign ->
 		let pat', cpat, idents = constr_of_pat env evdref arsign pat idents in
 		  (idents, pat' :: newpatterns, cpat :: pats))
-	      ([], [], []) eqn.patterns sign
+	      (Id.Set.empty, [], []) eqn.patterns sign
 	 in
 	 let newpatterns = List.rev newpatterns and opats = List.rev pats in
 	 let rhs_rels, pats, signlen =
@@ -2325,13 +2327,13 @@ let constrs_of_pats typing_fun env evdref eqns tomatchs sign neqs arity =
 	 let branch_name = Id.of_string ("program_branch_" ^ (string_of_int !i)) in
 	 let branch_decl = LocalDef (Name branch_name, lift !i bbody, lift !i btype) in
 	 let branch =
-	   let bref = CAst.make @@ GVar branch_name in
+	   let bref = DAst.make @@ GVar branch_name in
 	     match vars_of_ctx !evdref rhs_rels with
 		 [] -> bref
-	       | l  -> CAst.make @@ GApp (bref, l)
+	       | l  -> DAst.make @@ GApp (bref, l)
 	 in
 	 let branch = match ineqs with
-	     Some _ -> CAst.make @@ GApp (branch, [ hole Anonymous ])
+	     Some _ -> DAst.make @@ GApp (branch, [ hole Anonymous ])
 	   | None -> branch
 	 in
 	 incr i;
@@ -2373,8 +2375,8 @@ let abstract_tomatch env sigma tomatchs tycon =
 	       let name = next_ident_away (Id.of_string "filtered_var") names in
 		 (mkRel 1, lift_tomatch_type (succ lenctx) t) :: lift_ctx 1 prev,
 	       LocalDef (Name name, lift lenctx c, lift lenctx $ type_of_tomatch t) :: ctx,
-	       name :: names, tycon)
-      ([], [], [], tycon) tomatchs
+	       Id.Set.add name names, tycon)
+      ([], [], Id.Set.empty, tycon) tomatchs
   in List.rev prev, ctx, tycon
 
 let build_dependent_signature env evdref avoid tomatchs arsign =
@@ -2496,7 +2498,7 @@ let compile_program_cases ?loc style (typing_function, evdref) tycon env lvar
     let arsign = List.map fst arsign in (* Because no difference between the arity for typing and the arity for building *)
       (* Build the dependent arity signature, the equalities which makes
 	 the first part of the predicate and their instantiations. *)
-    let avoid = [] in
+    let avoid = Id.Set.empty in
       build_dependent_signature env evdref avoid tomatchs arsign
 
   in
diff --git a/pretyping/cases.mli b/pretyping/cases.mli
index 428f64b99..43dbc3105 100644
--- a/pretyping/cases.mli
+++ b/pretyping/cases.mli
@@ -7,13 +7,14 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Evd
 open Environ
 open EConstr
 open Inductiveops
 open Glob_term
-open Evarutil
+open Ltac_pretype
+open Evardefine
 
 (** {5 Compilation of pattern-matching } *)
 
@@ -49,16 +50,16 @@ val constr_of_pat :
            Evd.evar_map ref ->
            rel_context ->
            Glob_term.cases_pattern ->
-           Names.Id.t list ->
+           Names.Id.Set.t ->
            Glob_term.cases_pattern *
            (rel_context * constr *
             (types * constr list) * Glob_term.cases_pattern) *
-           Names.Id.t list
+           Names.Id.Set.t
 
 type 'a rhs =
     { rhs_env    : env;
-      rhs_vars   : Id.t list;
-      avoid_ids  : Id.t list;
+      rhs_vars   : Id.Set.t;
+      avoid_ids  : Id.Set.t;
       it         : 'a option}
 
 type 'a equation =
@@ -101,7 +102,7 @@ and pattern_continuation =
 
 type 'a pattern_matching_problem =
     { env       : env;
-      lvar      : Glob_term.ltac_var_map;
+      lvar      : Ltac_pretype.ltac_var_map;
       evdref    : evar_map ref;
       pred      : constr;
       tomatch   : tomatch_stack;
@@ -115,15 +116,15 @@ type 'a pattern_matching_problem =
 val compile : 'a pattern_matching_problem -> unsafe_judgment
 
 val prepare_predicate : ?loc:Loc.t ->
-           (Evarutil.type_constraint ->
+           (type_constraint ->
             Environ.env -> Evd.evar_map ref -> ltac_var_map -> glob_constr -> unsafe_judgment) ->
            Environ.env ->
            Evd.evar_map ->
-           Glob_term.ltac_var_map ->
+           Ltac_pretype.ltac_var_map ->
            (types * tomatch_type) list ->
            (rel_context * rel_context) list ->
            constr option ->
-           glob_constr option -> (Evd.evar_map * Names.name list * constr) list
+           glob_constr option -> (Evd.evar_map * Name.t list * constr) list
 
-val make_return_predicate_ltac_lvar : Evd.evar_map -> Names.name ->
-  Glob_term.glob_constr -> constr -> Glob_term.ltac_var_map -> Glob_term.ltac_var_map
+val make_return_predicate_ltac_lvar : Evd.evar_map -> Name.t ->
+  Glob_term.glob_constr -> constr -> Ltac_pretype.ltac_var_map -> ltac_var_map
diff --git a/pretyping/cbv.ml b/pretyping/cbv.ml
index 19d61a64d..e42576d95 100644
--- a/pretyping/cbv.ml
+++ b/pretyping/cbv.ml
@@ -8,7 +8,7 @@
 
 open Util
 open Names
-open Term
+open Constr
 open Vars
 open CClosure
 open Esubst
@@ -45,7 +45,7 @@ type cbv_value =
   | LAM of int * (Name.t * constr) list * constr * cbv_value subs
   | FIXP of fixpoint * cbv_value subs * cbv_value array
   | COFIXP of cofixpoint * cbv_value subs * cbv_value array
-  | CONSTR of constructor puniverses * cbv_value array
+  | CONSTR of constructor Univ.puniverses * cbv_value array
 
 (* type of terms with a hole. This hole can appear only under App or Case.
  *   TOP means the term is considered without context
@@ -171,7 +171,7 @@ let fixp_reducible flgs ((reci,i),_) stk =
 let cofixp_reducible flgs _ stk =
   if red_set flgs fCOFIX then
     match stk with
-      | (CASE _ | APP(_,CASE _)) -> true
+      | (CASE _ | PROJ _ | APP(_,CASE _) | APP(_,PROJ _)) -> true
       | _ -> false
   else
     false
@@ -208,25 +208,32 @@ and reify_value = function (* reduction under binders *)
   | STACK (n,v,stk) ->
       lift n (reify_stack (reify_value v) stk)
   | CBN(t,env) ->
-    t
-      (* map_constr_with_binders subs_lift (cbv_norm_term) env t *)
-  | LAM (n,ctxt,b,env) ->
-      List.fold_left (fun c (n,t)  -> Term.mkLambda (n, t, c)) b ctxt
+    apply_env env t
+  | LAM (k,ctxt,b,env) ->
+    apply_env env @@
+    List.fold_left (fun c (n,t) ->
+        mkLambda (n, t, c)) b ctxt
   | FIXP ((lij,(names,lty,bds)),env,args) ->
-      mkApp
-        (mkFix (lij,
-		(names,
-		 lty,
-		 bds)),
-         Array.map reify_value args)
+    let fix = mkFix (lij, (names, lty, bds)) in
+    mkApp (apply_env env fix, Array.map reify_value args)
   | COFIXP ((j,(names,lty,bds)),env,args) ->
-      mkApp
-        (mkCoFix (j,
-		  (names,lty,bds)),
-         Array.map reify_value args)
+    let cofix = mkCoFix (j, (names,lty,bds)) in
+    mkApp (apply_env env cofix, Array.map reify_value args)
   | CONSTR (c,args) ->
       mkApp(mkConstructU c, Array.map reify_value args)
 
+and apply_env env t =
+  match kind t with
+  | Rel i ->
+    begin match expand_rel i env with
+      | Inl (k, v) ->
+        reify_value (shift_value k v)
+      | Inr (k,_) ->
+        mkRel k
+    end
+  | _ ->
+    map_with_binders subs_lift apply_env env t
+
 (* The main recursive functions
  *
  * Go under applications and cases/projections (pushed in the stack), 
@@ -240,7 +247,7 @@ and reify_value = function (* reduction under binders *)
 
 let rec norm_head info env t stack =
   (* no reduction under binders *)
-  match kind_of_term t with
+  match kind t with
   (* stack grows (remove casts) *)
   | App (head,args) -> (* Applied terms are normalized immediately;
                         they could be computed when getting out of the stack *)
@@ -290,11 +297,14 @@ let rec norm_head info env t stack =
   | Evar ev ->
       (match evar_value info.infos.i_cache ev with
           Some c -> norm_head info env c stack
-        | None -> (VAL(0, t), stack))
+        | None ->
+          let e, xs = ev in
+          let xs' = Array.map (apply_env env) xs in
+          (VAL(0, mkEvar (e,xs')), stack))
 
   (* non-neutral cases *)
   | Lambda _ ->
-      let ctxt,b = decompose_lam t in
+      let ctxt,b = Term.decompose_lam t in
       (LAM(List.length ctxt, List.rev ctxt,b,env), stack)
   | Fix fix -> (FIXP(fix,env,[||]), stack)
   | CoFix cofix -> (COFIXP(cofix,env,[||]), stack)
@@ -411,12 +421,12 @@ and cbv_norm_value info = function (* reduction under binders *)
   | STACK (n,v,stk) ->
       lift n (apply_stack info (cbv_norm_value info v) stk)
   | CBN(t,env) ->
-      map_constr_with_binders subs_lift (cbv_norm_term info) env t
+      Constr.map_with_binders subs_lift (cbv_norm_term info) env t
   | LAM (n,ctxt,b,env) ->
       let nctxt =
         List.map_i (fun i (x,ty) ->
           (x,cbv_norm_term info (subs_liftn i env) ty)) 0 ctxt in
-      compose_lam (List.rev nctxt) (cbv_norm_term info (subs_liftn n env) b)
+      Term.compose_lam (List.rev nctxt) (cbv_norm_term info (subs_liftn n env) b)
   | FIXP ((lij,(names,lty,bds)),env,args) ->
       mkApp
         (mkFix (lij,
diff --git a/pretyping/cbv.mli b/pretyping/cbv.mli
index 3ee7bebf0..1d4c88ea2 100644
--- a/pretyping/cbv.mli
+++ b/pretyping/cbv.mli
@@ -24,7 +24,7 @@ val cbv_norm         : cbv_infos -> constr -> constr
 (***********************************************************************
   i This is for cbv debug *)
 
-open Term
+open Constr
 
 type cbv_value =
   | VAL of int * constr
@@ -33,7 +33,7 @@ type cbv_value =
   | LAM of int * (Name.t * constr) list * constr * cbv_value subs
   | FIXP of fixpoint * cbv_value subs * cbv_value array
   | COFIXP of cofixpoint * cbv_value subs * cbv_value array
-  | CONSTR of constructor puniverses * cbv_value array
+  | CONSTR of constructor Univ.puniverses * cbv_value array
 
 and cbv_stack =
   | TOP
diff --git a/pretyping/classops.ml b/pretyping/classops.ml
index 1cc072a2a..6d5ee504e 100644
--- a/pretyping/classops.ml
+++ b/pretyping/classops.ml
@@ -9,14 +9,13 @@
 open CErrors
 open Util
 open Pp
-open Flags
 open Names
+open Constr
 open Libnames
 open Globnames
 open Nametab
 open Environ
 open Libobject
-open Term
 open Mod_subst
 
 (* usage qque peu general: utilise aussi dans record *)
@@ -28,9 +27,9 @@ type cl_typ =
   | CL_SORT
   | CL_FUN
   | CL_SECVAR of variable
-  | CL_CONST of constant
+  | CL_CONST of Constant.t
   | CL_IND of inductive
-  | CL_PROJ of constant
+  | CL_PROJ of Constant.t
 
 type cl_info_typ = {
   cl_param : int
@@ -44,7 +43,7 @@ type coe_info_typ = {
   coe_value : constr;
   coe_type : types;
   coe_local : bool;
-  coe_context : Univ.universe_context_set;
+  coe_context : Univ.ContextSet.t;
   coe_is_identity : bool;
   coe_is_projection : bool;
   coe_param : int }
@@ -60,8 +59,8 @@ let coe_info_typ_equal c1 c2 =
 
 let cl_typ_ord t1 t2 = match t1, t2 with
   | CL_SECVAR v1, CL_SECVAR v2 -> Id.compare v1 v2
-  | CL_CONST c1, CL_CONST c2 -> con_ord c1 c2
-  | CL_PROJ c1, CL_PROJ c2 -> con_ord c1 c2
+  | CL_CONST c1, CL_CONST c2 -> Constant.CanOrd.compare c1 c2
+  | CL_PROJ c1, CL_PROJ c2 -> Constant.CanOrd.compare c1 c2
   | CL_IND i1, CL_IND i2 -> ind_ord i1 i2
   | _ -> Pervasives.compare t1 t2 (** OK *)
 
@@ -323,16 +322,16 @@ let coercion_value { coe_value = c; coe_type = t; coe_context = ctx;
 (* pretty-print functions are now in Pretty *)
 (* rajouter une coercion dans le graphe *)
 
-let path_printer = ref (fun _ -> str "<a class path>"
-                        : (Bijint.Index.t * Bijint.Index.t) * inheritance_path -> Pp.t)
+let path_printer : (env -> Evd.evar_map -> (Bijint.Index.t * Bijint.Index.t) * inheritance_path -> Pp.t) ref =
+  ref (fun _ _ _ -> str "<a class path>")
 
 let install_path_printer f = path_printer := f
 
-let print_path x = !path_printer x
+let print_path env sigma x = !path_printer env sigma x
 
-let message_ambig l =
-  (str"Ambiguous paths:" ++ spc () ++
-   prlist_with_sep fnl (fun ijp -> print_path ijp) l)
+let message_ambig env sigma l =
+  str"Ambiguous paths:" ++ spc () ++
+  prlist_with_sep fnl (fun ijp -> print_path env sigma ijp) l
 
 (* add_coercion_in_graph : coe_index * cl_index * cl_index -> unit
                          coercion,source,target *)
@@ -345,8 +344,8 @@ let different_class_params i =
       | CL_IND i -> Global.is_polymorphic (IndRef i)
       | CL_CONST c -> Global.is_polymorphic (ConstRef c)
       | _ -> false
-	
-let add_coercion_in_graph (ic,source,target) =
+
+let add_coercion_in_graph env sigma (ic,source,target) =
   let old_inheritance_graph = !inheritance_graph in
   let ambig_paths =
     (ref [] : ((cl_index * cl_index) * inheritance_path) list ref) in
@@ -387,8 +386,8 @@ let add_coercion_in_graph (ic,source,target) =
       old_inheritance_graph
   end;
   let is_ambig = match !ambig_paths with [] -> false | _ -> true in
-  if is_ambig && not !quiet then
-    Feedback.msg_info (message_ambig !ambig_paths)
+  if is_ambig && not !Flags.quiet then
+    Feedback.msg_info (message_ambig env sigma !ambig_paths)
 
 type coercion = {
   coercion_type   : coe_typ;
@@ -434,13 +433,13 @@ let _ =
       optread  = (fun () -> !automatically_import_coercions);
       optwrite = (:=) automatically_import_coercions }
 
-let cache_coercion (_, c) =
+let cache_coercion env sigma (_, c) =
   let () = add_class c.coercion_source in
   let () = add_class c.coercion_target in
   let is, _ = class_info c.coercion_source in
   let it, _ = class_info c.coercion_target in
-  let value, ctx = Universes.fresh_global_instance (Global.env()) c.coercion_type in
-  let typ = Retyping.get_type_of (Global.env ()) Evd.empty (EConstr.of_constr value) in
+  let value, ctx = Universes.fresh_global_instance env c.coercion_type in
+  let typ = Retyping.get_type_of env sigma (EConstr.of_constr value) in
   let typ = EConstr.Unsafe.to_constr typ in
   let xf =
     { coe_value = value;
@@ -451,15 +450,15 @@ let cache_coercion (_, c) =
       coe_is_projection = c.coercion_is_proj;
       coe_param = c.coercion_params } in
   let () = add_new_coercion c.coercion_type xf in
-  add_coercion_in_graph (xf,is,it)
+  add_coercion_in_graph env sigma (xf,is,it)
 
 let load_coercion _ o =
   if !automatically_import_coercions then
-    cache_coercion o
+    cache_coercion (Global.env ()) Evd.empty o
 
 let open_coercion i o =
   if Int.equal i 1 && not !automatically_import_coercions then
-    cache_coercion o
+    cache_coercion (Global.env ()) Evd.empty o
 
 let subst_coercion (subst, c) =
   let coe = subst_coe_typ subst c.coercion_type in
@@ -498,7 +497,9 @@ let inCoercion : coercion -> obj =
   declare_object {(default_object "COERCION") with
     open_function = open_coercion;
     load_function = load_coercion;
-    cache_function = cache_coercion;
+    cache_function = (fun objn ->
+        let env = Global.env () in cache_coercion env Evd.empty objn
+      );
     subst_function = subst_coercion;
     classify_function = classify_coercion;
     discharge_function = discharge_coercion }
diff --git a/pretyping/classops.mli b/pretyping/classops.mli
index 8707078b5..47b41f17b 100644
--- a/pretyping/classops.mli
+++ b/pretyping/classops.mli
@@ -17,9 +17,9 @@ type cl_typ =
   | CL_SORT
   | CL_FUN
   | CL_SECVAR of variable
-  | CL_CONST of constant
+  | CL_CONST of Constant.t
   | CL_IND of inductive
-  | CL_PROJ of constant
+  | CL_PROJ of Constant.t
 
 (** Equality over [cl_typ] *)
 val cl_typ_eq : cl_typ -> cl_typ -> bool
@@ -96,7 +96,7 @@ val lookup_pattern_path_between :
 (**/**)
 (* Crade *)
 val install_path_printer :
-  ((cl_index * cl_index) * inheritance_path -> Pp.t) -> unit
+  (env -> evar_map -> (cl_index * cl_index) * inheritance_path -> Pp.t) -> unit
 (**/**)
 
 (** {6 This is for printing purpose } *)
diff --git a/pretyping/coercion.ml b/pretyping/coercion.ml
index 535a62046..7cfd2e27d 100644
--- a/pretyping/coercion.ml
+++ b/pretyping/coercion.ml
@@ -77,8 +77,8 @@ let apply_pattern_coercion ?loc pat p =
   List.fold_left
     (fun pat (co,n) ->
        let f i =
-         if i<n then (CAst.make ?loc @@ Glob_term.PatVar Anonymous) else pat in
-        CAst.make ?loc @@ Glob_term.PatCstr (co, List.init (n+1) f, Anonymous))
+         if i<n then (DAst.make ?loc @@ Glob_term.PatVar Anonymous) else pat in
+        DAst.make ?loc @@ Glob_term.PatCstr (co, List.init (n+1) f, Anonymous))
     pat p
 
 (* raise Not_found if no coercion found *)
@@ -205,7 +205,7 @@ and coerce ?loc env evdref (x : EConstr.constr) (y : EConstr.constr)
 	| _ -> subco ())
       | Prod (name, a, b), Prod (name', a', b') ->
 	  let name' = 
-	    Name (Namegen.next_ident_away Namegen.default_dependent_ident (Termops.ids_of_context env))
+	    Name (Namegen.next_ident_away Namegen.default_dependent_ident (Termops.vars_of_env env))
 	  in
 	  let env' = push_rel (LocalAssum (name', a')) env in
 	  let c1 = coerce_unify env' (lift 1 a') (lift 1 a) in
diff --git a/pretyping/constr_matching.ml b/pretyping/constr_matching.ml
index 886cfd880..c3a221944 100644
--- a/pretyping/constr_matching.ml
+++ b/pretyping/constr_matching.ml
@@ -12,9 +12,7 @@ open CErrors
 open Util
 open Names
 open Globnames
-open Nameops
 open Termops
-open Reductionops
 open Term
 open EConstr
 open Vars
@@ -22,6 +20,7 @@ open Pattern
 open Patternops
 open Misctypes
 open Context.Rel.Declaration
+open Ltac_pretype
 (*i*)
 
 (* Given a term with second-order variables in it,
@@ -54,7 +53,7 @@ exception PatternMatchingFailure
 let warn_meta_collision =
   CWarnings.create ~name:"meta-collision" ~category:"ltac"
          (fun name ->
-          strbrk "Collision between bound variable " ++ pr_id name ++
+          strbrk "Collision between bound variable " ++ Id.print name ++
             strbrk " and a metavariable of same name.")
 
 
@@ -90,7 +89,8 @@ let rec build_lambda sigma vars ctx m = match vars with
   let pre, suf = List.chop (pred n) ctx in
   let (na, t, suf) = match suf with
   | [] -> assert false
-  | (_, na, t) :: suf -> (na, t, suf)
+  | (_, id, t) :: suf ->
+     (Name id, t, suf)
   in
   (** Check that the abstraction is legal by generating a transitive closure of
       its dependencies. *)
@@ -126,11 +126,11 @@ let rec build_lambda sigma vars ctx m = match vars with
     mkRel 1 ::
     List.mapi (fun i _ -> mkRel (i + keep + 2)) suf
   in
-  let map i (id, na, c) =
+  let map i (na, id, c) =
     let i = succ i in
     let subst = List.skipn i subst in
     let subst = List.map (fun c -> Vars.lift (- i) c) subst in
-    (id, na, substl subst c)
+    (na, id, substl subst c)
   in
   let pre = List.mapi map pre in
   let pre = List.filter_with clear pre in
@@ -150,11 +150,10 @@ let rec build_lambda sigma vars ctx m = match vars with
 
 let rec extract_bound_aux k accu frels ctx = match ctx with
 | [] -> accu
-| (na1, na2, _) :: ctx ->
+| (na, _, _) :: ctx ->
   if Int.Set.mem k frels then
-    begin match na1 with
+    begin match na with
     | Name id ->
-      let () = assert (match na2 with Anonymous -> false | Name _ -> true) in
       let () = if Id.Set.mem id accu then raise PatternMatchingFailure in
       extract_bound_aux (k + 1) (Id.Set.add id accu) frels ctx
     | Anonymous -> raise PatternMatchingFailure
@@ -167,13 +166,21 @@ let extract_bound_vars frels ctx =
 let dummy_constr = EConstr.mkProp
 
 let make_renaming ids = function
-| (Name id, Name _, _) ->
+| (Name id, _, _) ->
   begin
     try EConstr.mkRel (List.index Id.equal id ids)
     with Not_found -> dummy_constr
   end
 | _ -> dummy_constr
 
+let push_binder na1 na2 t ctx =
+  let id2 = match na2 with
+  | Name id2 -> id2
+  | Anonymous ->
+     let avoid = Id.Set.of_list (List.map pi2 ctx) in
+     Namegen.next_ident_away Namegen.default_non_dependent_ident avoid in
+  (na1, id2, t) :: ctx
+
 let to_fix (idx, (nas, cs, ts)) =
   let inj = EConstr.of_constr in
   (idx, (nas, Array.map inj cs, Array.map inj ts))
@@ -199,20 +206,16 @@ let merge_binding sigma allow_bound_rels ctx n cT subst =
   in
   constrain sigma n c subst
       
-let matches_core env sigma convert allow_partial_app allow_bound_rels
+let matches_core env sigma allow_bound_rels
     (binding_vars,pat) c =
   let open EConstr in
   let convref ref c = 
     match ref, EConstr.kind sigma c with
-    | VarRef id, Var id' -> Names.id_eq id id'
-    | ConstRef c, Const (c',_) -> Names.eq_constant c c'
+    | VarRef id, Var id' -> Names.Id.equal id id'
+    | ConstRef c, Const (c',_) -> Constant.equal c c'
     | IndRef i, Ind (i', _) -> Names.eq_ind i i'
     | ConstructRef c, Construct (c',u) -> Names.eq_constructor c c'
-    | _, _ -> 
-      (if convert then 
-	  let sigma,c' = Evd.fresh_global env sigma ref in
-	    is_conv env sigma (EConstr.of_constr c') c
-       else false)
+    | _, _ -> false
   in
   let rec sorec ctx env subst p t =
     let cT = strip_outer_cast sigma t in
@@ -257,7 +260,7 @@ let matches_core env sigma convert allow_partial_app allow_bound_rels
       | PApp (PApp (h, a1), a2), _ ->
           sorec ctx env subst (PApp(h,Array.append a1 a2)) t
 
-      | PApp (PMeta meta,args1), App (c2,args2) when allow_partial_app ->
+      | PApp (PMeta meta,args1), App (c2,args2) ->
          (let diff = Array.length args2 - Array.length args1 in
           if diff >= 0 then
             let args21, args22 = Array.chop diff args2 in
@@ -277,7 +280,7 @@ let matches_core env sigma convert allow_partial_app allow_bound_rels
 	   
       | PApp (c1,arg1), App (c2,arg2) ->
 	(match c1, EConstr.kind sigma c2 with
-	| PRef (ConstRef r), Proj (pr,c) when not (eq_constant r (Projection.constant pr))
+	| PRef (ConstRef r), Proj (pr,c) when not (Constant.equal r (Projection.constant pr))
 	    || Projection.unfolded pr ->
 	  raise PatternMatchingFailure
 	| PProj (pr1,c1), Proj (pr,c) ->
@@ -294,7 +297,7 @@ let matches_core env sigma convert allow_partial_app allow_bound_rels
           with Invalid_argument _ -> raise PatternMatchingFailure)
 	  
       | PApp (PRef (ConstRef c1), _), Proj (pr, c2) 
-	when Projection.unfolded pr || not (eq_constant c1 (Projection.constant pr)) -> 
+	when Projection.unfolded pr || not (Constant.equal c1 (Projection.constant pr)) -> 
 	raise PatternMatchingFailure
 	
       | PApp (c, args), Proj (pr, c2) ->
@@ -306,19 +309,19 @@ let matches_core env sigma convert allow_partial_app allow_bound_rels
           sorec ctx env subst c1 c2
 
       | PProd (na1,c1,d1), Prod(na2,c2,d2) ->
-	  sorec ((na1,na2,c2)::ctx) (EConstr.push_rel (LocalAssum (na2,c2)) env)
+	  sorec (push_binder na1 na2 c2 ctx) (EConstr.push_rel (LocalAssum (na2,c2)) env)
             (add_binders na1 na2 binding_vars (sorec ctx env subst c1 c2)) d1 d2
 
       | PLambda (na1,c1,d1), Lambda(na2,c2,d2) ->
-	  sorec ((na1,na2,c2)::ctx) (EConstr.push_rel (LocalAssum (na2,c2)) env)
+	  sorec (push_binder na1 na2 c2 ctx) (EConstr.push_rel (LocalAssum (na2,c2)) env)
             (add_binders na1 na2 binding_vars (sorec ctx env subst c1 c2)) d1 d2
 
       | PLetIn (na1,c1,Some t1,d1), LetIn(na2,c2,t2,d2) ->
-	  sorec ((na1,na2,t2)::ctx) (EConstr.push_rel (LocalDef (na2,c2,t2)) env)
+	  sorec (push_binder na1 na2 t2 ctx) (EConstr.push_rel (LocalDef (na2,c2,t2)) env)
             (add_binders na1 na2 binding_vars (sorec ctx env (sorec ctx env subst c1 c2) t1 t2)) d1 d2
 
       | PLetIn (na1,c1,None,d1), LetIn(na2,c2,t2,d2) ->
-	  sorec ((na1,na2,t2)::ctx) (EConstr.push_rel (LocalDef (na2,c2,t2)) env)
+	  sorec (push_binder na1 na2 t2 ctx) (EConstr.push_rel (LocalDef (na2,c2,t2)) env)
             (add_binders na1 na2 binding_vars (sorec ctx env subst c1 c2)) d1 d2
 
       | PIf (a1,b1,b1'), Case (ci,_,a2,[|b2;b2'|]) ->
@@ -327,7 +330,7 @@ let matches_core env sigma convert allow_partial_app allow_bound_rels
 	  let n = Context.Rel.length ctx_b2 in
           let n' = Context.Rel.length ctx_b2' in
 	  if Vars.noccur_between sigma 1 n b2 && Vars.noccur_between sigma 1 n' b2' then
-            let f l (LocalAssum (na,t) | LocalDef (na,_,t)) = (Anonymous,na,t)::l in
+            let f l (LocalAssum (na,t) | LocalDef (na,_,t)) = push_binder Anonymous na t l in
 	    let ctx_br = List.fold_left f ctx ctx_b2 in
 	    let ctx_br' = List.fold_left f ctx ctx_b2' in
 	    let b1 = lift_pattern n b1 and b1' = lift_pattern n' b1' in
@@ -363,19 +366,21 @@ let matches_core env sigma convert allow_partial_app allow_bound_rels
       |	PCoFix c1, CoFix _ when eq_constr sigma (mkCoFix (to_fix c1)) cT -> subst
       | PEvar (c1,args1), Evar (c2,args2) when Evar.equal c1 c2 ->
          Array.fold_left2 (sorec ctx env) subst args1 args2
-      | _ -> raise PatternMatchingFailure
+      | (PRef _ | PVar _ | PRel _ | PApp _ | PProj _ | PLambda _
+         | PProd _ | PLetIn _ | PSort _ | PIf _ | PCase _
+         | PFix _ | PCoFix _| PEvar _), _ -> raise PatternMatchingFailure
 
   in
   sorec [] env (Id.Map.empty, Id.Map.empty) pat c
 
-let matches_core_closed env sigma convert allow_partial_app pat c =
-  let names, subst = matches_core env sigma convert allow_partial_app false pat c in
+let matches_core_closed env sigma pat c =
+  let names, subst = matches_core env sigma false pat c in
   (names, Id.Map.map snd subst)
 
-let extended_matches env sigma = matches_core env sigma false true true
+let extended_matches env sigma = matches_core env sigma true
 
 let matches env sigma pat c =
-  snd (matches_core_closed env sigma false true (Id.Set.empty,pat) c)
+  snd (matches_core_closed env sigma (Id.Set.empty,pat) c)
 
 let special_meta = (-1)
 
@@ -400,9 +405,9 @@ let matches_head env sigma pat c =
   matches env sigma pat head
 
 (* Tells if it is an authorized occurrence and if the instance is closed *)
-let authorized_occ env sigma partial_app closed pat c mk_ctx =
+let authorized_occ env sigma closed pat c mk_ctx =
   try
-    let subst = matches_core_closed env sigma false partial_app pat c in
+    let subst = matches_core_closed env sigma pat c in
     if closed && Id.Map.exists (fun _ c -> not (closed0 sigma c)) (snd subst)
     then (fun next -> next ())
     else (fun next -> mkresult subst (mk_ctx (mkMeta special_meta)) next)
@@ -411,10 +416,10 @@ let authorized_occ env sigma partial_app closed pat c mk_ctx =
 let subargs env v = Array.map_to_list (fun c -> (env, c)) v
 
 (* Tries to match a subterm of [c] with [pat] *)
-let sub_match ?(partial_app=false) ?(closed=true) env sigma pat c =
+let sub_match ?(closed=true) env sigma pat c =
   let open EConstr in
   let rec aux env c mk_ctx next =
-  let here = authorized_occ env sigma partial_app closed pat c mk_ctx in
+  let here = authorized_occ env sigma closed pat c mk_ctx in
   let next () = match EConstr.kind sigma c with
   | Cast (c1,k,c2) ->
       let next_mk_ctx = function
@@ -444,34 +449,12 @@ let sub_match ?(partial_app=false) ?(closed=true) env sigma pat c =
       let env' = EConstr.push_rel (LocalDef (x,c1,t)) env in
       try_aux [(env, c1); (env', c2)] next_mk_ctx next
   | App (c1,lc) ->
-        let topdown = true in
-        if partial_app then
-          if topdown then
-            let lc1 = Array.sub lc 0 (Array.length lc - 1) in
-            let app = mkApp (c1,lc1) in
-            let mk_ctx = function
-              | [app';c] -> mk_ctx (mkApp (app',[|c|]))
-              | _ -> assert false in
-            try_aux [(env, app); (env, Array.last lc)] mk_ctx next
-          else
-            let rec aux2 app args next =
-              match args with
-              | [] ->
-                  let mk_ctx le =
-                    mk_ctx (mkApp (List.hd le, Array.of_list (List.tl le))) in
-                  let sub = (env, c1) :: subargs env lc in
-                  try_aux sub mk_ctx next
-              | arg :: args ->
-                  let app = mkApp (app,[|arg|]) in
-                  let next () = aux2 app args next in
-                  let mk_ctx ce = mk_ctx (mkApp (ce, Array.of_list args)) in
-                  aux env app mk_ctx next in
-            aux2 c1 (Array.to_list lc) next
-        else
-          let mk_ctx le =
-            mk_ctx (mkApp (List.hd le, Array.of_list (List.tl le))) in
-          let sub = (env, c1) :: subargs env lc in
-          try_aux sub mk_ctx next
+     let lc1 = Array.sub lc 0 (Array.length lc - 1) in
+     let app = mkApp (c1,lc1) in
+     let mk_ctx = function
+       | [app';c] -> mk_ctx (mkApp (app',[|c|]))
+       | _ -> assert false in
+     try_aux [(env, app); (env, Array.last lc)] mk_ctx next
   | Case (ci,hd,c1,lc) ->
       let next_mk_ctx = function
       | c1 :: hd :: lc -> mk_ctx (mkCase (ci,hd,c1,Array.of_list lc))
@@ -479,29 +462,28 @@ let sub_match ?(partial_app=false) ?(closed=true) env sigma pat c =
       in
       let sub = (env, c1) :: (env, hd) :: subargs env lc in
       try_aux sub next_mk_ctx next
-  | Fix (indx,(names,types,bodies)) ->
+  | Fix (indx,(names,types,bodies as recdefs)) ->
     let nb_fix = Array.length types in
     let next_mk_ctx le =
       let (ntypes,nbodies) = CList.chop nb_fix le in
       mk_ctx (mkFix (indx,(names, Array.of_list ntypes, Array.of_list nbodies))) in
-    let sub = subargs env types @ subargs env bodies in
+    let env' = push_rec_types recdefs env in
+    let sub = subargs env types @ subargs env' bodies in
     try_aux sub next_mk_ctx next
-  | CoFix (i,(names,types,bodies)) ->
+  | CoFix (i,(names,types,bodies as recdefs)) ->
     let nb_fix = Array.length types in
     let next_mk_ctx le =
       let (ntypes,nbodies) = CList.chop nb_fix le in
       mk_ctx (mkCoFix (i,(names, Array.of_list ntypes, Array.of_list nbodies))) in
-    let sub = subargs env types @ subargs env bodies in
+    let env' = push_rec_types recdefs env in
+    let sub = subargs env types @ subargs env' bodies in
     try_aux sub next_mk_ctx next
   | Proj (p,c') ->
-    let next_mk_ctx le = mk_ctx (mkProj (p,List.hd le)) in
-      if partial_app then
-	try 
-	  let term = Retyping.expand_projection env sigma p c' [] in
-	    aux env term mk_ctx next
-	with Retyping.RetypeError _ -> next ()
-      else
-      try_aux [env, c'] next_mk_ctx next
+    begin try
+      let term = Retyping.expand_projection env sigma p c' [] in
+      aux env term mk_ctx next
+    with Retyping.RetypeError _ -> next ()
+    end
   | Construct _| Ind _|Evar _|Const _ | Rel _|Meta _|Var _|Sort _ ->
     next ()
   in
@@ -522,13 +504,7 @@ let sub_match ?(partial_app=false) ?(closed=true) env sigma pat c =
   let result () = aux env c (fun x -> x) lempty in
   IStream.thunk result
 
-let match_subterm env sigma pat c = sub_match env sigma (Id.Set.empty,pat) c
-
-let match_appsubterm env sigma pat c = 
-  sub_match ~partial_app:true env sigma (Id.Set.empty,pat) c
-
-let match_subterm_gen env sigma app pat c = 
-  sub_match ~partial_app:app env sigma pat c
+let match_subterm env sigma pat c = sub_match env sigma pat c
 
 let is_matching env sigma pat c =
   try let _ = matches env sigma pat c in true
@@ -540,12 +516,5 @@ let is_matching_head env sigma pat c =
 
 let is_matching_appsubterm ?(closed=true) env sigma pat c =
   let pat = (Id.Set.empty,pat) in
-  let results = sub_match ~partial_app:true ~closed env sigma pat c in
+  let results = sub_match ~closed env sigma pat c in
   not (IStream.is_empty results)
-
-let matches_conv env sigma p c =
-  snd (matches_core_closed env sigma true false (Id.Set.empty,p) c)
-
-let is_matching_conv env sigma pat n =
-  try let _ = matches_conv env sigma pat n in true
-  with PatternMatchingFailure -> false
diff --git a/pretyping/constr_matching.mli b/pretyping/constr_matching.mli
index 1d7019d09..e4d9ff9e1 100644
--- a/pretyping/constr_matching.mli
+++ b/pretyping/constr_matching.mli
@@ -9,10 +9,11 @@
 (** This module implements pattern-matching on terms *)
 
 open Names
-open Term
+open Constr
 open EConstr
 open Environ
 open Pattern
+open Ltac_pretype
 
 type binding_bound_vars = Id.Set.t
 
@@ -54,38 +55,19 @@ val is_matching : env -> Evd.evar_map -> constr_pattern -> constr -> bool
     prefix of it matches against [pat] *)
 val is_matching_head : env -> Evd.evar_map -> constr_pattern -> constr -> bool
 
-(** [matches_conv env sigma] matches up to conversion in environment
-   [(env,sigma)] when constants in pattern are concerned; it raises
-   [PatternMatchingFailure] if not matchable; bindings are given in
-   increasing order based on the numbers given in the pattern *)
-val matches_conv : env -> Evd.evar_map -> constr_pattern -> constr -> patvar_map
-
 (** The type of subterm matching results: a substitution + a context
    (whose hole is denoted here with [special_meta]) *)
 type matching_result =
     { m_sub : bound_ident_map * patvar_map;
       m_ctx : EConstr.t }
 
-(** [match_subterm n pat c] returns the substitution and the context
-   corresponding to each **closed** subterm of [c] matching [pat]. *)
-val match_subterm : env -> Evd.evar_map -> constr_pattern -> constr -> matching_result IStream.t
-
-(** [match_appsubterm pat c] returns the substitution and the context
+(** [match_subterm pat c] returns the substitution and the context
    corresponding to each **closed** subterm of [c] matching [pat],
    considering application contexts as well. *)
-val match_appsubterm : env -> Evd.evar_map -> constr_pattern -> constr -> matching_result IStream.t
-
-(** [match_subterm_gen] calls either [match_subterm] or [match_appsubterm] *)
-val match_subterm_gen : env -> Evd.evar_map ->
-  bool (** true = with app context *) ->
+val match_subterm : env -> Evd.evar_map ->
   binding_bound_vars * constr_pattern -> constr ->
   matching_result IStream.t
 
 (** [is_matching_appsubterm pat c] tells if a subterm of [c] matches
    against [pat] taking partial subterms into consideration *)
 val is_matching_appsubterm : ?closed:bool -> env -> Evd.evar_map -> constr_pattern -> constr -> bool
-
-(** [is_matching_conv env sigma pat c] tells if [c] matches against [pat]
-   up to conversion for constants in patterns *)
-val is_matching_conv :
-  env -> Evd.evar_map -> constr_pattern -> constr -> bool
diff --git a/pretyping/detyping.ml b/pretyping/detyping.ml
index b9cb7ba1b..18ecbf8ed 100644
--- a/pretyping/detyping.ml
+++ b/pretyping/detyping.ml
@@ -27,6 +27,11 @@ open Mod_subst
 open Misctypes
 open Decl_kinds
 open Context.Named.Declaration
+open Ltac_pretype
+
+type _ delay =
+| Now : 'a delay
+| Later : [ `thunk ] delay
 
 (** Should we keep details of universes during detyping ? *)
 let print_universes = Flags.univ_print
@@ -217,12 +222,12 @@ let lookup_name_as_displayed env sigma t s =
 	   | (Anonymous,avoid') -> lookup avoid' (n+1) (pop c'))
     | Cast (c,_,_) -> lookup avoid n c
     | _ -> None
-  in lookup (ids_of_named_context (named_context env)) 1 t
+  in lookup (Environ.ids_of_named_context_val (Environ.named_context_val env)) 1 t
 
 let lookup_index_as_renamed env sigma t n =
   let rec lookup n d c = match EConstr.kind sigma c with
     | Prod (name,_,c') ->
-	  (match compute_displayed_name_in sigma RenamingForGoal [] name c' with
+	  (match compute_displayed_name_in sigma RenamingForGoal Id.Set.empty name c' with
                (Name _,_) -> lookup n (d+1) c'
              | (Anonymous,_) ->
 		 if Int.equal n 0 then
@@ -232,7 +237,7 @@ let lookup_index_as_renamed env sigma t n =
 		 else
 		   lookup (n-1) (d+1) c')
     | LetIn (name,_,_,c') ->
-	  (match compute_displayed_name_in sigma RenamingForGoal [] name c' with
+	  (match compute_displayed_name_in sigma RenamingForGoal Id.Set.empty name c' with
              | (Name _,_) -> lookup n (d+1) c'
              | (Anonymous,_) ->
 		 if Int.equal n 0 then
@@ -247,6 +252,89 @@ let lookup_index_as_renamed env sigma t n =
   in lookup n 1 t
 
 (**********************************************************************)
+(* Factorization of match patterns *)
+
+let print_factorize_match_patterns = ref true
+
+let _ =
+  let open Goptions in
+  declare_bool_option
+    { optdepr  = false;
+      optname  = "factorization of \"match\" patterns in printing";
+      optkey   = ["Printing";"Factorizable";"Match";"Patterns"];
+      optread  = (fun () -> !print_factorize_match_patterns);
+      optwrite = (fun b -> print_factorize_match_patterns := b) }
+
+let print_allow_match_default_clause = ref true
+
+let _ =
+  let open Goptions in
+  declare_bool_option
+    { optdepr  = false;
+      optname  = "possible use of \"match\" default pattern in printing";
+      optkey   = ["Printing";"Allow";"Match";"Default";"Clause"];
+      optread  = (fun () -> !print_allow_match_default_clause);
+      optwrite = (fun b -> print_allow_match_default_clause := b) }
+
+let rec join_eqns (ids,rhs as x) patll = function
+  | (loc,(ids',patl',rhs') as eqn')::rest ->
+     if not !Flags.raw_print && !print_factorize_match_patterns &&
+        List.eq_set Id.equal ids ids' && glob_constr_eq rhs rhs'
+     then
+       join_eqns x (patl'::patll) rest
+     else
+       let eqn,rest = join_eqns x patll rest in
+       eqn, eqn'::rest
+  | [] ->
+     patll, []
+
+let number_of_patterns (_gloc,(_ids,patll,_rhs)) = List.length patll
+
+let is_default_candidate (_gloc,(ids,_patll,_rhs) ) = ids = []
+
+let rec move_more_factorized_default_candidate_to_end eqn n = function
+  | eqn' :: eqns ->
+     let set,get = set_temporary_memory () in
+     if is_default_candidate eqn' && set (number_of_patterns eqn') >= n then
+       let isbest, dft, eqns = move_more_factorized_default_candidate_to_end eqn' (get ()) eqns in
+       if isbest then false, dft, eqns else false, dft, eqn' :: eqns
+     else
+       let isbest, dft, eqns = move_more_factorized_default_candidate_to_end eqn n eqns in
+       isbest, dft, eqn' :: eqns
+  | [] -> true, Some eqn, []
+
+let rec select_default_clause = function
+  | eqn :: eqns ->
+     let set,get = set_temporary_memory () in
+     if is_default_candidate eqn && set (number_of_patterns eqn) > 1 then
+       let isbest, dft, eqns = move_more_factorized_default_candidate_to_end eqn (get ()) eqns in
+       if isbest then dft, eqns else dft, eqn :: eqns
+     else
+       let dft, eqns = select_default_clause eqns in dft, eqn :: eqns
+  | [] -> None, []
+
+let factorize_eqns eqns =
+  let rec aux found = function
+  | (loc,(ids,patl,rhs))::rest ->
+     let patll,rest = join_eqns (ids,rhs) [patl] rest in
+     aux ((loc,(ids,patll,rhs))::found) rest
+  | [] ->
+     found in
+  let eqns = aux [] (List.rev eqns) in
+  let mk_anon patl = List.map (fun _ -> DAst.make @@ PatVar Anonymous) patl in
+  if not !Flags.raw_print && !print_allow_match_default_clause && eqns <> [] then
+    match select_default_clause eqns with
+    (* At least two clauses and the last one is disjunctive with no variables *)
+    | Some (gloc,([],patl::_::_,rhs)), (_::_ as eqns) -> eqns@[gloc,([],[mk_anon patl],rhs)]
+    (* Only one clause which is disjunctive with no variables: we keep at least one constructor *)
+    (* so that it is not interpreted as a dummy "match" *)
+    | Some (gloc,([],patl::patl'::_,rhs)), [] -> [gloc,([],[patl;mk_anon patl'],rhs)]
+    | Some (_,((_::_,_,_ | _,([]|[_]),_))), _ -> assert false
+    | None, eqns -> eqns
+  else
+    eqns
+
+(**********************************************************************)
 (* Fragile algorithm to reverse pattern-matching compilation          *)
 
 let update_name sigma na ((_,(e,_)),c) =
@@ -277,15 +365,14 @@ let rec decomp_branch tags nal b (avoid,env as e) sigma c =
       (avoid', add_name_opt na' body t env) sigma c
 
 let rec build_tree na isgoal e sigma ci cl =
-  let mkpat n rhs pl = CAst.make @@ PatCstr((ci.ci_ind,n+1),pl,update_name sigma na rhs) in
+  let mkpat n rhs pl = DAst.make @@ PatCstr((ci.ci_ind,n+1),pl,update_name sigma na rhs) in
   let cnl = ci.ci_pp_info.cstr_tags in
-  let cna = ci.ci_cstr_nargs in
   List.flatten
     (List.init (Array.length cl)
-      (fun i -> contract_branch isgoal e sigma (cnl.(i),cna.(i),mkpat i,cl.(i))))
+      (fun i -> contract_branch isgoal e sigma (cnl.(i),mkpat i,cl.(i))))
 
 and align_tree nal isgoal (e,c as rhs) sigma = match nal with
-  | [] -> [[],rhs]
+  | [] -> [Id.Set.empty,[],rhs]
   | na::nal ->
     match EConstr.kind sigma c with
     | Case (ci,p,c,cl) when
@@ -295,19 +382,20 @@ and align_tree nal isgoal (e,c as rhs) sigma = match nal with
 	computable sigma p (List.length ci.ci_pp_info.ind_tags) (* FIXME: can do better *) ->
 	let clauses = build_tree na isgoal e sigma ci cl in
 	List.flatten
-          (List.map (fun (pat,rhs) ->
+          (List.map (fun (ids,pat,rhs) ->
 	      let lines = align_tree nal isgoal rhs sigma in
-	      List.map (fun (hd,rest) -> pat::hd,rest) lines)
+              List.map (fun (ids',hd,rest) -> Id.Set.fold Id.Set.add ids ids',pat::hd,rest) lines)
 	    clauses)
     | _ ->
-	let pat = CAst.make @@ PatVar(update_name sigma na rhs) in
-	let mat = align_tree nal isgoal rhs sigma in
-	List.map (fun (hd,rest) -> pat::hd,rest) mat
+        let na = update_name sigma na rhs in
+        let pat = DAst.make @@ PatVar na in
+        let mat = align_tree nal isgoal rhs sigma in
+        List.map (fun (ids,hd,rest) -> Nameops.Name.fold_right Id.Set.add na ids,pat::hd,rest) mat
 
-and contract_branch isgoal e sigma (cdn,can,mkpat,b) =
-  let nal,rhs = decomp_branch cdn [] isgoal e sigma b in
+and contract_branch isgoal e sigma (cdn,mkpat,rhs) =
+  let nal,rhs = decomp_branch cdn [] isgoal e sigma rhs in
   let mat = align_tree nal isgoal rhs sigma in
-  List.map (fun (hd,rhs) -> (mkpat rhs hd,rhs)) mat
+  List.map (fun (ids,hd,rhs) -> ids,mkpat rhs hd,rhs) mat
 
 (**********************************************************************)
 (* Transform internal representation of pattern-matching into list of *)
@@ -323,7 +411,7 @@ let is_nondep_branch sigma c l =
 
 let extract_nondep_branches test c b l =
   let rec strip l r =
-    match r.CAst.v, l with
+    match DAst.get r, l with
       | r', [] -> r
       | GLambda (_,_,_,t), false::l -> strip l t
       | GLetIn (_,_,_,t), true::l -> strip l t
@@ -333,7 +421,7 @@ let extract_nondep_branches test c b l =
 
 let it_destRLambda_or_LetIn_names l c =
   let rec aux l nal c =
-    match c.CAst.v, l with
+    match DAst.get c, l with
       | _, [] -> (List.rev nal,c)
       | GLambda (na,_,_,c), false::l -> aux l (na::nal) c
       | GLetIn (na,_,_,c), true::l -> aux l (na::nal) c
@@ -347,11 +435,11 @@ let it_destRLambda_or_LetIn_names l c =
 	    x
 	  in
 	  let x = next (free_glob_vars c) in
-	  let a = CAst.make @@ GVar x in
+	  let a = DAst.make @@ GVar x in
 	  aux l (Name x :: nal)
-            (match c with
-              | { loc; CAst.v = GApp (p,l) } -> CAst.make ?loc @@ GApp (p,l@[a])
-              | _ -> CAst.make @@ GApp (c,[a]))
+            (match DAst.get c with
+              | GApp (p,l) -> DAst.make ?loc:c.CAst.loc @@ GApp (p,l@[a])
+              | _ -> DAst.make @@ GApp (c,[a]))
   in aux l [] c
 
 let detype_case computable detype detype_eqns testdep avoid data p c bl =
@@ -363,17 +451,15 @@ let detype_case computable detype detype_eqns testdep avoid data p c bl =
     then
       Anonymous, None, None
     else
-      match Option.map detype p with
-        | None -> Anonymous, None, None
-        | Some p ->
-            let nl,typ = it_destRLambda_or_LetIn_names k p in
-	    let n,typ = match typ.CAst.v with
-              | GLambda (x,_,t,c) -> x, c
-	      | _ -> Anonymous, typ in
-	    let aliastyp =
-	      if List.for_all (Name.equal Anonymous) nl then None
-	      else Some (Loc.tag (indsp,nl)) in
-            n, aliastyp, Some typ
+      let p = detype p in
+      let nl,typ = it_destRLambda_or_LetIn_names k p in
+      let n,typ = match DAst.get typ with
+        | GLambda (x,_,t,c) -> x, c
+        | _ -> Anonymous, typ in
+      let aliastyp =
+        if List.for_all (Name.equal Anonymous) nl then None
+        else Some (Loc.tag (indsp,nl)) in
+      n, aliastyp, Some typ
   in
   let constructs = Array.init (Array.length bl) (fun i -> (indsp,i+1)) in
   let tag =
@@ -409,15 +495,17 @@ let detype_case computable detype detype_eqns testdep avoid data p c bl =
       let eqnl = detype_eqns constructs constagsl bl in
       GCases (tag,pred,[tomatch,(alias,aliastyp)],eqnl)
 
+let detype_universe sigma u =
+  let fn (l, n) = Some (Termops.reference_of_level sigma l, n) in
+  Univ.Universe.map fn u
+
 let detype_sort sigma = function
   | Prop Null -> GProp
   | Prop Pos -> GSet
   | Type u ->
     GType
       (if !print_universes
-       then
-         let u = Pp.string_of_ppcmds (Univ.Universe.pr_with (Termops.pr_evd_level sigma) u) in
-         [Loc.tag @@ Name.mk_name (Id.of_string_soft u)]
+       then detype_universe sigma u
        else [])
 
 type binder_kind = BProd | BLambda | BLetIn
@@ -429,70 +517,76 @@ let detype_anonymous = ref (fun ?loc n -> anomaly ~label:"detype" (Pp.str "index
 let set_detype_anonymous f = detype_anonymous := f
 
 let detype_level sigma l =
-  let l = Pp.string_of_ppcmds (Termops.pr_evd_level sigma l) in
-  GType (Some (Loc.tag @@ Name.mk_name (Id.of_string_soft l)))
+  let l = Termops.reference_of_level sigma l in
+  GType (UNamed l)
 
 let detype_instance sigma l = 
   let l = EInstance.kind sigma l in
   if Univ.Instance.is_empty l then None
   else Some (List.map (detype_level sigma) (Array.to_list (Univ.Instance.to_array l)))
 
-let rec detype flags avoid env sigma t = CAst.make @@
+let delay (type a) (d : a delay) (f : a delay -> _ -> _ -> _ -> _ -> _ -> a glob_constr_r) flags env avoid sigma t : a glob_constr_g =
+  match d with
+  | Now -> DAst.make (f d flags env avoid sigma t)
+  | Later -> DAst.delay (fun () -> f d flags env avoid sigma t)
+
+let rec detype d flags avoid env sigma t =
+  delay d detype_r flags avoid env sigma t
+
+and detype_r d flags avoid env sigma t =
   match EConstr.kind sigma (collapse_appl sigma t) with
     | Rel n ->
       (try match lookup_name_of_rel n (fst env) with
 	 | Name id   -> GVar id
-	 | Anonymous -> (!detype_anonymous n).CAst.v
+	 | Anonymous -> GVar (!detype_anonymous n)
        with Not_found ->
 	 let s = "_UNBOUND_REL_"^(string_of_int n)
 	 in GVar (Id.of_string s))
     | Meta n ->
 	(* Meta in constr are not user-parsable and are mapped to Evar *)
-        (* using numbers to be unparsable *)
-	GEvar (Id.of_string ("M" ^ string_of_int n), [])
+        if n = Constr_matching.special_meta then
+          (* Using a dash to be unparsable *)
+	  GEvar (Id.of_string_soft "CONTEXT-HOLE", [])
+        else
+	  GEvar (Id.of_string_soft ("M" ^ string_of_int n), [])
     | Var id ->
 	(try let _ = Global.lookup_named id in GRef (VarRef id, None)
 	 with Not_found -> GVar id)
     | Sort s -> GSort (detype_sort sigma (ESorts.kind sigma s))
     | Cast (c1,REVERTcast,c2) when not !Flags.raw_print ->
-        (detype flags avoid env sigma c1).CAst.v
+        DAst.get (detype d flags avoid env sigma c1)
     | Cast (c1,k,c2) ->
-        let d1 = detype flags avoid env sigma c1 in
-	let d2 = detype flags avoid env sigma c2 in
+        let d1 = detype d flags avoid env sigma c1 in
+	let d2 = detype d flags avoid env sigma c2 in
     let cast = match k with
     | VMcast -> CastVM d2
     | NATIVEcast -> CastNative d2
     | _ -> CastConv d2
     in
 	GCast(d1,cast)
-    | Prod (na,ty,c) -> detype_binder flags BProd avoid env sigma na None ty c
-    | Lambda (na,ty,c) -> detype_binder flags BLambda avoid env sigma na None ty c
-    | LetIn (na,b,ty,c) -> detype_binder flags BLetIn avoid env sigma na (Some b) ty c
+    | Prod (na,ty,c) -> detype_binder d flags BProd avoid env sigma na None ty c
+    | Lambda (na,ty,c) -> detype_binder d flags BLambda avoid env sigma na None ty c
+    | LetIn (na,b,ty,c) -> detype_binder d flags BLetIn avoid env sigma na (Some b) ty c
     | App (f,args) ->
       let mkapp f' args' = 
- 	match f'.CAst.v with
+ 	match DAst.get f' with
  	| GApp (f',args'') -> 
  	  GApp (f',args''@args')
  	| _ -> GApp (f',args')
       in
-      mkapp (detype flags avoid env sigma f)
-        (Array.map_to_list (detype flags avoid env sigma) args)
+      mkapp (detype d flags avoid env sigma f)
+        (Array.map_to_list (detype d flags avoid env sigma) args)
     | Const (sp,u) -> GRef (ConstRef sp, detype_instance sigma u)
     | Proj (p,c) ->
       let noparams () = 
-	let pb = Environ.lookup_projection p (snd env) in
-	let pars = pb.Declarations.proj_npars in
-	let hole = CAst.make @@ GHole(Evar_kinds.InternalHole,Misctypes.IntroAnonymous,None) in
-	let args = List.make pars hole in
- 	  GApp (CAst.make @@ GRef (ConstRef (Projection.constant p), None),
-		(args @ [detype flags avoid env sigma c]))
+    GProj (p, detype d flags avoid env sigma c)
       in
       if fst flags || !Flags.in_debugger || !Flags.in_toplevel then
 	try noparams ()
 	with _ ->
 	    (* lax mode, used by debug printers only *) 
-	  GApp (CAst.make @@ GRef (ConstRef (Projection.constant p), None), 
-		[detype flags avoid env sigma c])
+	  GApp (DAst.make @@ GRef (ConstRef (Projection.constant p), None), 
+		[detype d flags avoid env sigma c])
       else 
 	if print_primproj_compatibility () && Projection.unfolded p then
 	  (** Print the compatibility match version *)
@@ -509,12 +603,12 @@ let rec detype flags avoid env sigma t = CAst.make @@
 		substl (c :: List.rev args) body'
 	    with Retyping.RetypeError _ | Not_found -> 
 	      anomaly (str"Cannot detype an unfolded primitive projection.")
-	  in (detype flags avoid env sigma c').CAst.v
+	  in DAst.get (detype d flags avoid env sigma c')
 	else
 	  if print_primproj_params () then
 	    try
 	      let c = Retyping.expand_projection (snd env) sigma p c [] in
-              (detype flags avoid env sigma c).CAst.v
+              DAst.get (detype d flags avoid env sigma c)
 	    with Retyping.RetypeError _ -> noparams ()
 	  else noparams ()
 
@@ -538,59 +632,59 @@ let rec detype flags avoid env sigma t = CAst.make @@
           let l = Evd.evar_instance_array (fun d c -> not !print_evar_arguments && (bound_to_itself_or_letin d c && not (isRel sigma c && Int.Set.mem (destRel sigma c) rels || isVar sigma c && (Id.Set.mem (destVar sigma c) fvs)))) (Evd.find sigma evk) cl in
           id,l
         with Not_found ->
-          Id.of_string ("X" ^ string_of_int (Evar.repr evk)), 
+          Id.of_string ("X" ^ string_of_int (Evar.repr evk)),
           (Array.map_to_list (fun c -> (Id.of_string "__",c)) cl)
       in
         GEvar (id,
-               List.map (on_snd (detype flags avoid env sigma)) l)
+               List.map (on_snd (detype d flags avoid env sigma)) l)
     | Ind (ind_sp,u) ->
 	GRef (IndRef ind_sp, detype_instance sigma u)
     | Construct (cstr_sp,u) ->
 	GRef (ConstructRef cstr_sp, detype_instance sigma u)
     | Case (ci,p,c,bl) ->
 	let comp = computable sigma p (List.length (ci.ci_pp_info.ind_tags)) in
-	detype_case comp (detype flags avoid env sigma)
-	  (detype_eqns flags avoid env sigma ci comp)
+	detype_case comp (detype d flags avoid env sigma)
+	  (detype_eqns d flags avoid env sigma ci comp)
 	  (is_nondep_branch sigma) avoid
 	  (ci.ci_ind,ci.ci_pp_info.style,
 	   ci.ci_pp_info.cstr_tags,ci.ci_pp_info.ind_tags)
-	  (Some p) c bl
-    | Fix (nvn,recdef) -> detype_fix flags avoid env sigma nvn recdef
-    | CoFix (n,recdef) -> detype_cofix flags avoid env sigma n recdef
+          p c bl
+    | Fix (nvn,recdef) -> detype_fix d flags avoid env sigma nvn recdef
+    | CoFix (n,recdef) -> detype_cofix d flags avoid env sigma n recdef
 
-and detype_fix flags avoid env sigma (vn,_ as nvn) (names,tys,bodies) =
+and detype_fix d flags avoid env sigma (vn,_ as nvn) (names,tys,bodies) =
   let def_avoid, def_env, lfi =
     Array.fold_left2
       (fun (avoid, env, l) na ty ->
 	 let id = next_name_away na avoid in
-	 (id::avoid, add_name (Name id) None ty env, id::l))
+	 (Id.Set.add id avoid, add_name (Name id) None ty env, id::l))
       (avoid, env, []) names tys in
   let n = Array.length tys in
   let v = Array.map3
-    (fun c t i -> share_names flags (i+1) [] def_avoid def_env sigma c (lift n t))
+    (fun c t i -> share_names d flags (i+1) [] def_avoid def_env sigma c (lift n t))
     bodies tys vn in
   GRec(GFix (Array.map (fun i -> Some i, GStructRec) (fst nvn), snd nvn),Array.of_list (List.rev lfi),
        Array.map (fun (bl,_,_) -> bl) v,
        Array.map (fun (_,_,ty) -> ty) v,
        Array.map (fun (_,bd,_) -> bd) v)
 
-and detype_cofix flags avoid env sigma n (names,tys,bodies) =
+and detype_cofix d flags avoid env sigma n (names,tys,bodies) =
   let def_avoid, def_env, lfi =
     Array.fold_left2
       (fun (avoid, env, l) na ty ->
 	 let id = next_name_away na avoid in
-	 (id::avoid, add_name (Name id) None ty env, id::l))
+	 (Id.Set.add id avoid, add_name (Name id) None ty env, id::l))
       (avoid, env, []) names tys in
   let ntys = Array.length tys in
   let v = Array.map2
-    (fun c t -> share_names flags 0 [] def_avoid def_env sigma c (lift ntys t))
+    (fun c t -> share_names d flags 0 [] def_avoid def_env sigma c (lift ntys t))
     bodies tys in
   GRec(GCoFix n,Array.of_list (List.rev lfi),
        Array.map (fun (bl,_,_) -> bl) v,
        Array.map (fun (_,_,ty) -> ty) v,
        Array.map (fun (_,bd,_) -> bd) v)
 
-and share_names flags n l avoid env sigma c t =
+and share_names d flags n l avoid env sigma c t =
   match EConstr.kind sigma c, EConstr.kind sigma t with
     (* factorize even when not necessary to have better presentation *)
     | Lambda (na,t,c), Prod (na',t',c') ->
@@ -598,59 +692,59 @@ and share_names flags n l avoid env sigma c t =
             Name _, _ -> na
           | _, Name _ -> na'
           | _ -> na in
-        let t' = detype flags avoid env sigma t in
+        let t' = detype d flags avoid env sigma t in
 	let id = next_name_away na avoid in
-        let avoid = id::avoid and env = add_name (Name id) None t env in
-        share_names flags (n-1) ((Name id,Explicit,None,t')::l) avoid env sigma c c'
+        let avoid = Id.Set.add id avoid and env = add_name (Name id) None t env in
+        share_names d flags (n-1) ((Name id,Explicit,None,t')::l) avoid env sigma c c'
     (* May occur for fix built interactively *)
     | LetIn (na,b,t',c), _ when n > 0 ->
-        let t'' = detype flags avoid env sigma t' in
-        let b' = detype flags avoid env sigma b in
+        let t'' = detype d flags avoid env sigma t' in
+        let b' = detype d flags avoid env sigma b in
 	let id = next_name_away na avoid in
-        let avoid = id::avoid and env = add_name (Name id) (Some b) t' env in
-        share_names flags n ((Name id,Explicit,Some b',t'')::l) avoid env sigma c (lift 1 t)
+        let avoid = Id.Set. add id avoid and env = add_name (Name id) (Some b) t' env in
+        share_names d flags n ((Name id,Explicit,Some b',t'')::l) avoid env sigma c (lift 1 t)
     (* Only if built with the f/n notation or w/o let-expansion in types *)
     | _, LetIn (_,b,_,t) when n > 0 ->
-	share_names flags n l avoid env sigma c (subst1 b t)
+	share_names d flags n l avoid env sigma c (subst1 b t)
     (* If it is an open proof: we cheat and eta-expand *)
     | _, Prod (na',t',c') when n > 0 ->
-        let t'' = detype flags avoid env sigma t' in
+        let t'' = detype d flags avoid env sigma t' in
 	let id = next_name_away na' avoid in
-        let avoid = id::avoid and env = add_name (Name id) None t' env in
+        let avoid = Id.Set.add id avoid and env = add_name (Name id) None t' env in
         let appc = mkApp (lift 1 c,[|mkRel 1|]) in
-        share_names flags (n-1) ((Name id,Explicit,None,t'')::l) avoid env sigma appc c'
+        share_names d 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_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
+        let c = detype d flags avoid env sigma c in
+        let t = detype d flags avoid env sigma t in
         (List.rev l,c,t)
 
-and detype_eqns flags avoid env sigma ci computable constructs consnargsl bl =
+and detype_eqns d flags avoid env sigma ci computable constructs consnargsl bl =
   try
     if !Flags.raw_print || not (reverse_matching ()) then raise Exit;
     let mat = build_tree Anonymous (snd flags) (avoid,env) sigma ci bl in
-    List.map (fun (pat,((avoid,env),c)) -> Loc.tag ([],[pat],detype flags avoid env sigma c))
+    List.map (fun (ids,pat,((avoid,env),c)) -> Loc.tag (Id.Set.elements ids,[pat],detype d flags avoid env sigma c))
       mat
   with e when CErrors.noncritical e ->
     Array.to_list
-      (Array.map3 (detype_eqn flags avoid env sigma) constructs consnargsl bl)
+      (Array.map3 (detype_eqn d flags avoid env sigma) constructs consnargsl bl)
 
-and detype_eqn (lax,isgoal as flags) avoid env sigma constr construct_nargs branch =
+and detype_eqn d (lax,isgoal as flags) avoid env sigma constr construct_nargs branch =
   let make_pat x avoid env b body ty ids =
     if force_wildcard () && noccurn sigma 1 b then
-      CAst.make @@ PatVar Anonymous,avoid,(add_name Anonymous body ty env),ids
+      DAst.make @@ PatVar Anonymous,avoid,(add_name Anonymous body ty env),ids
     else
       let flag = if isgoal then RenamingForGoal else RenamingForCasesPattern (fst env,b) in
       let na,avoid' = compute_displayed_name_in sigma flag avoid x b in
-      CAst.make (PatVar na),avoid',(add_name na body ty env),add_vname ids na
+      DAst.make (PatVar na),avoid',(add_name na body ty env),add_vname ids na
   in
   let rec buildrec ids patlist avoid env l b =
     match EConstr.kind sigma b, l with
       | _, [] -> Loc.tag @@
         (Id.Set.elements ids,
-         [CAst.make @@ PatCstr(constr, List.rev patlist,Anonymous)],
-         detype flags avoid env sigma b)
+         [DAst.make @@ PatCstr(constr, List.rev patlist,Anonymous)],
+         detype d flags avoid env sigma b)
       | Lambda (x,t,b), false::l ->
 	    let pat,new_avoid,new_env,new_ids = make_pat x avoid env b None t ids in
             buildrec new_ids (pat::patlist) new_avoid new_env l b
@@ -663,7 +757,7 @@ and detype_eqn (lax,isgoal as flags) avoid env sigma constr construct_nargs bran
 	    buildrec ids patlist avoid env l c
 
       | _, true::l ->
-	    let pat = CAst.make @@ PatVar Anonymous in
+	    let pat = DAst.make @@ PatVar Anonymous in
             buildrec ids (pat::patlist) avoid env l b
 
       | _, false::l ->
@@ -678,23 +772,23 @@ and detype_eqn (lax,isgoal as flags) avoid env sigma constr construct_nargs bran
   in
   buildrec Id.Set.empty [] avoid env construct_nargs branch
 
-and detype_binder (lax,isgoal as flags) bk avoid env sigma na body ty c =
+and detype_binder d (lax,isgoal as flags) bk avoid env sigma na body ty c =
   let flag = if isgoal then RenamingForGoal else RenamingElsewhereFor (fst env,c) in
   let na',avoid' = match bk with
   | BLetIn -> compute_displayed_let_name_in sigma flag avoid na c
   | _ -> compute_displayed_name_in sigma flag avoid na c in
-  let r =  detype flags avoid' (add_name na' body ty env) sigma c in
+  let r =  detype d flags avoid' (add_name na' body ty env) sigma c in
   match bk with
-  | BProd   -> GProd (na',Explicit,detype (lax,false) avoid env sigma ty, r)
-  | BLambda -> GLambda (na',Explicit,detype (lax,false) avoid env sigma ty, r)
+  | BProd   -> GProd (na',Explicit,detype d (lax,false) avoid env sigma ty, r)
+  | BLambda -> GLambda (na',Explicit,detype d (lax,false) avoid env sigma ty, r)
   | BLetIn ->
-      let c = detype (lax,false) avoid env sigma (Option.get body) in
+      let c = detype d (lax,false) avoid env sigma (Option.get body) in
       (* Heuristic: we display the type if in Prop *)
       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 t = if s != InProp  && not !Flags.raw_print then None else Some (detype (lax,false) avoid env sigma ty) in
+      let t = if s != InProp  && not !Flags.raw_print then None else Some (detype d (lax,false) avoid env sigma ty) in
       GLetIn (na', c, t, r)
 
-let detype_rel_context ?(lax=false) where avoid env sigma sign =
+let detype_rel_context d ?(lax=false) where avoid env sigma sign =
   let where = Option.map (fun c -> EConstr.it_mkLambda_or_LetIn c sign) where in
   let rec aux avoid env = function
   | [] -> []
@@ -716,15 +810,18 @@ let detype_rel_context ?(lax=false) where avoid env sigma sign =
 	      | LocalAssum _ -> None
 	      | LocalDef (_,b,_) -> Some b
       in
-      let b' = Option.map (detype (lax,false) avoid env sigma) b in
-      let t' = detype (lax,false) avoid env sigma t in
+      let b' = Option.map (detype d (lax,false) avoid env sigma) b in
+      let t' = detype d (lax,false) avoid env sigma t in
       (na',Explicit,b',t') :: aux avoid' (add_name na' b t env) rest
   in aux avoid env (List.rev sign)
 
 let detype_names isgoal avoid nenv env sigma t = 
-  detype (false,isgoal) avoid (nenv,env) sigma t
-let detype ?(lax=false) isgoal avoid env sigma t =
-  detype (lax,isgoal) avoid (names_of_rel_context env, env) sigma t
+  detype Now (false,isgoal) avoid (nenv,env) sigma t
+let detype d ?(lax=false) isgoal avoid env sigma t =
+  detype d (lax,isgoal) avoid (names_of_rel_context env, env) sigma t
+
+let detype_rel_context d ?lax where avoid env sigma sign =
+  detype_rel_context d ?lax where avoid env sigma sign
 
 let detype_closed_glob ?lax isgoal avoid env sigma t =
   let open Context.Rel.Declaration in
@@ -736,7 +833,7 @@ let detype_closed_glob ?lax isgoal avoid env sigma t =
     | Name id -> Name (convert_id cl id)
     | Anonymous -> Anonymous
   in
-  let rec detype_closed_glob cl cg : Glob_term.glob_constr = CAst.map (function
+  let rec detype_closed_glob cl cg : Glob_term.glob_constr = DAst.map (function
     | GVar id ->
         (* if [id] is bound to a name. *)
         begin try
@@ -750,11 +847,11 @@ let detype_closed_glob ?lax isgoal avoid env sigma t =
              [Printer.pr_constr_under_binders_env] does. *)
           let assums = List.map (fun id -> LocalAssum (Name id,(* dummy *) mkProp)) b in
           let env = push_rel_context assums env in
-          (detype ?lax isgoal avoid env sigma c).CAst.v
+          DAst.get (detype Now ?lax isgoal avoid env sigma c)
         (* if [id] is bound to a [closed_glob_constr]. *)
         with Not_found -> try
           let {closure;term} = Id.Map.find id cl.untyped in
-          (detype_closed_glob closure term).CAst.v
+          DAst.get (detype_closed_glob closure term)
         (* Otherwise [id] stands for itself *)
         with Not_found ->
          GVar id
@@ -781,7 +878,7 @@ let detype_closed_glob ?lax isgoal avoid env sigma t =
         in
         GCases(sty,po,tml,eqns)
     | c ->
-        (Glob_ops.map_glob_constr (detype_closed_glob cl) cg).CAst.v
+        DAst.get (Glob_ops.map_glob_constr (detype_closed_glob cl) cg)
     ) cg
   in
   detype_closed_glob t.closure t.term
@@ -789,7 +886,7 @@ let detype_closed_glob ?lax isgoal avoid env sigma t =
 (**********************************************************************)
 (* Module substitution: relies on detyping                            *)
 
-let rec subst_cases_pattern subst = CAst.map (function
+let rec subst_cases_pattern subst = DAst.map (function
   | PatVar _ as pat -> pat
   | PatCstr (((kn,i),j),cpl,n) as pat ->
       let kn' = subst_mind subst kn
@@ -800,11 +897,11 @@ let rec subst_cases_pattern subst = CAst.map (function
 
 let (f_subst_genarg, subst_genarg_hook) = Hook.make ()
 
-let rec subst_glob_constr subst = CAst.map (function
+let rec subst_glob_constr subst = DAst.map (function
   | GRef (ref,u) as raw ->
       let ref',t = subst_global subst ref in
 	if ref' == ref then raw else
-         (detype false [] (Global.env()) Evd.empty (EConstr.of_constr t)).CAst.v
+         DAst.get (detype Now false Id.Set.empty (Global.env()) Evd.empty (EConstr.of_constr t))
 
   | GSort _
   | GVar _
@@ -898,6 +995,13 @@ let rec subst_glob_constr subst = CAst.map (function
       let r1' = subst_glob_constr subst r1 in
       let k' = Miscops.smartmap_cast_type (subst_glob_constr subst) k in
       if r1' == r1 && k' == k then raw else GCast (r1',k')
+
+  | GProj (p,c) as raw ->
+    let kn = Projection.constant p in
+    let b = Projection.unfolded p in
+    let kn' = subst_constant subst kn in
+    let c' = subst_glob_constr subst c in
+    if kn' == kn && c' == c then raw else GProj(Projection.make kn' b, c')
   )
 
 (* Utilities to transform kernel cases to simple pattern-matching problem *)
@@ -905,8 +1009,8 @@ let rec subst_glob_constr subst = CAst.map (function
 let simple_cases_matrix_of_branches ind brs =
   List.map (fun (i,n,b) ->
       let nal,c = it_destRLambda_or_LetIn_names n b in
-      let mkPatVar na = CAst.make @@ PatVar na in
-      let p = CAst.make @@ PatCstr ((ind,i+1),List.map mkPatVar nal,Anonymous) in
+      let mkPatVar na = DAst.make @@ PatVar na in
+      let p = DAst.make @@ PatCstr ((ind,i+1),List.map mkPatVar nal,Anonymous) in
       let ids = List.map_filter Nameops.Name.to_option nal in
       Loc.tag @@ (ids,[p],c))
     brs
diff --git a/pretyping/detyping.mli b/pretyping/detyping.mli
index 59f3f967d..f150cb195 100644
--- a/pretyping/detyping.mli
+++ b/pretyping/detyping.mli
@@ -7,7 +7,6 @@
 (************************************************************************)
 
 open Names
-open Term
 open Environ
 open EConstr
 open Glob_term
@@ -15,6 +14,11 @@ open Termops
 open Mod_subst
 open Misctypes
 open Evd
+open Ltac_pretype
+
+type _ delay =
+| Now : 'a delay
+| Later : [ `thunk ] delay
 
 (** Should we keep details of universes during detyping ? *)
 val print_universes : bool ref
@@ -22,32 +26,42 @@ val print_universes : bool ref
 (** If true, prints full local context of evars *)
 val print_evar_arguments : bool ref
 
+(** If true, contract branches with same r.h.s. and same matching
+    variables in a disjunctive pattern *)
+val print_factorize_match_patterns : bool ref
+
+(** If true and the last non unique clause of a "match" is a
+    variable-free disjunctive pattern, turn it into a catch-call case *)
+val print_allow_match_default_clause : bool ref
+
 val subst_cases_pattern : substitution -> cases_pattern -> cases_pattern
 
 val subst_glob_constr : substitution -> glob_constr -> glob_constr
 
+val factorize_eqns : 'a cases_clauses_g -> 'a disjunctive_cases_clauses_g
+
 (** [detype isgoal avoid ctx c] turns a closed [c], into a glob_constr 
    de Bruijn indexes are turned to bound names, avoiding names in [avoid] 
    [isgoal] tells if naming must avoid global-level synonyms as intro does 
    [ctx] gives the names of the free variables *)
 
-val detype_names : bool -> Id.t list -> names_context -> env -> evar_map -> constr -> glob_constr
+val detype_names : bool -> Id.Set.t -> names_context -> env -> evar_map -> constr -> glob_constr
 
-val detype : ?lax:bool -> bool -> Id.t list -> env -> evar_map -> constr -> glob_constr
+val detype : 'a delay -> ?lax:bool -> bool -> Id.Set.t -> env -> evar_map -> constr -> 'a glob_constr_g
 
-val detype_sort : evar_map -> sorts -> glob_sort
+val detype_sort : evar_map -> Sorts.t -> glob_sort
 
-val detype_rel_context : ?lax:bool -> constr option -> Id.t list -> (names_context * env) -> 
-  evar_map -> rel_context -> glob_decl list
+val detype_rel_context : 'a delay -> ?lax:bool -> constr option -> Id.Set.t -> (names_context * env) -> 
+  evar_map -> rel_context -> 'a glob_decl_g list
 
-val detype_closed_glob : ?lax:bool -> bool -> Id.t list -> env -> evar_map -> closed_glob_constr -> glob_constr
+val detype_closed_glob : ?lax:bool -> bool -> Id.Set.t -> env -> evar_map -> closed_glob_constr -> glob_constr
 
 (** look for the index of a named var or a nondep var as it is renamed *)
 val lookup_name_as_displayed  : env -> evar_map -> constr -> Id.t -> int option
 val lookup_index_as_renamed : env -> evar_map -> constr -> int -> int option
 
 (* XXX: This is a hack and should go away *)
-val set_detype_anonymous : (?loc:Loc.t -> int -> glob_constr) -> unit
+val set_detype_anonymous : (?loc:Loc.t -> int -> Id.t) -> unit
 
 val force_wildcard : unit -> bool
 val synthetize_type : unit -> bool
diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml
index cb76df4e8..dc3acbc3e 100644
--- a/pretyping/evarconv.ml
+++ b/pretyping/evarconv.ml
@@ -9,7 +9,7 @@
 open CErrors
 open Util
 open Names
-open Term
+open Constr
 open Termops
 open Environ
 open EConstr
@@ -48,8 +48,8 @@ let _ = Goptions.declare_bool_option {
    "data.id.type" etc... *)
 let impossible_default_case () =
   let c, ctx = Universes.fresh_global_instance (Global.env()) (Globnames.ConstRef Coqlib.id) in
-  let (_, u) = Term.destConst c in
-  Some (c, Term.mkConstU (Coqlib.type_of_id, u), ctx)
+  let (_, u) = Constr.destConst c in
+  Some (c, Constr.mkConstU (Coqlib.type_of_id, u), ctx)
 
 let coq_unit_judge =
   let open Environ in
@@ -175,7 +175,13 @@ let check_conv_record env sigma (t1,sk1) (t2,sk2) =
       | Sort s ->
         let s = ESorts.kind sigma s in
 	lookup_canonical_conversion
-	  (proji, Sort_cs (family_of_sort s)),[]
+	  (proji, Sort_cs (Sorts.family s)),[]
+      | Proj (p, c) ->
+        let c2 = Globnames.ConstRef (Projection.constant p) in
+        let c = Retyping.expand_projection env sigma p c [] in
+        let _, args = destApp sigma c in
+        let sk2 = Stack.append_app args sk2 in
+        lookup_canonical_conversion (proji, Const_cs c2), sk2
       | _ ->
 	let (c2, _) = Termops.global_of_constr sigma t2 in
 	  lookup_canonical_conversion (proji, Const_cs c2),sk2
@@ -212,6 +218,8 @@ let check_conv_record env sigma (t1,sk1) (t2,sk2) =
   let t' = EConstr.of_constr t' in
   let t' = subst_univs_level_constr subst t' in
   let bs' = List.map (EConstr.of_constr %> subst_univs_level_constr subst) bs in
+  let params = List.map (fun c -> subst_univs_level_constr subst c) params in
+  let us = List.map (fun c -> subst_univs_level_constr subst c) us in
   let h, _ = decompose_app_vect sigma t' in
     ctx',(h, t2),c',bs',(Stack.append_app_list params Stack.empty,params1),
     (Stack.append_app_list us Stack.empty,us2),(extra_args1,extra_args2),c1,
@@ -268,11 +276,6 @@ let rec ise_app_stack2 env f evd sk1 sk2 =
      end
   | _, _ -> (sk1,sk2), Success evd
 
-let push_rec_types pfix env =
-  let (i, c, t) = pfix in
-  let inj c = EConstr.Unsafe.to_constr c in
-  push_rec_types (i, Array.map inj c, Array.map inj t) env
-
 (* This function tries to unify 2 stacks element by element. It works
    from the end to the beginning. If it unifies a non empty suffix of
    stacks but not the entire stacks, the first part of the answer is
@@ -291,7 +294,7 @@ let ise_stack2 no_app env evd f sk1 sk2 =
         | UnifFailure _ as x -> fail x)
       | UnifFailure _ as x -> fail x)
     | Stack.Proj (n1,a1,p1,_)::q1, Stack.Proj (n2,a2,p2,_)::q2 ->
-       if eq_constant (Projection.constant p1) (Projection.constant p2)
+       if Constant.equal (Projection.constant p1) (Projection.constant p2)
        then ise_stack2 true i q1 q2
        else fail (UnifFailure (i, NotSameHead))
     | Stack.Fix (((li1, i1),(_,tys1,bds1 as recdef1)),a1,_)::q1,
@@ -304,8 +307,6 @@ let ise_stack2 no_app env evd f sk1 sk2 =
         | Success i' -> ise_stack2 true i' q1 q2
         | UnifFailure _ as x -> fail x
       else fail (UnifFailure (i,NotSameHead))
-    | Stack.Update _ :: _, _ | Stack.Shift _ :: _, _
-    | _, Stack.Update _ :: _ | _, Stack.Shift _ :: _ -> assert false
     | Stack.App _ :: _, Stack.App _ :: _ ->
        if no_app && deep then fail ((*dummy*)UnifFailure(i,NotSameHead)) else
 	 begin match ise_app_stack2 env f i sk1 sk2 with
@@ -335,11 +336,9 @@ let exact_ise_stack2 env evd f sk1 sk2 =
 	  (fun i -> ise_stack2 i a1 a2)]
       else UnifFailure (i,NotSameHead)
     | Stack.Proj (n1,a1,p1,_)::q1, Stack.Proj (n2,a2,p2,_)::q2 ->
-       if eq_constant (Projection.constant p1) (Projection.constant p2)
+       if Constant.equal (Projection.constant p1) (Projection.constant p2)
        then ise_stack2 i q1 q2
        else (UnifFailure (i, NotSameHead))
-    | Stack.Update _ :: _, _ | Stack.Shift _ :: _, _
-    | _, Stack.Update _ :: _ | _, Stack.Shift _ :: _ -> assert false
     | Stack.App _ :: _, Stack.App _ :: _ ->
 	 begin match ise_app_stack2 env f i sk1 sk2 with
 	       |_,(UnifFailure _ as x) -> x
@@ -354,19 +353,7 @@ let exact_ise_stack2 env evd f sk1 sk2 =
 let check_leq_inductives evd cumi u u' =
   let u = EConstr.EInstance.kind evd u in
   let u' = EConstr.EInstance.kind evd u' in
-  let length_ind_instance =
-    Univ.AUContext.size (Univ.ACumulativityInfo.univ_context cumi)
-  in
-  let ind_sbcst =  Univ.ACumulativityInfo.subtyp_context cumi in
-  if not ((length_ind_instance = Univ.Instance.length u) &&
-          (length_ind_instance = Univ.Instance.length u')) then
-     anomaly (Pp.str "Invalid inductive subtyping encountered!")
-  else
-    begin
-     let comp_subst = (Univ.Instance.append u u') in
-     let comp_cst =  Univ.AUContext.instantiate comp_subst ind_sbcst in
-     Evd.add_constraints evd comp_cst
-    end
+  Evd.add_constraints evd (Reduction.get_cumulativity_constraints CUMUL cumi u u')
 
 let rec evar_conv_x ts env evd pbty term1 term2 =
   let term1 = whd_head_evar evd term1 in
@@ -451,7 +438,7 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
     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
-      (Stack.zip evd (term', sk' @ [Stack.Shift 1]), Stack.append_app [|EConstr.mkRel 1|] Stack.empty), 
+      (lift 1 (Stack.zip evd (term', sk')), Stack.append_app [|EConstr.mkRel 1|] Stack.empty),
       Cst_stack.empty in
     if onleft then evar_eqappr_x ts env' evd CONV out1 out2
     else evar_eqappr_x ts env' evd CONV out2 out1
@@ -765,7 +752,7 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
 	    ise_try evd [f1; f2]
 	      
 	(* Catch the p.c ~= p c' cases *)
-	| Proj (p,c), Const (p',u) when eq_constant (Projection.constant p) p' ->
+	| Proj (p,c), Const (p',u) when Constant.equal (Projection.constant p) p' ->
 	  let res = 
 	    try Some (destApp evd (Retyping.expand_projection env evd p c []))
 	    with Retyping.RetypeError _ -> None
@@ -776,7 +763,7 @@ and evar_eqappr_x ?(rhs_is_already_stuck = false) ts env evd pbty
 		(appr2,csts2)
 	    | None -> UnifFailure (evd,NotSameHead))
 	      
-	| Const (p,u), Proj (p',c') when eq_constant p (Projection.constant p') ->
+	| Const (p,u), Proj (p',c') when Constant.equal p (Projection.constant p') ->
 	  let res = 
 	    try Some (destApp evd (Retyping.expand_projection env evd p' c' []))
 	    with Retyping.RetypeError _ -> None
@@ -1040,7 +1027,7 @@ and conv_record trs env evd (ctx,(h,h2),c,bs,(params,params1),(us,us2),(sk1,sk2)
 and eta_constructor ts env evd sk1 ((ind, i), u) sk2 term2 =
   let mib = lookup_mind (fst ind) env in
     match mib.Declarations.mind_record with
-    | Some (Some (id, projs, pbs)) when mib.Declarations.mind_finite == Decl_kinds.BiFinite -> 
+    | Some (Some (id, projs, pbs)) when mib.Declarations.mind_finite == Declarations.BiFinite ->
       let pars = mib.Declarations.mind_nparams in
 	(try 
 	   let l1' = Stack.tail pars sk1 in
@@ -1061,8 +1048,8 @@ let evar_conv_x ts = evar_conv_x (ts, true)
 (* Profiling *)
 let evar_conv_x =
   if Flags.profile then
-    let evar_conv_xkey = Profile.declare_profile "evar_conv_x" in
-      Profile.profile6 evar_conv_xkey evar_conv_x
+    let evar_conv_xkey = CProfile.declare_profile "evar_conv_x" in
+      CProfile.profile6 evar_conv_xkey evar_conv_x
   else evar_conv_x
 
 let evar_conv_hook_get, evar_conv_hook_set = Hook.make ~default:evar_conv_x ()
diff --git a/pretyping/evarconv.mli b/pretyping/evarconv.mli
index c30d1d26b..d793b06d3 100644
--- a/pretyping/evarconv.mli
+++ b/pretyping/evarconv.mli
@@ -47,7 +47,7 @@ val check_problems_are_solved : env -> evar_map -> unit
 
 val check_conv_record : env -> evar_map -> 
   state -> state ->
-  Univ.universe_context_set * (constr * constr) 
+  Univ.ContextSet.t * (constr * constr) 
   * constr * constr list * (constr Stack.t * constr Stack.t) *
     (constr Stack.t * constr Stack.t) *
     (constr Stack.t * constr Stack.t) * constr *
diff --git a/pretyping/evardefine.ml b/pretyping/evardefine.ml
index 7f5a780f9..fd83795f5 100644
--- a/pretyping/evardefine.ml
+++ b/pretyping/evardefine.ml
@@ -6,10 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+open Sorts
 open Util
 open Pp
 open Names
-open Term
+open Constr
 open Termops
 open EConstr
 open Vars
@@ -27,8 +28,8 @@ let env_nf_evar sigma env =
 
 let env_nf_betaiotaevar sigma env =
   process_rel_context
-    (fun d e ->
-      push_rel (RelDecl.map_constr (fun c -> Reductionops.nf_betaiota sigma c) d) e) env
+    (fun d env ->
+      push_rel (RelDecl.map_constr (fun c -> Reductionops.nf_betaiota env sigma c) d) env) env
 
 (****************************************)
 (* Operations on value/type constraints *)
@@ -72,7 +73,7 @@ let define_pure_evar_as_product evd evk =
   let open Context.Named.Declaration in
   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 id = next_ident_away idx (Environ.ids_of_named_context_val evi.evar_hyps) in
   let concl = Reductionops.whd_all evenv evd (EConstr.of_constr evi.evar_concl) in
   let s = destSort evd concl in
   let evd1,(dom,u1) =
@@ -82,7 +83,7 @@ let define_pure_evar_as_product evd evk =
     let newenv = push_named (LocalAssum (id, dom)) evenv in
     let src = evar_source evk evd1 in
     let filter = Filter.extend 1 (evar_filter evi) in
-      if is_prop_sort (ESorts.kind evd1 s) then
+      if Sorts.is_prop (ESorts.kind evd1 s) then
        (* Impredicative product, conclusion must fall in [Prop]. *)
         new_evar newenv evd1 concl ~src ~filter
       else
@@ -127,7 +128,7 @@ let define_pure_evar_as_lambda env evd evk =
   | Prod (na,dom,rng) -> (evd,(na,dom,rng))
   | Evar ev' -> let evd,typ = define_evar_as_product evd ev' in evd,destProd evd typ
   | _ -> error_not_product env evd typ in
-  let avoid = ids_of_named_context (evar_context evi) in
+  let avoid = Environ.ids_of_named_context_val evi.evar_hyps in
   let id =
     next_name_away_with_default_using_types "x" na avoid (Reductionops.whd_evar evd dom) in
   let newenv = push_named (LocalAssum (id, dom)) evenv in
diff --git a/pretyping/evardefine.mli b/pretyping/evardefine.mli
index 5477c5c99..869e3adbf 100644
--- a/pretyping/evardefine.mli
+++ b/pretyping/evardefine.mli
@@ -7,7 +7,6 @@
 (************************************************************************)
 
 open Names
-open Term
 open EConstr
 open Evd
 open Environ
@@ -39,7 +38,7 @@ val lift_tycon : int -> type_constraint -> type_constraint
 
 val define_evar_as_product : evar_map -> existential -> evar_map * types
 val define_evar_as_lambda : env -> evar_map -> existential -> evar_map * types
-val define_evar_as_sort : env -> evar_map -> existential -> evar_map * sorts
+val define_evar_as_sort : env -> evar_map -> existential -> evar_map * Sorts.t
 
 (** {6 debug pretty-printer:} *)
 
diff --git a/pretyping/evarsolve.ml b/pretyping/evarsolve.ml
index ef0fb8ea6..e6d1e59b3 100644
--- a/pretyping/evarsolve.ml
+++ b/pretyping/evarsolve.ml
@@ -6,10 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+open Sorts
 open Util
 open CErrors
 open Names
-open Term
+open Constr
 open Environ
 open Termops
 open Evd
@@ -679,6 +680,7 @@ let materialize_evar define_fun env evd k (evk1,args1) ty_in_env =
   let filter1 = evar_filter evi1 in
   let src = subterm_source evk1 evi1.evar_source in
   let ids1 = List.map get_id (named_context_of_val sign1) in
+  let avoid = Environ.ids_of_named_context_val sign1 in
   let inst_in_sign = List.map mkVar (Filter.filter_list filter1 ids1) in
   let open Context.Rel.Declaration in
   let (sign2,filter2,inst2_in_env,inst2_in_sign,_,evd,_) =
@@ -700,9 +702,9 @@ let materialize_evar define_fun env evd k (evk1,args1) ty_in_env =
       (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))
+       push_rel d env,evd,Id.Set.add id avoid))
       rel_sign
-      (sign1,filter1,Array.to_list args1,inst_in_sign,env1,evd,ids1)
+      (sign1,filter1,Array.to_list args1,inst_in_sign,env1,evd,avoid)
   in
   let evd,ev2ty_in_sign =
     let s = Retyping.get_sort_of env evd ty_in_env in
@@ -841,6 +843,25 @@ let rec find_solution_type evarenv = function
   | (id,ProjectEvar _)::l -> find_solution_type evarenv l
   | [] -> assert false
 
+let is_preferred_projection_over sign (id,p) (id',p') =
+  (* We give priority to projection of variables over instantiation of
+     an evar considering that the latter is a stronger decision which
+     may even procude an incorrect (ill-typed) solution *)
+  match p, p' with
+  | ProjectEvar _, ProjectVar -> false
+  | ProjectVar, ProjectEvar _ -> true
+  | _, _ ->
+     List.index Id.equal id sign < List.index Id.equal id' sign
+
+let choose_projection evi sols =
+  let sign = List.map get_id (evar_filtered_context evi) in
+  match sols with
+  | y::l ->
+     List.fold_right (fun (id,p as x) (id',_ as y) ->
+         if is_preferred_projection_over sign x y then x else y)
+    l y
+  | _ -> assert false
+
 (* In case the solution to a projection problem requires the instantiation of
  * subsidiary evars, [do_projection_effects] performs them; it
  * also try to instantiate the type of those subsidiary evars if their
@@ -1001,7 +1022,7 @@ let closure_of_filter evd evk = function
   | Some filter ->
   let evi = Evd.find_undefined evd evk in
   let vars = collect_vars evd (EConstr.of_constr (evar_concl evi)) in
-  let test b decl = b || Idset.mem (get_id decl) vars ||
+  let test b decl = b || Id.Set.mem (get_id decl) vars ||
                     match decl with
                     | LocalAssum _ ->
                        false
@@ -1371,7 +1392,7 @@ let occur_evar_upto_types sigma n c =
   let c = EConstr.Unsafe.to_constr c in
   let seen = ref Evar.Set.empty in
   (** FIXME: Is that supposed to be evar-insensitive? *)
-  let rec occur_rec c = match kind_of_term c with
+  let rec occur_rec c = match Constr.kind c with
     | Evar (sp,_) when Evar.equal sp n -> raise Occur
     | Evar (sp,args as e) ->
        if Evar.Set.mem sp !seen then
@@ -1428,8 +1449,12 @@ let rec invert_definition conv_algo choose env evd pbty (evk,argsv as ev) rhs =
       let c, p = match sols with
         | [] -> raise Not_found
         | [id,p] -> (mkVar id, p)
-        | (id,p)::_::_ ->
-            if choose then (mkVar id, p) else raise (NotUniqueInType sols)
+        | _ ->
+            if choose then
+              let (id,p) = choose_projection evi sols in
+              (mkVar id, p)
+            else
+              raise (NotUniqueInType sols)
       in
       let ty = lazy (Retyping.get_type_of env !evdref (of_alias t)) in
       let evd = do_projection_effects (evar_define conv_algo ~choose) env ty !evdref p in
@@ -1550,19 +1575,19 @@ let rec invert_definition conv_algo choose env evd pbty (evk,argsv as ev) rhs =
   let rhs = whd_beta evd rhs (* heuristic *) in
   let fast rhs = 
     let filter_ctxt = evar_filtered_context evi in
-    let names = ref Idset.empty in
+    let names = ref Id.Set.empty in
     let rec is_id_subst ctxt s =
       match ctxt, s with
       | (decl :: ctxt'), (c :: s') ->
         let id = get_id decl in
-        names := Idset.add id !names;
+        names := Id.Set.add id !names;
         isVarId evd id c && is_id_subst ctxt' s'
       | [], [] -> true
       | _ -> false 
     in
       is_id_subst filter_ctxt (Array.to_list argsv) &&
       closed0 evd rhs &&
-      Idset.subset (collect_vars evd rhs) !names 
+      Id.Set.subset (collect_vars evd rhs) !names 
   in
   let body =
     if fast rhs then EConstr.of_constr (EConstr.to_constr evd rhs) (** FIXME? *)
diff --git a/pretyping/evarsolve.mli b/pretyping/evarsolve.mli
index 811b4dc18..703c4616c 100644
--- a/pretyping/evarsolve.mli
+++ b/pretyping/evarsolve.mli
@@ -6,7 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Term
 open EConstr
 open Evd
 open Environ
@@ -49,7 +48,7 @@ val refresh_universes :
   env -> evar_map -> types -> evar_map * types
 
 val solve_refl : ?can_drop:bool -> conv_fun_bool -> env ->  evar_map ->
-  bool option -> existential_key -> constr array -> constr array -> evar_map
+  bool option -> Evar.t -> constr array -> constr array -> evar_map
 
 val solve_evar_evar : ?force:bool ->
   (env -> evar_map -> bool option -> existential -> constr -> evar_map) ->
@@ -78,10 +77,10 @@ exception IllTypedInstance of env * types * types
 
 (* May raise IllTypedInstance if types are not convertible *)
 val check_evar_instance :
-  evar_map -> existential_key -> constr -> conv_fun -> evar_map
+  evar_map -> Evar.t -> constr -> conv_fun -> evar_map
 
 val remove_instance_local_defs :
-  evar_map -> existential_key -> 'a array -> 'a list
+  evar_map -> Evar.t -> 'a array -> 'a list
 
 val get_type_of_refresh : 
   ?polyprop:bool -> ?lax:bool -> env -> evar_map -> constr -> evar_map * types
diff --git a/pretyping/find_subterm.ml b/pretyping/find_subterm.ml
index 9e7652da6..fd6bfe0a2 100644
--- a/pretyping/find_subterm.ml
+++ b/pretyping/find_subterm.ml
@@ -12,7 +12,6 @@ open CErrors
 open Names
 open Locus
 open EConstr
-open Nameops
 open Termops
 open Pretype_errors
 
@@ -30,7 +29,7 @@ let explain_invalid_occurrence l =
   ++ prlist_with_sep spc int l ++ str "."
 
 let explain_incorrect_in_value_occurrence id =
-  pr_id id ++ str " has no value."
+  Id.print id ++ str " has no value."
 
 let explain_occurrence_error = function
   | InvalidOccurrence l -> explain_invalid_occurrence l
diff --git a/engine/geninterp.ml b/pretyping/geninterp.ml
index e79e258fb..768ef3cfd 100644
--- a/engine/geninterp.ml
+++ b/pretyping/geninterp.ml
@@ -9,11 +9,11 @@
 open Names
 open Genarg
 
-module TacStore = Store.Make(struct end)
+module TacStore = Store.Make ()
 
 (** Dynamic toplevel values *)
 
-module ValT = Dyn.Make(struct end)
+module ValT = Dyn.Make ()
 
 module Val =
 struct
@@ -47,6 +47,8 @@ struct
 
 end
 
+module ValTMap = ValT.Map
+
 module ValReprObj =
 struct
   type ('raw, 'glb, 'top) obj = 'top Val.tag
diff --git a/engine/geninterp.mli b/pretyping/geninterp.mli
index 492e372ad..ae0b26e59 100644
--- a/engine/geninterp.mli
+++ b/pretyping/geninterp.mli
@@ -39,6 +39,10 @@ sig
   val inject : 'a tag -> 'a -> t
 
 end
+
+module ValTMap (M : Dyn.TParam) :
+  Dyn.MapS with type 'a obj = 'a M.t with type 'a key = 'a Val.typ
+
 (** Dynamic types for toplevel values. While the generic types permit to relate
     objects at various levels of interpretation, toplevel values are wearing
     their own type regardless of where they came from. This allows to use the
diff --git a/pretyping/glob_ops.ml b/pretyping/glob_ops.ml
index b94228e75..25817478e 100644
--- a/pretyping/glob_ops.ml
+++ b/pretyping/glob_ops.ml
@@ -13,18 +13,29 @@ open Globnames
 open Misctypes
 open Glob_term
 open Evar_kinds
+open Ltac_pretype
 
 (* Untyped intermediate terms, after ASTs and before constr. *)
 
 let cases_pattern_loc c = c.CAst.loc
 
+let alias_of_pat pat = DAst.with_val (function
+  | PatVar name -> name
+  | PatCstr(_,_,name) -> name
+  ) pat
+
+let set_pat_alias id = DAst.map (function
+  | PatVar Anonymous -> PatVar (Name id)
+  | PatCstr (cstr,patl,Anonymous) -> PatCstr (cstr,patl,Name id)
+  | pat -> assert false)
+
 let cases_predicate_names tml =
   List.flatten (List.map (function
     | (tm,(na,None)) -> [na]
     | (tm,(na,Some (_,(_,nal)))) -> na::nal) tml)
 
-let mkGApp ?loc p t = CAst.make ?loc @@
-  match p.CAst.v with
+let mkGApp ?loc p t = DAst.make ?loc @@
+  match DAst.get p with
   | GApp (f,l) -> GApp (f,l@[t])
   | _          -> GApp (p,[t])
 
@@ -46,7 +57,7 @@ let case_style_eq s1 s2 = match s1, s2 with
   | RegularStyle, RegularStyle -> true
   | (LetStyle | IfStyle | LetPatternStyle | MatchStyle | RegularStyle), _ -> false
 
-let rec cases_pattern_eq { CAst.v = p1} { CAst.v = p2 } = match p1, p2 with
+let rec cases_pattern_eq p1 p2 = match DAst.get p1, DAst.get 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 &&
@@ -98,7 +109,7 @@ let fix_kind_eq f k1 k2 = match k1, k2 with
 let instance_eq f (x1,c1) (x2,c2) =
   Id.equal x1 x2 && f c1 c2
 
-let mk_glob_constr_eq f { CAst.v = c1 } { CAst.v = c2 } = match c1, c2 with
+let mk_glob_constr_eq f c1 c2 = match DAst.get c1, DAst.get c2 with
   | GRef (gr1, _), GRef (gr2, _) -> eq_gr gr1 gr2
   | GVar id1, GVar id2 -> Id.equal id1 id2
   | GEvar (id1, arg1), GEvar (id2, arg2) ->
@@ -132,12 +143,14 @@ let mk_glob_constr_eq f { CAst.v = c1 } { CAst.v = c2 } = match c1, c2 with
     Miscops.intro_pattern_naming_eq nam1 nam2
   | GCast (c1, t1), GCast (c2, t2) ->
     f c1 c2 && cast_type_eq f t1 t2
+  | GProj (p1, t1), GProj (p2, t2) ->
+    Projection.equal p1 p2 && f t1 t2
   | (GRef _ | GVar _ | GEvar _ | GPatVar _ | GApp _ | GLambda _ | GProd _ | GLetIn _ |
-     GCases _ | GLetTuple _ | GIf _ | GRec _ | GSort _ | GHole _ | GCast _), _ -> false
+     GCases _ | GLetTuple _ | GIf _ | GRec _ | GSort _ | GHole _ | GCast _ | GProj _), _ -> false
 
 let rec glob_constr_eq c = mk_glob_constr_eq glob_constr_eq c
 
-let map_glob_constr_left_to_right f = CAst.map (function
+let map_glob_constr_left_to_right f = DAst.map (function
   | GApp (g,args) ->
       let comp1 = f g in
       let comp2 = Util.List.map_left f args in
@@ -179,6 +192,8 @@ let map_glob_constr_left_to_right f = CAst.map (function
       let comp1 = f c in
       let comp2 = Miscops.map_cast_type f k in
       GCast (comp1,comp2)
+  | GProj (p,c) ->
+    GProj (p, f c)
   | (GVar _ | GSort _ | GHole _ | GRef _ | GEvar _ | GPatVar _) as x -> x
   )
 
@@ -186,7 +201,7 @@ let map_glob_constr = map_glob_constr_left_to_right
 
 let fold_return_type f acc (na,tyopt) = Option.fold_left f acc tyopt
 
-let fold_glob_constr f acc = CAst.with_val (function
+let fold_glob_constr f acc = DAst.with_val (function
   | GVar _ -> acc
   | GApp (c,args) -> List.fold_left f (f acc c) args
   | GLambda (_,_,b,c) | GProd (_,_,b,c) ->
@@ -211,13 +226,15 @@ let fold_glob_constr f acc = CAst.with_val (function
     let acc = match k with
       | CastConv t | CastVM t | CastNative t -> f acc t | CastCoerce -> acc in
     f acc c
+  | GProj(_,c) ->
+    f acc c
   | (GSort _ | GHole _ | GRef _ | GEvar _ | GPatVar _) -> acc
   )
 
 let fold_return_type_with_binders f g v acc (na,tyopt) =
   Option.fold_left (f (Name.fold_right g na v)) acc tyopt
 
-let fold_glob_constr_with_binders g f v acc = CAst.(with_val (function
+let fold_glob_constr_with_binders g f v acc = DAst.(with_val (function
   | GVar _ -> acc
   | GApp (c,args) -> List.fold_left (f v) (f v acc c) args
   | GLambda (na,_,b,c) | GProd (na,_,b,c) ->
@@ -234,7 +251,8 @@ let fold_glob_constr_with_binders g f v acc = CAst.(with_val (function
     let acc = Option.fold_left (f v') acc rtntypopt in
     List.fold_left fold_pattern acc pl
   | GLetTuple (nal,rtntyp,b,c) ->
-    f v (f v (fold_return_type_with_binders f g v acc rtntyp) b) c
+    f (List.fold_right (Name.fold_right g) nal v)
+      (f v (fold_return_type_with_binders f g v acc rtntyp) b) c
   | GIf (c,rtntyp,b1,b2) ->
     f v (f v (f v (fold_return_type_with_binders f g v acc rtntyp) c) b1) b2
   | GRec (_,idl,bll,tyl,bv) ->
@@ -251,15 +269,16 @@ let fold_glob_constr_with_binders g f v acc = CAst.(with_val (function
     let acc = match k with
       | CastConv t | CastVM t | CastNative t -> f v acc t | CastCoerce -> acc in
     f v acc c
+  | GProj(_,c) ->
+    f v acc c
   | (GSort _ | GHole _ | GRef _ | GEvar _ | GPatVar _) -> acc))
 
 let iter_glob_constr f = fold_glob_constr (fun () -> f) ()
 
 let occur_glob_constr id =
-  let open CAst in
-  let rec occur barred acc = function
-    | { loc ; v = GVar id' } -> Id.equal id id'
-    | c ->
+  let rec occur barred acc c = match DAst.get c with
+    | GVar id' -> Id.equal id id'
+    | _ ->
        (* [g] looks if [id] appears in a binding position, in which
           case, we don't have to look in the corresponding subterm *)
        let g id' barred = barred || Id.equal id id' in
@@ -268,29 +287,28 @@ let occur_glob_constr id =
   occur false false
 
 let free_glob_vars =
-  let open CAst in
-  let rec vars bound vs = function
-    | { loc ; v = GVar id' } -> if Id.Set.mem id' bound then vs else Id.Set.add id' vs
-    | c -> fold_glob_constr_with_binders Id.Set.add vars bound vs c in
+  let rec vars bound vs c = match DAst.get c with
+    | GVar id' -> if Id.Set.mem id' bound then vs else Id.Set.add id' vs
+    | _ -> fold_glob_constr_with_binders Id.Set.add vars bound vs c in
   fun rt ->
     let vs = vars Id.Set.empty Id.Set.empty rt in
-    Id.Set.elements vs
+    vs
 
 let glob_visible_short_qualid c =
-  let rec aux acc = function
-    | { CAst.v = GRef (c,_) } ->
+  let rec aux acc c = match DAst.get c with
+    | GRef (c,_) ->
         let qualid = Nametab.shortest_qualid_of_global Id.Set.empty c in
         let dir,id = Libnames.repr_qualid  qualid in
-        if DirPath.is_empty dir then id :: acc else acc
-    | c ->
+        if DirPath.is_empty dir then Id.Set.add id acc else acc
+    | _ ->
         fold_glob_constr aux acc c
-  in aux [] c
+  in aux Id.Set.empty 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)
+          strbrk "Collision between bound variables of name " ++ Id.print name)
 
 let add_and_check_ident id set =
   if Id.Set.mem id set then warn_variable_collision id;
@@ -326,7 +344,7 @@ let map_tomatch_binders f ((c,(na,inp)) as x) : tomatch_tuple =
   if r == inp then x
   else c,(f na, r)
 
-let rec map_case_pattern_binders f = CAst.map (function
+let rec map_case_pattern_binders f = DAst.map (function
   | PatVar na as x ->
       let r = f na in
       if r == na then x
@@ -396,7 +414,9 @@ let rename_var l id =
     if List.exists (fun (_,id') -> Id.equal id id') l then raise UnsoundRenaming
     else id
 
-let rec rename_glob_vars l c = CAst.map_with_loc (fun ?loc -> function
+let force c = DAst.make ?loc:c.CAst.loc (DAst.get c)
+
+let rec rename_glob_vars l c = force @@ DAst.map_with_loc (fun ?loc -> function
   | GVar id as r ->
       let id' = rename_var l id in
       if id == id' then r else GVar id'
@@ -436,13 +456,17 @@ let rec rename_glob_vars l c = CAst.map_with_loc (fun ?loc -> function
              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)
-  | _ -> (map_glob_constr (rename_glob_vars l) c).CAst.v
+  | _ -> DAst.get (map_glob_constr (rename_glob_vars l) c)
   ) c
 
 (**********************************************************************)
 (* Conversion from glob_constr to cases pattern, if possible            *)
 
-let rec cases_pattern_of_glob_constr na = CAst.map (function
+let is_gvar id c = match DAst.get c with
+| GVar id' -> Id.equal id id'
+| _ -> false
+
+let rec cases_pattern_of_glob_constr na = DAst.map (function
   | GVar id ->
     begin match na with
     | Name _ ->
@@ -452,8 +476,15 @@ let rec cases_pattern_of_glob_constr na = CAst.map (function
     end
   | GHole (_,_,_) -> PatVar na
   | GRef (ConstructRef cstr,_) -> PatCstr (cstr,[],na)
-  | GApp ( { CAst.v = GRef (ConstructRef cstr,_) }, l) ->
+  | GApp (c, l) ->
+    begin match DAst.get c with
+    | GRef (ConstructRef cstr,_) ->
       PatCstr (cstr,List.map (cases_pattern_of_glob_constr Anonymous) l,na)
+    | _ -> raise Not_found
+    end
+  | GLetIn (Name id as na',b,None,e) when is_gvar id e && na = Anonymous ->
+     (* A canonical encoding of aliases *)
+     DAst.get (cases_pattern_of_glob_constr na' b)
   | _ -> raise Not_found
   )
 
@@ -469,7 +500,7 @@ let drop_local_defs typi args =
       | [], [] -> []
       | Rel.Declaration.LocalDef _ :: decls, pat :: args ->
          begin
-           match pat.CAst.v with
+           match DAst.get pat with
            | PatVar Anonymous -> aux decls args
            | _ -> raise Not_found (* The pattern is used, one cannot drop it *)
          end
@@ -487,24 +518,36 @@ let add_patterns_for_params_remove_local_defs (ind,j) l =
       let typi = mip.mind_nf_lc.(j-1) in
       let (_,typi) = decompose_prod_n_assum (Rel.length mib.mind_params_ctxt) typi in
       drop_local_defs typi l in
-  Util.List.addn nparams (CAst.make @@ PatVar Anonymous) l
+  Util.List.addn nparams (DAst.make @@ PatVar Anonymous) l
+
+let add_alias ?loc na c =
+  match na with
+  | Anonymous -> c
+  | Name id -> GLetIn (na,DAst.make ?loc c,None,DAst.make ?loc (GVar id))
 
 (* Turn a closed cases pattern into a glob_constr *)
-let rec glob_constr_of_closed_cases_pattern_aux x = CAst.map_with_loc (fun ?loc -> function
-  | PatCstr (cstr,[],Anonymous) -> GRef (ConstructRef cstr,None)
-  | PatCstr (cstr,l,Anonymous)  ->
-      let ref = CAst.make ?loc @@ GRef (ConstructRef cstr,None) in
+let rec glob_constr_of_cases_pattern_aux isclosed x = DAst.map_with_loc (fun ?loc -> function
+  | PatCstr (cstr,[],na) -> add_alias ?loc na (GRef (ConstructRef cstr,None))
+  | PatCstr (cstr,l,na)  ->
+      let ref = DAst.make ?loc @@ GRef (ConstructRef cstr,None) in
       let l = add_patterns_for_params_remove_local_defs cstr l in
-      GApp (ref, List.map glob_constr_of_closed_cases_pattern_aux l)
+      add_alias ?loc na (GApp (ref, List.map (glob_constr_of_cases_pattern_aux isclosed) l))
+  | PatVar (Name id) when not isclosed ->
+      GVar id
+  | PatVar Anonymous when not isclosed ->
+      GHole (Evar_kinds.QuestionMark (Define false,Anonymous),Misctypes.IntroAnonymous,None)
   | _ -> raise Not_found
   ) x
 
-let glob_constr_of_closed_cases_pattern = function
-  | { CAst.loc ; v = PatCstr (cstr,l,na) } ->
-      na,glob_constr_of_closed_cases_pattern_aux (CAst.make ?loc @@ PatCstr (cstr,l,Anonymous))
+let glob_constr_of_closed_cases_pattern p = match DAst.get p with
+  | PatCstr (cstr,l,na) ->
+      let loc = p.CAst.loc in
+      na,glob_constr_of_cases_pattern_aux true (DAst.make ?loc @@ PatCstr (cstr,l,Anonymous))
   | _ ->
       raise Not_found
 
+let glob_constr_of_cases_pattern p = glob_constr_of_cases_pattern_aux false p
+
 (**********************************************************************)
 (* Interpreting ltac variables *)
 
@@ -517,7 +560,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
-          user_err (str"Ltac variable"++spc()++ pr_id id ++
+          user_err (str"Ltac variable"++spc()++ Id.print id ++
                            spc()++str"is not bound to an identifier."++spc()++
                            str"It cannot be used in a binder.")
         else n
diff --git a/pretyping/glob_ops.mli b/pretyping/glob_ops.mli
index bd9e111f5..0d9fb1f45 100644
--- a/pretyping/glob_ops.mli
+++ b/pretyping/glob_ops.mli
@@ -11,21 +11,25 @@ open Glob_term
 
 (** Equalities *)
 
-val cases_pattern_eq : cases_pattern -> cases_pattern -> bool
+val cases_pattern_eq : 'a cases_pattern_g -> 'a cases_pattern_g -> bool
+
+val alias_of_pat : 'a cases_pattern_g -> Name.t
+
+val set_pat_alias : Id.t -> 'a cases_pattern_g -> 'a cases_pattern_g
 
 val cast_type_eq : ('a -> 'a -> bool) ->
   'a Misctypes.cast_type -> 'a Misctypes.cast_type -> bool
 
-val glob_constr_eq : glob_constr -> glob_constr -> bool
+val glob_constr_eq : 'a glob_constr_g -> 'a glob_constr_g -> bool
 
 (** Operations on [glob_constr] *)
 
-val cases_pattern_loc : cases_pattern -> Loc.t option
+val cases_pattern_loc : 'a cases_pattern_g -> Loc.t option
 
-val cases_predicate_names : tomatch_tuples -> Name.t list
+val cases_predicate_names : 'a tomatch_tuples_g -> Name.t list
 
 (** Apply one argument to a glob_constr *)
-val mkGApp : ?loc:Loc.t -> glob_constr -> glob_constr -> glob_constr
+val mkGApp : ?loc:Loc.t -> 'a glob_constr_g -> 'a glob_constr_g -> 'a glob_constr_g
 
 val map_glob_constr :
   (glob_constr -> glob_constr) -> glob_constr -> glob_constr
@@ -42,12 +46,12 @@ val mk_glob_constr_eq : (glob_constr -> glob_constr -> bool) ->
 val fold_glob_constr : ('a -> glob_constr -> 'a) -> 'a -> glob_constr -> 'a
 val fold_glob_constr_with_binders : (Id.t -> 'a -> 'a) -> ('a -> 'b -> glob_constr -> 'b) -> 'a -> 'b -> glob_constr -> 'b
 val iter_glob_constr : (glob_constr -> unit) -> glob_constr -> unit
-val occur_glob_constr : Id.t -> glob_constr -> bool
-val free_glob_vars : glob_constr -> Id.t list
+val occur_glob_constr : Id.t -> 'a glob_constr_g -> bool
+val free_glob_vars : 'a glob_constr_g -> Id.Set.t
 val bound_glob_vars : glob_constr -> Id.Set.t
 (* Obsolete *)
-val loc_of_glob_constr : glob_constr -> Loc.t option
-val glob_visible_short_qualid : glob_constr -> Id.t list
+val loc_of_glob_constr : 'a glob_constr_g -> Loc.t option
+val glob_visible_short_qualid : 'a glob_constr_g -> Id.Set.t
 
 (* Renaming free variables using a renaming map; fails with
    [UnsoundRenaming] if applying the renaming would introduce
@@ -57,14 +61,14 @@ val glob_visible_short_qualid : glob_constr -> Id.t list
 
 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
+val rename_glob_vars : (Id.t * Id.t) list -> 'a glob_constr_g -> 'a glob_constr_g
 
 (** [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
     interpret Ltac-bound names both in pretyping and printing of
     terms. *)
-val map_pattern_binders : (name -> name) ->
+val map_pattern_binders : (Name.t -> Name.t) ->
   tomatch_tuples -> cases_clauses -> (tomatch_tuples*cases_clauses)
 
 (** [map_pattern f m c] applies [f] to the return predicate and the
@@ -78,11 +82,15 @@ val map_pattern : (glob_constr -> glob_constr) ->
 
     Take the current alias as parameter,
     @raise Not_found if translation is impossible *)
-val cases_pattern_of_glob_constr : Name.t -> glob_constr -> cases_pattern
+val cases_pattern_of_glob_constr : Name.t -> 'a glob_constr_g -> 'a cases_pattern_g
+
+val glob_constr_of_closed_cases_pattern : 'a cases_pattern_g -> Name.t * 'a glob_constr_g
 
-val glob_constr_of_closed_cases_pattern : cases_pattern -> Name.t * glob_constr
+(** A canonical encoding of cases pattern into constr such that
+    composed with [cases_pattern_of_glob_constr Anonymous] gives identity *)
+val glob_constr_of_cases_pattern : 'a cases_pattern_g -> 'a glob_constr_g
 
-val add_patterns_for_params_remove_local_defs : constructor -> cases_pattern list -> cases_pattern list
+val add_patterns_for_params_remove_local_defs : constructor -> 'a cases_pattern_g list -> 'a cases_pattern_g list
 
-val ltac_interp_name : Glob_term.ltac_var_map -> Names.name -> Names.name
-val empty_lvar : Glob_term.ltac_var_map
+val ltac_interp_name : Ltac_pretype.ltac_var_map -> Name.t -> Name.t
+val empty_lvar : Ltac_pretype.ltac_var_map
diff --git a/pretyping/indrec.ml b/pretyping/indrec.ml
index aced42f83..b7b5b1662 100644
--- a/pretyping/indrec.ml
+++ b/pretyping/indrec.ml
@@ -18,6 +18,7 @@ open Libnames
 open Globnames
 open Nameops
 open Term
+open Constr
 open Vars
 open Namegen
 open Declarations
@@ -33,7 +34,7 @@ type dep_flag = bool
 
 (* Errors related to recursors building *)
 type recursion_scheme_error =
-  | NotAllowedCaseAnalysis of (*isrec:*) bool * sorts * pinductive
+  | NotAllowedCaseAnalysis of (*isrec:*) bool * Sorts.t * pinductive
   | NotMutualInScheme of inductive * inductive
   | NotAllowedDependentAnalysis of (*isrec:*) bool * inductive
 
@@ -168,7 +169,7 @@ let type_rec_branch is_rec dep env sigma (vargs,depPvect,decP) tyi cs recargs =
       let p',largs = whd_allnolet_stack env sigma (EConstr.of_constr p) in
       let p' = EConstr.Unsafe.to_constr p' in
       let largs = List.map EConstr.Unsafe.to_constr largs in
-      match kind_of_term p' with
+      match kind p' with
 	| Prod (n,t,c) ->
 	    let d = LocalAssum (n,t) in
 	    make_prod env (n,t,prec (push_rel d env) (i+1) (d::sign) c)
@@ -186,13 +187,13 @@ let type_rec_branch is_rec dep env sigma (vargs,depPvect,decP) tyi cs recargs =
       	| _ ->
 	   let t' = whd_all env sigma (EConstr.of_constr p) in
 	   let t' = EConstr.Unsafe.to_constr t' in
-	   if Term.eq_constr p' t' then assert false
+	   if Constr.equal p' t' then assert false
 	   else prec env i sign t'
     in
     prec env 0 []
   in
   let rec process_constr env i c recargs nhyps li =
-    if nhyps > 0 then match kind_of_term c with
+    if nhyps > 0 then match kind c with
       | Prod (n,t,c_0) ->
           let (optionpos,rest) =
 	    match recargs with
@@ -247,7 +248,7 @@ let make_rec_branch_arg env sigma (nparrec,fvect,decF) f cstr recargs =
       let p',largs = whd_allnolet_stack env sigma (EConstr.of_constr p) in
       let p' = EConstr.Unsafe.to_constr p' in
       let largs = List.map EConstr.Unsafe.to_constr largs in
-      match kind_of_term p' with
+      match kind p' with
 	| Prod (n,t,c) ->
 	    let d = LocalAssum (n,t) in
 	    mkLambda_name env (n,t,prec (push_rel d env) (i+1) (d::hyps) c)
@@ -261,7 +262,7 @@ let make_rec_branch_arg env sigma (nparrec,fvect,decF) f cstr recargs =
      	| _ ->
 	   let t' = whd_all env sigma (EConstr.of_constr p) in
 	   let t' = EConstr.Unsafe.to_constr t' in
-	     if Term.eq_constr t' p' then assert false
+	     if Constr.equal t' p' then assert false
 	     else prec env i hyps t'
     in
     prec env 0 []
@@ -505,7 +506,7 @@ let build_case_analysis_scheme_default env sigma pity kind =
    [rec] by [s] *)
 
 let change_sort_arity sort =
-  let rec drec a = match kind_of_term a with
+  let rec drec a = match kind a with
     | Cast (c,_,_) -> drec c
     | Prod (n,t,c) -> let s, c' = drec c in s, mkProd (n, t, c')
     | LetIn (n,b,t,c) -> let s, c' = drec c in s, mkLetIn (n,b,t,c')
@@ -519,7 +520,7 @@ let change_sort_arity sort =
 let weaken_sort_scheme env evd set sort npars term ty =
   let evdref = ref evd in
   let rec drec np elim =
-    match kind_of_term elim with
+    match kind elim with
       | Prod (n,t,c) ->
 	  if Int.equal np 0 then
             let osort, t' = change_sort_arity sort t in
@@ -566,7 +567,7 @@ let build_mutual_induction_scheme env sigma = function
     	(List.map
 	   (function ((mind',u'),dep',s') ->
 	      let (sp',_) = mind' in
-	      if eq_mind sp sp' then
+	      if MutInd.equal sp sp' then
                 let (mibi',mipi') = lookup_mind_specif env mind' in
 		((mind',u'),mibi',mipi',dep',s')
 	      else
@@ -605,7 +606,7 @@ let lookup_eliminator ind_sp s =
   (* Try first to get an eliminator defined in the same section as the *)
   (* inductive type *)
   try
-    let cst =Global.constant_of_delta_kn (make_kn mp dp (Label.of_id id)) in
+    let cst =Global.constant_of_delta_kn (KerName.make mp dp (Label.of_id id)) in
     let _ = Global.lookup_constant cst in
       ConstRef cst
   with Not_found ->
@@ -615,7 +616,7 @@ let lookup_eliminator ind_sp s =
   with Not_found ->
     user_err ~hdr:"default_elim"
       (strbrk "Cannot find the elimination combinator " ++
-       pr_id id ++ strbrk ", the elimination of the inductive definition " ++
+       Id.print id ++ strbrk ", the elimination of the inductive definition " ++
        pr_global_env Id.Set.empty (IndRef ind_sp) ++
        strbrk " on sort " ++ Termops.pr_sort_family s ++
        strbrk " is probably not allowed.")
diff --git a/pretyping/indrec.mli b/pretyping/indrec.mli
index 2825c4d83..a9838cffe 100644
--- a/pretyping/indrec.mli
+++ b/pretyping/indrec.mli
@@ -7,14 +7,14 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
 open Evd
 
 (** Errors related to recursors building *)
 
 type recursion_scheme_error =
-  | NotAllowedCaseAnalysis of (*isrec:*) bool * sorts * pinductive
+  | NotAllowedCaseAnalysis of (*isrec:*) bool * Sorts.t * pinductive
   | NotMutualInScheme of inductive * inductive
   | NotAllowedDependentAnalysis of (*isrec:*) bool * inductive
 
@@ -27,25 +27,25 @@ type dep_flag = bool
 (** Build a case analysis elimination scheme in some sort family *)
 
 val build_case_analysis_scheme : env -> Evd.evar_map -> pinductive ->
-      dep_flag -> sorts_family -> evar_map * Constr.t
+      dep_flag -> Sorts.family -> evar_map * Constr.t
 
 (** 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 -> evar_map -> pinductive ->
-      sorts_family -> evar_map * Constr.t
+      Sorts.family -> evar_map * Constr.t
 
 (** Builds a recursive induction scheme (Peano-induction style) in the same
    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
+      dep_flag -> Sorts.family -> evar_map * constr
 
 (** Builds mutual (recursive) induction schemes *)
 
 val build_mutual_induction_scheme :
-  env -> evar_map -> (pinductive * dep_flag * sorts_family) list -> evar_map * constr list
+  env -> evar_map -> (pinductive * dep_flag * Sorts.family) list -> evar_map * constr list
 
 (** Scheme combinators *)
 
@@ -54,13 +54,13 @@ val build_mutual_induction_scheme :
    scheme quantified on sort [s]. [set] asks for [s] be declared equal to [i],
   otherwise just less or equal to [i]. *)
 
-val weaken_sort_scheme : env -> evar_map -> bool -> sorts -> int -> constr -> types -> 
+val weaken_sort_scheme : env -> evar_map -> bool -> Sorts.t -> int -> constr -> types ->
   evar_map * types * constr
 
 (** Recursor names utilities *)
 
-val lookup_eliminator : inductive -> sorts_family -> Globnames.global_reference
-val elimination_suffix : sorts_family -> string
-val make_elimination_ident : Id.t -> sorts_family -> Id.t
+val lookup_eliminator : inductive -> Sorts.family -> Globnames.global_reference
+val elimination_suffix : Sorts.family -> string
+val make_elimination_ident : Id.t -> Sorts.family -> Id.t
 
 val case_suffix : string
diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml
index 88ca9b5ca..275a079d5 100644
--- a/pretyping/inductiveops.ml
+++ b/pretyping/inductiveops.ml
@@ -11,6 +11,7 @@ open Util
 open Names
 open Univ
 open Term
+open Constr
 open Vars
 open Termops
 open Declarations
@@ -83,7 +84,7 @@ let mis_is_recursive_subset listind rarg =
     List.exists
       (fun ra ->
         match dest_recarg ra with
-	  | Mrec (_,i) -> Int.List.mem i listind
+          | Mrec (_,i) -> Int.List.mem i listind
           | _ -> false) rvec
   in
   Array.exists one_is_rec (dest_subterms rarg)
@@ -274,7 +275,7 @@ 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
+  | Some (Some _) -> mib.mind_finite == BiFinite
   | _ -> true
 
 (* Annotation for cases *)
@@ -360,20 +361,20 @@ let make_case_or_project env sigma indf ci pred c branches =
        if (* dependent *) not (Vars.noccurn sigma 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))
+                    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 sigma (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, Vars.substl subst b :: subst))
-	 ctx (0, [])
+          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, Vars.substl subst b :: subst))
+         ctx (0, [])
      in Vars.substl subst br
 
 (* substitution in a signature *)
@@ -397,8 +398,8 @@ let get_arity env ((ind,u),params) =
       mib.mind_params_ctxt
     else begin
       assert (Int.equal nparams mib.mind_nparams_rec);
-      let nnonrecparamdecls = List.length mib.mind_params_ctxt - mib.mind_nparams_rec in
-      snd (List.chop nnonrecparamdecls mib.mind_params_ctxt)
+      let nnonrecparamdecls = mib.mind_nparams - mib.mind_nparams_rec in
+      snd (Termops.context_chop nnonrecparamdecls mib.mind_params_ctxt)
     end in
   let parsign = Vars.subst_instance_context u parsign in
   let arproperlength = List.length mip.mind_arity_ctxt - List.length parsign in
@@ -485,7 +486,7 @@ let find_inductive env sigma c =
   let (t, l) = decompose_app sigma (whd_all env sigma c) in
   match EConstr.kind sigma t with
     | Ind ind
-        when (fst (Inductive.lookup_mind_specif env (fst ind))).mind_finite <> Decl_kinds.CoFinite ->
+        when (fst (Inductive.lookup_mind_specif env (fst ind))).mind_finite <> CoFinite ->
         let l = List.map EConstr.Unsafe.to_constr l in
         (ind, l)
     | _ -> raise Not_found
@@ -495,7 +496,7 @@ let find_coinductive env sigma c =
   let (t, l) = decompose_app sigma (whd_all env sigma c) in
   match EConstr.kind sigma t with
     | Ind ind
-        when (fst (Inductive.lookup_mind_specif env (fst ind))).mind_finite == Decl_kinds.CoFinite ->
+        when (fst (Inductive.lookup_mind_specif env (fst ind))).mind_finite == CoFinite ->
         let l = List.map EConstr.Unsafe.to_constr l in
         (ind, l)
     | _ -> raise Not_found
@@ -510,25 +511,25 @@ let is_predicate_explicitly_dep env sigma pred arsign =
     let pv' = whd_all env sigma pval in
     match EConstr.kind sigma pv', arsign with
       | Lambda (na,t,b), (LocalAssum _)::arsign ->
-	  srec (push_rel_assum (na, t) env) b arsign
+          srec (push_rel_assum (na, t) env) b arsign
       | Lambda (na,_,t), _ ->
 
        (* The following code has an impact on the introduction names
-	  given by the tactics "case" and "inversion": when the
-	  elimination is not dependent, "case" uses Anonymous for
-	  inductive types in Prop and names created by mkProd_name for
-	  inductive types in Set/Type while "inversion" uses anonymous
-	  for inductive types both in Prop and Set/Type !!
-
-	  Previously, whether names were created or not relied on
-	  whether the predicate created in Indrec.make_case_com had a
-	  dependent arity or not. To avoid different predicates
-	  printed the same in v8, all predicates built in indrec.ml
-	  got a dependent arity (Aug 2004). The new way to decide
-	  whether names have to be created or not is to use an
-	  Anonymous or Named variable to enforce the expected
-	  dependency status (of course, Anonymous implies non
-	  dependent, but not conversely).
+          given by the tactics "case" and "inversion": when the
+          elimination is not dependent, "case" uses Anonymous for
+          inductive types in Prop and names created by mkProd_name for
+          inductive types in Set/Type while "inversion" uses anonymous
+          for inductive types both in Prop and Set/Type !!
+
+          Previously, whether names were created or not relied on
+          whether the predicate created in Indrec.make_case_com had a
+          dependent arity or not. To avoid different predicates
+          printed the same in v8, all predicates built in indrec.ml
+          got a dependent arity (Aug 2004). The new way to decide
+          whether names have to be created or not is to use an
+          Anonymous or Named variable to enforce the expected
+          dependency status (of course, Anonymous implies non
+          dependent, but not conversely).
 
           From Coq > 8.2, using or not the the effective dependency of
           the predicate is parametrable! *)
@@ -599,15 +600,15 @@ let rec instantiate_universes env evdref scl is = function
       let ctx,_ = Reduction.dest_arity env ty in
       let u = Univ.Universe.make l in
       let s =
-	(* Does the sort of parameter [u] appear in (or equal)
+        (* Does the sort of parameter [u] appear in (or equal)
            the sort of inductive [is] ? *)
         if univ_level_mem l is then
           scl (* constrained sort: replace by scl *)
         else
           (* unconstrained sort: replace by fresh universe *)
           let evm, s = Evd.new_sort_variable Evd.univ_flexible !evdref in
-	  let evm = Evd.set_leq_sort env evm s (Sorts.sort_of_univ u) in
-	    evdref := evm; s
+          let evm = Evd.set_leq_sort env evm s (Sorts.sort_of_univ u) in
+            evdref := evm; s
       in
       (LocalAssum (na,mkArity(ctx,s))) :: instantiate_universes env evdref scl is (sign, exp)
   | sign, [] -> sign (* Uniform parameters are exhausted *)
@@ -643,7 +644,7 @@ let type_of_projection_knowing_arg env sigma p c ty =
    syntactic conditions *)
 
 let control_only_guard env c =
-  let check_fix_cofix e c = match kind_of_term c with
+  let check_fix_cofix e c = match kind c with
     | CoFix (_,(_,_,_) as cofix) ->
       Inductive.check_cofix e cofix
     | Fix (_,(_,_,_) as fix) ->
@@ -655,93 +656,3 @@ let control_only_guard env c =
     iter_constr_with_full_binders push_rel iter env c
   in
   iter env c
-
-(* inference of subtyping condition for inductive types *)
-
-let infer_inductive_subtyping_arity_constructor
-    (env, evd, csts) (subst : constr -> constr) (arcn : Term.types) is_arity (params : Context.Rel.t) =
-  let numchecked = ref 0 in
-  let numparams = Context.Rel.nhyps params in
-  let update_contexts (env, evd, csts) csts' =
-    (Environ.add_constraints csts' env, Evd.add_constraints evd csts', Univ.Constraint.union csts csts')
-  in
-  let basic_check (env, evd, csts) tp =
-    let result =
-      if !numchecked >= numparams then
-        let csts' =
-          Reduction.infer_conv_leq ~evars:(Evd.existential_opt_value evd) env (Evd.universes evd) tp (subst tp)
-        in update_contexts (env, evd, csts) csts'
-      else
-        (env, evd, csts)
-    in
-    numchecked := !numchecked + 1; result
-  in
-  let infer_typ typ ctxs =
-   match typ with
-     | LocalAssum (_, typ') ->
-       begin
-         try
-           let (env, evd, csts) = basic_check ctxs typ' in (Environ.push_rel typ env, evd, csts)
-         with Reduction.NotConvertible -> 
-           anomaly ~label:"inference of record/inductive subtyping relation failed"
-             (Pp.str "Can't infer subtyping for record/inductive type")
-       end
-     | _ -> anomaly (Pp.str "")
-  in
-  let arcn' = Term.it_mkProd_or_LetIn arcn params in
-  let typs, codom = Reduction.dest_prod env arcn' in
-  let last_contexts = Context.Rel.fold_outside infer_typ typs ~init:(env, evd, csts) in
-  if not is_arity then basic_check last_contexts codom else last_contexts
-
-let infer_inductive_subtyping env evd mind_ent =
-  let { Entries.mind_entry_params = params;
-        Entries.mind_entry_inds = entries;
-        Entries.mind_entry_universes = ground_univs;
-      } = mind_ent
-  in
-  let uinfind =
-    match ground_univs with
-    | Entries.Monomorphic_ind_entry _
-    | Entries.Polymorphic_ind_entry _ -> ground_univs
-    | Entries.Cumulative_ind_entry cumi -> 
-      begin
-        let uctx = Univ.CumulativityInfo.univ_context cumi in
-        let sbsubst = Univ.CumulativityInfo.subtyping_susbst cumi in
-        let dosubst = subst_univs_level_constr sbsubst in
-        let instance_other = 
-          Univ.subst_univs_level_instance sbsubst (Univ.UContext.instance uctx) 
-        in
-        let constraints_other = 
-          Univ.subst_univs_level_constraints
-            sbsubst (Univ.UContext.constraints uctx) 
-        in
-        let uctx_other = Univ.UContext.make (instance_other, constraints_other) in
-        let env = Environ.push_context uctx env in
-        let env = Environ.push_context uctx_other env in
-        let evd = 
-          Evd.merge_universe_context
-            evd (UState.of_context_set (Univ.ContextSet.of_context uctx_other)) 
-        in
-        let (_, _, subtyp_constraints) =
-          List.fold_left
-            (fun ctxs indentry ->
-               let _, params = Typeops.infer_local_decls env params in
-               let ctxs' = infer_inductive_subtyping_arity_constructor
-                   ctxs dosubst indentry.Entries.mind_entry_arity true params
-               in
-               List.fold_left
-                 (fun ctxs cons ->
-                    infer_inductive_subtyping_arity_constructor
-                      ctxs dosubst cons false params
-                 )
-                 ctxs' indentry.Entries.mind_entry_lc
-            ) (env, evd, Univ.Constraint.empty) entries
-        in 
-        Entries.Cumulative_ind_entry
-          (Univ.CumulativityInfo.make 
-             (Univ.CumulativityInfo.univ_context cumi,
-              Univ.UContext.make
-                (Univ.UContext.instance (Univ.CumulativityInfo.subtyp_context cumi),
-                 subtyp_constraints)))
-      end
-  in {mind_ent with Entries.mind_entry_universes = uinfind;}
diff --git a/pretyping/inductiveops.mli b/pretyping/inductiveops.mli
index aa38d3b47..55149552a 100644
--- a/pretyping/inductiveops.mli
+++ b/pretyping/inductiveops.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Declarations
 open Environ
 open Evd
@@ -28,8 +28,8 @@ val arities_of_constructors : env -> pinductive -> types array
     reasoning either with only recursively uniform parameters or with all
     parameters including the recursively non-uniform ones *)
 type inductive_family
-val make_ind_family : inductive puniverses * constr list -> inductive_family
-val dest_ind_family : inductive_family -> inductive puniverses * constr list
+val make_ind_family : inductive Univ.puniverses * constr list -> inductive_family
+val dest_ind_family : inductive_family -> inductive Univ.puniverses * constr list
 val map_ind_family : (constr -> constr) -> inductive_family -> inductive_family
 val liftn_inductive_family : int -> int -> inductive_family -> inductive_family
 val lift_inductive_family  : int -> inductive_family -> inductive_family
@@ -120,7 +120,7 @@ val constructor_nrealdecls_env : env -> constructor -> int
 val constructor_has_local_defs : constructor -> bool
 val inductive_has_local_defs : inductive -> bool
 
-val allowed_sorts : env -> inductive -> sorts_family list
+val allowed_sorts : env -> inductive -> Sorts.family list
 
 (** (Co)Inductive records with primitive projections do not have eta-conversion,
     hence no dependent elimination. *)
@@ -147,17 +147,17 @@ val get_constructor :
   pinductive * mutual_inductive_body * one_inductive_body * constr list ->
   int -> constructor_summary
 val get_constructors : env -> inductive_family -> constructor_summary array
-val get_projections  : env -> inductive_family -> constant array option
+val get_projections  : env -> inductive_family -> Constant.t array option
 
 (** [get_arity] returns the arity of the inductive family instantiated
     with the parameters; if recursively non-uniform parameters are not
     part of the inductive family, they appears in the arity *)
-val get_arity        : env -> inductive_family -> Context.Rel.t * sorts_family
+val get_arity        : env -> inductive_family -> Context.Rel.t * Sorts.family
 
 val build_dependent_constructor : constructor_summary -> constr
 val build_dependent_inductive   : env -> inductive_family -> constr
 val make_arity_signature : env -> evar_map -> bool -> inductive_family -> EConstr.rel_context
-val make_arity : env -> evar_map -> bool -> inductive_family -> sorts -> EConstr.types
+val make_arity : env -> evar_map -> bool -> inductive_family -> Sorts.t -> EConstr.types
 val build_branch_type : env -> evar_map -> bool -> constr -> constructor_summary -> types
 
 (** Raise [Not_found] if not given a valid inductive type *)
@@ -172,7 +172,7 @@ val find_coinductive : env -> evar_map -> EConstr.types -> (inductive * EConstr.
 
 (** Builds the case predicate arity (dependent or not) *)
 val arity_of_case_predicate :
-  env -> inductive_family -> bool -> sorts -> types
+  env -> inductive_family -> bool -> Sorts.t -> types
 
 val type_case_branches_with_names :
   env -> evar_map -> pinductive * EConstr.constr list -> constr -> constr -> types array * types
@@ -195,16 +195,7 @@ i*)
 (********************)
 
 val type_of_inductive_knowing_conclusion :
-  env -> evar_map -> Inductive.mind_specif puniverses -> EConstr.types -> evar_map * EConstr.types
+  env -> evar_map -> Inductive.mind_specif Univ.puniverses -> EConstr.types -> evar_map * EConstr.types
 
 (********************)
 val control_only_guard : env -> types -> unit
-
-(* inference of subtyping condition for inductive types *)
-(* for debugging purposes only to be removed *)
-val infer_inductive_subtyping_arity_constructor : Environ.env * Evd.evar_map * Univ.Constraint.t ->
-(Term.constr -> Term.constr) ->
-Term.types -> bool -> Context.Rel.t -> Environ.env * Evd.evar_map * Univ.Constraint.t
-
-val infer_inductive_subtyping : Environ.env -> Evd.evar_map -> Entries.mutual_inductive_entry ->
-  Entries.mutual_inductive_entry
diff --git a/pretyping/inferCumulativity.ml b/pretyping/inferCumulativity.ml
new file mode 100644
index 000000000..a4097237f
--- /dev/null
+++ b/pretyping/inferCumulativity.ml
@@ -0,0 +1,208 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Reduction
+open Declarations
+open Constr
+open Univ
+open Util
+
+(** Throughout this module we modify a map [variances] from local
+   universes to [Variance.t]. It starts as a trivial mapping to
+   [Irrelevant] and every time we encounter a local universe we
+   restrict it accordingly. *)
+
+let infer_level_eq u variances =
+  if LMap.mem u variances
+  then LMap.set u Variance.Invariant variances
+  else variances
+
+let infer_level_leq u variances =
+  match LMap.find u variances with
+  | exception Not_found -> variances
+  | varu -> LMap.set u (Variance.sup varu Variance.Covariant) variances
+
+let infer_generic_instance_eq variances u =
+  Array.fold_left (fun variances u -> infer_level_eq u variances)
+    variances (Instance.to_array u)
+
+let variance_pb cv_pb var =
+  let open Variance in
+  match cv_pb, var with
+  | _, Irrelevant -> Irrelevant
+  | _, Invariant -> Invariant
+  | CONV, Covariant -> Invariant
+  | CUMUL, Covariant -> Covariant
+
+let infer_cumulative_ind_instance cv_pb cumi variances u =
+  Array.fold_left2 (fun variances varu u ->
+      match LMap.find u variances with
+      | exception Not_found -> variances
+      | varu' ->
+        LMap.set u (Variance.sup varu' (variance_pb cv_pb varu)) variances)
+    variances (ACumulativityInfo.variance cumi) (Instance.to_array u)
+
+let infer_inductive_instance cv_pb env variances ind nargs u =
+  let mind = Environ.lookup_mind (fst ind) env in
+  match mind.mind_universes with
+  | Monomorphic_ind _ -> assert (Instance.is_empty u); variances
+  | Polymorphic_ind _ -> infer_generic_instance_eq variances u
+  | Cumulative_ind cumi ->
+    if not (Int.equal (inductive_cumulativity_arguments (mind,snd ind)) nargs)
+    then infer_generic_instance_eq variances u
+    else infer_cumulative_ind_instance cv_pb cumi variances u
+
+let infer_constructor_instance_eq env variances ((mi,ind),ctor) nargs u =
+  let mind = Environ.lookup_mind mi env in
+  match mind.mind_universes with
+  | Monomorphic_ind _ -> assert (Instance.is_empty u); variances
+  | Polymorphic_ind _ -> infer_generic_instance_eq variances u
+  | Cumulative_ind cumi ->
+    if not (Int.equal (constructor_cumulativity_arguments (mind,ind,ctor)) nargs)
+    then infer_generic_instance_eq variances u
+    else infer_cumulative_ind_instance CONV cumi variances u
+
+let infer_sort cv_pb variances s =
+  match cv_pb with
+  | CONV ->
+    LSet.fold infer_level_eq (Universe.levels (Sorts.univ_of_sort s)) variances
+  | CUMUL ->
+    LSet.fold infer_level_leq (Universe.levels (Sorts.univ_of_sort s)) variances
+
+let infer_table_key infos variances c =
+  let open Names in
+  match c with
+  | ConstKey (_, u) ->
+    infer_generic_instance_eq variances u
+  | VarKey _ | RelKey _ -> variances
+
+let rec infer_fterm cv_pb infos variances hd stk =
+  Control.check_for_interrupt ();
+  let open CClosure in
+  let hd,stk = whd_stack infos hd stk in
+  match fterm_of hd with
+  | FAtom a ->
+    begin match kind a with
+      | Sort s -> infer_sort cv_pb variances s
+      | Meta _ -> infer_stack infos variances stk
+      | _ -> assert false
+    end
+  | FEvar ((_,args),e) ->
+    let variances = infer_stack infos variances stk in
+    infer_vect infos variances (Array.map (mk_clos e) args)
+  | FRel _ -> variances
+  | FFlex fl ->
+    let variances = infer_table_key infos variances fl in
+    infer_stack infos variances stk
+  | FProj (_,c) ->
+    let variances = infer_fterm CONV infos variances c [] in
+    infer_stack infos variances stk
+  | FLambda _ ->
+    let (_,ty,bd) = destFLambda mk_clos hd in
+    let variances = infer_fterm CONV infos variances ty [] in
+    infer_fterm CONV infos variances bd []
+  | FProd (_,dom,codom) ->
+    let variances = infer_fterm CONV infos variances dom [] in
+    infer_fterm cv_pb infos variances codom []
+  | FInd (ind, u) ->
+    let variances =
+      if Instance.is_empty u then variances
+      else
+        let nargs = stack_args_size stk in
+        infer_inductive_instance cv_pb (info_env infos) variances ind nargs u
+    in
+    infer_stack infos variances stk
+  | FConstruct (ctor,u) ->
+    let variances =
+      if Instance.is_empty u then variances
+      else
+        let nargs = stack_args_size stk in
+        infer_constructor_instance_eq (info_env infos) variances ctor nargs u
+    in
+    infer_stack infos variances stk
+  | FFix ((_,(_,tys,cl)),e) | FCoFix ((_,(_,tys,cl)),e) ->
+    let n = Array.length cl in
+    let variances = infer_vect infos variances (Array.map (mk_clos e) tys) in
+    let le = Esubst.subs_liftn n e in
+    let variances = infer_vect infos variances (Array.map (mk_clos le) cl) in
+    infer_stack infos variances stk
+
+  (* Removed by whnf *)
+  | FLOCKED | FCaseT _ | FCast _ | FLetIn _ | FApp _ | FLIFT _ | FCLOS _ -> assert false
+
+and infer_stack infos variances (stk:CClosure.stack) =
+  match stk with
+  | [] -> variances
+  | z :: stk ->
+    let open CClosure in
+    let variances = match z with
+      | Zapp v -> infer_vect infos variances v
+      | Zproj _ -> variances
+      | Zfix (fx,a) ->
+        let variances = infer_fterm CONV infos variances fx [] in
+        infer_stack infos variances a
+      | ZcaseT (ci,p,br,e) ->
+        let variances = infer_fterm CONV infos variances (mk_clos e p) [] in
+        infer_vect infos variances (Array.map (mk_clos e) br)
+      | Zshift _ -> variances
+      | Zupdate _ -> variances
+    in
+    infer_stack infos variances stk
+
+and infer_vect infos variances v =
+  Array.fold_left (fun variances c -> infer_fterm CONV infos variances c []) variances v
+
+let infer_term cv_pb env variances c =
+  let open CClosure in
+  let infos = create_clos_infos all env in
+  infer_fterm cv_pb infos variances (CClosure.inject c) []
+
+let infer_arity_constructor is_arity env variances arcn =
+  let infer_typ typ (env,variances) =
+    match typ with
+    | Context.Rel.Declaration.LocalAssum (_, typ') ->
+      (Environ.push_rel typ env, infer_term CUMUL env variances typ')
+    | Context.Rel.Declaration.LocalDef _ -> assert false
+  in
+  let typs, codom = Reduction.dest_prod env arcn in
+  let env, variances = Context.Rel.fold_outside infer_typ typs ~init:(env, variances) in
+  (* If we have Inductive foo@{i j} : ... -> Type@{i} := C : ... -> foo Type@{j}
+     i is irrelevant, j is invariant. *)
+  if not is_arity then infer_term CUMUL env variances codom else variances
+
+let infer_inductive env mie =
+  let open Entries in
+  let { mind_entry_params = params;
+        mind_entry_inds = entries; } = mie
+  in
+  let univs =
+    match mie.mind_entry_universes with
+    | Monomorphic_ind_entry _
+    | Polymorphic_ind_entry _ as univs -> univs
+    | Cumulative_ind_entry cumi ->
+      let uctx = CumulativityInfo.univ_context cumi in
+      let uarray = Instance.to_array @@ UContext.instance uctx in
+      let env = Environ.push_context uctx env in
+      let variances =
+        Array.fold_left (fun variances u -> LMap.add u Variance.Irrelevant variances)
+          LMap.empty uarray
+      in
+      let env, _ = Typeops.infer_local_decls env params in
+      let variances = List.fold_left (fun variances entry ->
+          let variances = infer_arity_constructor true
+              env variances entry.mind_entry_arity
+          in
+          List.fold_left (infer_arity_constructor false env)
+            variances entry.mind_entry_lc)
+          variances
+          entries
+      in
+      let variances = Array.map (fun u -> LMap.find u variances) uarray in
+      Cumulative_ind_entry (CumulativityInfo.make (uctx, variances))
+  in
+  { mie with mind_entry_universes = univs }
diff --git a/pretyping/inferCumulativity.mli b/pretyping/inferCumulativity.mli
new file mode 100644
index 000000000..a5037ea47
--- /dev/null
+++ b/pretyping/inferCumulativity.mli
@@ -0,0 +1,10 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+val infer_inductive : Environ.env -> Entries.mutual_inductive_entry ->
+  Entries.mutual_inductive_entry
diff --git a/pretyping/ltac_pretype.ml b/pretyping/ltac_pretype.ml
new file mode 100644
index 000000000..be8579c2e
--- /dev/null
+++ b/pretyping/ltac_pretype.ml
@@ -0,0 +1,68 @@
+open Names
+open Glob_term
+
+(** {5 Maps of pattern variables} *)
+
+(** Type [constr_under_binders] is for representing the term resulting
+    of a matching. Matching can return terms defined in a some context
+    of named binders; in the context, variable names are ordered by
+    (<) and referred to by index in the term Thanks to the canonical
+    ordering, a matching problem like
+
+    [match ... with [(fun x y => ?p,fun y x => ?p)] => [forall x y => p]]
+
+    will be accepted. Thanks to the reference by index, a matching
+    problem like
+
+    [match ... with [(fun x => ?p)] => [forall x => p]]
+
+    will work even if [x] is also the name of an existing goal
+    variable.
+
+    Note: we do not keep types in the signature. Besides simplicity,
+    the main reason is that it would force to close the signature over
+    binders that occur only in the types of effective binders but not
+    in the term itself (e.g. for a term [f x] with [f:A -> True] and
+    [x:A]).
+
+    On the opposite side, by not keeping the types, we loose
+    opportunity to propagate type informations which otherwise would
+    not be inferable, as e.g. when matching [forall x, x = 0] with
+    pattern [forall x, ?h = 0] and using the solution "x|-h:=x" in
+    expression [forall x, h = x] where nothing tells how the type of x
+    could be inferred. We also loose the ability of typing ltac
+    variables before calling the right-hand-side of ltac matching clauses. *)
+
+type constr_under_binders = Id.t list * EConstr.constr
+
+(** Types of substitutions with or w/o bound variables *)
+
+type patvar_map = EConstr.constr Id.Map.t
+type extended_patvar_map = constr_under_binders Id.Map.t
+
+(** A globalised term together with a closure representing the value
+    of its free variables. Intended for use when these variables are taken
+    from the Ltac environment. *)
+type closure = {
+  idents:Id.t Id.Map.t;
+  typed: constr_under_binders Id.Map.t ;
+  untyped:closed_glob_constr Id.Map.t }
+and closed_glob_constr = {
+  closure: closure;
+  term: glob_constr }
+
+(** Ltac variable maps *)
+type var_map = constr_under_binders Id.Map.t
+type uconstr_var_map = closed_glob_constr Id.Map.t
+type unbound_ltac_var_map = Geninterp.Val.t Id.Map.t
+
+type ltac_var_map = {
+  ltac_constrs : var_map;
+  (** Ltac variables bound to constrs *)
+  ltac_uconstrs : uconstr_var_map;
+  (** Ltac variables bound to untyped constrs *)
+  ltac_idents: Id.t Id.Map.t;
+  (** Ltac variables bound to identifiers *)
+  ltac_genargs : unbound_ltac_var_map;
+  (** Ltac variables bound to other kinds of arguments *)
+}
diff --git a/pretyping/miscops.ml b/pretyping/miscops.ml
index bc563b46d..f0cb8fd1f 100644
--- a/pretyping/miscops.ml
+++ b/pretyping/miscops.ml
@@ -30,7 +30,8 @@ let smartmap_cast_type f c =
 let glob_sort_eq g1 g2 = match g1, g2 with
 | GProp, GProp -> true
 | GSet, GSet -> true
-| GType l1, GType l2 -> List.equal (fun x y -> Names.Name.equal (snd x) (snd y)) l1 l2
+| GType l1, GType l2 ->
+   List.equal (Option.equal (fun (x,m) (y,n) -> Libnames.eq_reference x y && Int.equal m n)) l1 l2
 | _ -> false
 
 let intro_pattern_naming_eq nam1 nam2 = match nam1, nam2 with
diff --git a/pretyping/nativenorm.ml b/pretyping/nativenorm.ml
index 39c2ceeba..b41e15f5a 100644
--- a/pretyping/nativenorm.ml
+++ b/pretyping/nativenorm.ml
@@ -5,13 +5,12 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-open Pp
 open CErrors
 open Term
+open Constr
 open Vars
 open Environ
 open Reduction
-open Univ
 open Declarations
 open Names
 open Inductive
@@ -20,8 +19,6 @@ 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
@@ -92,7 +89,7 @@ let invert_tag cst tag reloc_tbl =
 let decompose_prod env t =
   let (name,dom,codom as res) = destProd (whd_all env t) in
   match name with
-  | Anonymous -> (Name (id_of_string "x"),dom,codom)
+  | Anonymous -> (Name (Id.of_string "x"),dom,codom)
   | _ -> res
 
 let app_type env c =
@@ -102,7 +99,7 @@ let app_type env c =
  
 let find_rectype_a env c =
   let (t, l) = app_type env c in
-  match kind_of_term t with
+  match kind t with
   | Ind ind -> (ind, l)
   | _ -> raise Not_found
 
@@ -135,7 +132,7 @@ let construct_of_constr_notnative const env tag (mind, _ as ind) u allargs =
 
 let construct_of_constr const env tag typ =
   let t, l = app_type env typ in
-  match kind_of_term t with
+  match kind t with
   | Ind (ind,u) -> 
       construct_of_constr_notnative const env tag ind u l
   | _ -> assert false
@@ -177,44 +174,6 @@ let build_case_type dep p realargs c =
   if dep then mkApp(mkApp(p, realargs), [|c|])
   else mkApp(p, realargs)
 
-(* TODO move this function *)
-let type_of_rel env n =
-  env |> lookup_rel n |> RelDecl.get_type |> lift n
-
-let type_of_prop = mkSort type1_sort
-
-let type_of_sort s = 
-  match s with
-  | Prop _ -> type_of_prop
-  | Type u -> mkType (Univ.super u)
-
-let type_of_var env id =
-  let open Context.Named.Declaration in
-  try env |> lookup_named id |> get_type
-  with Not_found ->
-    anomaly ~label:"type_of_var" (str "variable " ++ Id.print id ++ str " unbound.")
-
-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 (sup u1 type0_univ)
-    (* Product rule (Prop,Type_i,Type_i) *)
-    | (Prop Pos,  Type u2)  -> Type (sup type0_univ u2)
-    (* Product rule (Prop,Type_i,Type_i) *)
-    | (Prop Null, Type _)  -> rangsort
-    (* Product rule (Type_i,Type_i,Type_i) *)
-    | (Type u1, Type u2) -> Type (sup u1 u2)
-
 (* normalisation of values *)
 
 let branch_of_switch lvl ans bs = 
@@ -265,7 +224,7 @@ and nf_accu env sigma accu =
   if Int.equal (accu_nargs accu) 0 then nf_atom env sigma atom
   else
     let a,typ = nf_atom_type env sigma atom in
-    let _, args = nf_args env sigma accu typ in
+    let _, args = nf_args env sigma (args_of_accu accu) typ in
     mkApp(a,Array.of_list args)
 
 and nf_accu_type env sigma accu =
@@ -273,10 +232,10 @@ and nf_accu_type env sigma accu =
   if Int.equal (accu_nargs accu) 0 then nf_atom_type env sigma atom
   else
     let a,typ = nf_atom_type env sigma atom in
-    let t, args = nf_args env sigma accu typ in
+    let t, args = nf_args env sigma (args_of_accu accu) typ in
     mkApp(a,Array.of_list args), t
 
-and nf_args env sigma accu t =
+and nf_args env sigma args t =
   let aux arg (t,l) = 
     let _,dom,codom =
       try decompose_prod env t with
@@ -287,7 +246,7 @@ and nf_args env sigma accu t =
     let c = nf_val env sigma arg dom in
     (subst1 c codom, c::l)
   in
-  let t,l = List.fold_right aux (args_of_accu accu) (t,[]) in
+  let t,l = Array.fold_right aux args (t,[]) in
   t, List.rev l
 
 and nf_bargs env sigma b t =
@@ -318,7 +277,6 @@ and nf_atom env sigma atom =
       let codom = nf_type env sigma (codom vn) in
       mkProd(n,dom,codom)
   | Ameta (mv,_) -> mkMeta mv
-  | Aevar (ev,_) -> mkEvar ev
   | Aproj(p,c) ->
       let c = nf_accu env sigma c in
 	mkProj(Projection.make p true,c)
@@ -328,15 +286,15 @@ and nf_atom_type env sigma atom =
   match atom with
   | Arel i ->
       let n = (nb_rel env - i) in
-      mkRel n, type_of_rel env n
+      mkRel n, Typeops.type_of_relative env n
   | Aconstant cst ->
       mkConstU cst, Typeops.type_of_constant_in env cst
   | Aind ind ->
       mkIndU ind, Inductiveops.type_of_inductive env ind
   | Asort s ->
-      mkSort s, type_of_sort s
+      mkSort s, Typeops.type_of_sort s
   | Avar id ->
-      mkVar id, type_of_var env id
+      mkVar id, Typeops.type_of_variable env id
   | Acase(ans,accu,p,bs) ->
       let a,ta = nf_accu_type env sigma accu in
       let ((mind,_),u as ind),allargs = find_rectype_a env ta in
@@ -363,7 +321,7 @@ and nf_atom_type env sigma atom =
       mkCase(ci, p, a, branchs), tcase 
   | Afix(tt,ft,rp,s) ->
       let tt = Array.map (fun t -> nf_type env sigma t) tt in
-      let name = Array.map (fun _ -> (Name (id_of_string "Ffix"))) tt in
+      let name = Array.map (fun _ -> (Name (Id.of_string "Ffix"))) tt in
       let lvl = nb_rel env in
       let nbfix = Array.length ft in
       let fargs = mk_rels_accu lvl (Array.length ft) in
@@ -376,7 +334,7 @@ and nf_atom_type env sigma atom =
       mkFix((rp,s),(name,tt,ft)), tt.(s)
   | Acofix(tt,ft,s,_) | Acofixe(tt,ft,s,_) ->
       let tt = Array.map (nf_type env sigma) tt in
-      let name = Array.map (fun _ -> (Name (id_of_string "Fcofix"))) tt in
+      let name = Array.map (fun _ -> (Name (Id.of_string "Fcofix"))) tt in
       let lvl = nb_rel env in
       let fargs = mk_rels_accu lvl (Array.length ft) in
       let env = push_rec_types (name,tt,[||]) env in
@@ -387,10 +345,10 @@ and nf_atom_type env sigma atom =
       let vn = mk_rel_accu (nb_rel env) in
       let env = push_rel (LocalAssum (n,dom)) env in
       let codom,s2 = nf_type_sort env sigma (codom vn) in
-      mkProd(n,dom,codom), mkSort (sort_of_product env s1 s2)
-  | Aevar(ev,ty) ->
-     let ty = nf_type env sigma ty in
-     mkEvar ev, ty
+      mkProd(n,dom,codom), Typeops.type_of_product env n s1 s2
+  | Aevar(evk,ty,args) ->
+    let ty = nf_type env sigma ty in
+    nf_evar env sigma evk ty args
   | Ameta(mv,ty) ->
      let ty = nf_type env sigma ty in
      mkMeta mv, ty
@@ -402,7 +360,7 @@ and nf_atom_type env sigma atom =
 
 
 and  nf_predicate env sigma ind mip params v pT =
-  match kind_of_value v, kind_of_term pT with
+  match kind_of_value v, kind pT with
   | Vfun f, Prod _ ->
       let k = nb_rel env in
       let vb = f (mk_rel_accu k) in
@@ -418,7 +376,7 @@ and  nf_predicate env sigma ind mip params v pT =
   | Vfun f, _ -> 
       let k = nb_rel env in
       let vb = f (mk_rel_accu k) in
-      let name = Name (id_of_string "c") in
+      let name = Name (Id.of_string "c") in
       let n = mip.mind_nrealargs in
       let rargs = Array.init n (fun i -> mkRel (n-i)) in
       let params = if Int.equal n 0 then params else Array.map (lift n) params in
@@ -427,6 +385,19 @@ and  nf_predicate env sigma ind mip params v pT =
       true, mkLambda(name,dom,body)
   | _, _ -> false, nf_type env sigma v
 
+and nf_evar env sigma evk ty args =
+  let evi = try Evd.find sigma evk with Not_found -> assert false in
+  let hyps = Environ.named_context_of_val (Evd.evar_filtered_hyps evi) in
+  if List.is_empty hyps then begin
+    assert (Int.equal (Array.length args) 0);
+    mkEvar (evk, [||]), ty
+  end
+  else
+    let fold accu d = Term.mkNamedProd_or_LetIn d accu in
+    let t = List.fold_left fold ty hyps in
+    let ty, args = nf_args env sigma args t in
+    mkEvar (evk, Array.of_list args), ty
+
 let evars_of_evar_map sigma =
   { Nativelambda.evars_val = Evd.existential_opt_value sigma;
     Nativelambda.evars_typ = Evd.existential_type sigma;
@@ -477,11 +448,11 @@ let stop_profiler m_pid =
   match profiler_platform() with
     "Unix (Linux)" -> stop_profiler_linux m_pid
   | _ -> ()
-     
+
 let native_norm env sigma c ty =
   let c = EConstr.Unsafe.to_constr c in
   let ty = EConstr.Unsafe.to_constr ty in
-  if Coq_config.no_native_compiler then
+  if not Coq_config.native_compiler then
     user_err Pp.(str "Native_compute reduction has been disabled at configure time.")
   else
   let penv = Environ.pre_env env in
diff --git a/pretyping/patternops.ml b/pretyping/patternops.ml
index 5826cc135..1bec4a6f1 100644
--- a/pretyping/patternops.ml
+++ b/pretyping/patternops.ml
@@ -12,6 +12,7 @@ open Names
 open Globnames
 open Nameops
 open Term
+open Constr
 open Vars
 open Glob_term
 open Pp
@@ -58,7 +59,11 @@ let rec constr_pattern_eq p1 p2 = match p1, p2 with
   fixpoint_eq f1 f2
 | PCoFix f1, PCoFix f2 ->
   cofixpoint_eq f1 f2
-| _ -> false
+| PProj (p1, t1), PProj (p2, t2) ->
+   Projection.equal p1 p2 && constr_pattern_eq t1 t2
+| (PRef _ | PVar _ | PEvar _ | PRel _ | PApp _ | PSoApp _
+   | PLambda _ | PProd _ | PLetIn _ | PSort _ | PMeta _
+   | PIf _ | PCase _ | PFix _ | PCoFix _ | PProj _), _ -> false
 (** FIXME: fixpoint and cofixpoint should be relativized to pattern *)
 
 and pattern_eq (i1, j1, p1) (i2, j2, p2) =
@@ -75,8 +80,8 @@ and cofixpoint_eq (i1, r1) (i2, r2) =
 
 and rec_declaration_eq (n1, c1, r1) (n2, c2, r2) =
   Array.equal Name.equal n1 n2 &&
-  Array.equal Term.eq_constr c1 c2 &&
-  Array.equal Term.eq_constr r1 r2
+  Array.equal Constr.equal c1 c2 &&
+  Array.equal Constr.equal r1 r2
 
 let rec occur_meta_pattern = function
   | PApp (f,args) ->
@@ -96,6 +101,31 @@ let rec occur_meta_pattern = function
   | PMeta _ | PSoApp _ -> true
   | PEvar _ | PVar _ | PRef _ | PRel _ | PSort _ | PFix _ | PCoFix _ -> false
 
+let rec occurn_pattern n = function
+  | PRel p -> Int.equal n p
+  | PApp (f,args) ->
+      (occurn_pattern n f) || (Array.exists (occurn_pattern n) args)
+  | PProj (_,arg) -> occurn_pattern n arg
+  | PLambda (na,t,c)  -> (occurn_pattern n t) || (occurn_pattern (n+1) c)
+  | PProd (na,t,c)  -> (occurn_pattern n t) || (occurn_pattern (n+1) c)
+  | PLetIn (na,b,t,c)  ->
+     Option.fold_left (fun b t -> b || occurn_pattern n t) (occurn_pattern n b) t ||
+     (occurn_pattern (n+1) c)
+  | PIf (c,c1,c2)  ->
+      (occurn_pattern n c) ||
+      (occurn_pattern n c1) || (occurn_pattern n c2)
+  | PCase(_,p,c,br) ->
+      (occurn_pattern n p) ||
+      (occurn_pattern n c) ||
+      (List.exists (fun (_,_,p) -> occurn_pattern n p) br)
+  | PMeta _ | PSoApp _ -> true
+  | PEvar (_,args) -> Array.exists (occurn_pattern n) args
+  | PVar _ | PRef _ | PSort _ -> false
+  | PFix fix -> not (noccurn n (mkFix fix))
+  | PCoFix cofix -> not (noccurn n (mkCoFix cofix))
+
+let noccurn_pattern n c = not (occurn_pattern n c)
+
 exception BoundPattern;;
 
 let rec head_pattern_bound t =
@@ -107,8 +137,7 @@ let rec head_pattern_bound t =
     | PCase (_,p,c,br) -> head_pattern_bound c
     | PRef r         -> r
     | PVar id        -> VarRef id
-    | PProj (p,c)    -> ConstRef (Projection.constant p)
-    | PEvar _ | PRel _ | PMeta _ | PSoApp _  | PSort _ | PFix _
+    | PEvar _ | PRel _ | PMeta _ | PSoApp _  | PSort _ | PFix _ | PProj _
 	-> raise BoundPattern
     (* Perhaps they were arguments, but we don't beta-reduce *)
     | PLambda _ -> raise BoundPattern
@@ -124,7 +153,7 @@ let head_of_constr_reference sigma c = match EConstr.kind sigma c with
 let pattern_of_constr env sigma t =
   let rec pattern_of_constr env t =
   let open Context.Rel.Declaration in
-  match kind_of_term t with
+  match kind t with
     | Rel n  -> PRel n
     | Meta n -> PMeta (Some (Id.of_string ("META" ^ string_of_int n)))
     | Var id -> PVar id
@@ -140,7 +169,7 @@ let pattern_of_constr env sigma t =
 				  pattern_of_constr (push_rel (LocalAssum (na, c)) env) b)
     | App (f,a) ->
         (match
-          match kind_of_term f with
+          match kind f with
           | Evar (evk,args) ->
             (match snd (Evd.evar_source evk sigma) with
               Evar_kinds.MatchingVar (Evar_kinds.SecondOrderPatVar id) -> Some id
@@ -149,7 +178,7 @@ let pattern_of_constr env sigma t =
          with
          | Some n -> PSoApp (n,Array.to_list (Array.map (pattern_of_constr env) a))
          | None -> PApp (pattern_of_constr env f,Array.map (pattern_of_constr env) a))
-    | Const (sp,u)  -> PRef (ConstRef (constant_of_kn(canonical_con sp)))
+    | Const (sp,u)  -> PRef (ConstRef (Constant.make1 (Constant.canonical sp)))
     | Ind (sp,u)    -> PRef (canonical_gr (IndRef sp))
     | Construct (sp,u) -> PRef (canonical_gr (ConstructRef sp))
     | Proj (p, c) -> 
@@ -204,8 +233,8 @@ let error_instantiate_pattern id l =
   | [_] -> "is" 
   | _ -> "are"
   in
-  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
+  user_err  (str "Cannot substitute the term bound to " ++ Id.print id
+    ++ strbrk " in pattern because the term refers to " ++ pr_enum Id.print l
     ++ strbrk " which " ++ str is ++ strbrk " not bound in the pattern.")
 
 let instantiate_pattern env sigma lvar c =
@@ -326,7 +355,7 @@ 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 = CAst.with_loc_val (fun ?loc -> function
+let rec pat_of_raw metas vars = DAst.with_loc_val (fun ?loc -> function
   | GVar id ->
       (try PRel (List.index Name.equal (Name id) vars)
        with Not_found -> PVar id)
@@ -335,11 +364,14 @@ let rec pat_of_raw metas vars = CAst.with_loc_val (fun ?loc -> function
   | GRef (gr,_) ->
       PRef (canonical_gr gr)
   (* Hack to avoid rewriting a complete interpretation of patterns *)
-  | GApp ({ CAst.v = GPatVar (Evar_kinds.SecondOrderPatVar n) }, cl) ->
+  | GApp (c, cl) ->
+    begin match DAst.get c with
+    | GPatVar (Evar_kinds.SecondOrderPatVar n) ->
       metas := n::!metas; PSoApp (n, List.map (pat_of_raw metas vars) cl)
-  | GApp (c,cl) ->
+    | _ ->
       PApp (pat_of_raw metas vars c,
 	    Array.of_list (List.map (pat_of_raw metas vars) cl))
+    end
   | GLambda (na,bk,c1,c2) ->
       Name.iter (fun n -> metas := n::!metas) na;
       PLambda (na, pat_of_raw metas vars c1,
@@ -364,8 +396,8 @@ let rec pat_of_raw metas vars = CAst.with_loc_val (fun ?loc -> function
       PIf (pat_of_raw metas vars c,
            pat_of_raw metas vars b1,pat_of_raw metas vars b2)
   | GLetTuple (nal,(_,None),b,c) ->
-      let mkGLambda na c = CAst.make ?loc @@
-	GLambda (na,Explicit, CAst.make @@ GHole (Evar_kinds.InternalHole, IntroAnonymous, None),c) in
+      let mkGLambda na c = DAst.make ?loc @@
+	GLambda (na,Explicit, DAst.make @@ GHole (Evar_kinds.InternalHole, IntroAnonymous, None),c) in
       let c = List.fold_right mkGLambda nal c in
       let cip =
 	{ cip_style = LetStyle;
@@ -377,8 +409,12 @@ let rec pat_of_raw metas vars = CAst.with_loc_val (fun ?loc -> function
       PCase (cip, PMeta None, pat_of_raw metas vars b,
              [0,tags,pat_of_raw metas vars c])
   | GCases (sty,p,[c,(na,indnames)],brs) ->
+      let get_ind p = match DAst.get p with 
+      | PatCstr((ind,_),_,_) -> Some ind
+      | _ -> None
+      in
       let get_ind = function
-	| (_,(_,[{ CAst.v = PatCstr((ind,_),_,_) }],_))::_ -> Some ind
+	| (_,(_,[p],_))::_ -> get_ind p
 	| _ -> None
       in
       let ind_tags,ind = match indnames with
@@ -391,8 +427,11 @@ let rec pat_of_raw metas vars = CAst.with_loc_val (fun ?loc -> function
 	| Some p, Some (_,(_,nal)) ->
           let nvars = na :: List.rev nal @ vars in
           rev_it_mkPLambda nal (mkPLambda na (pat_of_raw metas nvars p))
-        | (None | Some { CAst.v = GHole _}), _ -> PMeta None
+        | None, _ -> PMeta None
 	| Some p, None ->
+          match DAst.get p with
+          | GHole _ -> PMeta None
+          | _ ->
             user_err ?loc  (strbrk "Clause \"in\" expected in patterns over \"match\" expressions with an explicit \"return\" clause.")
       in
       let info =
@@ -406,34 +445,43 @@ let rec pat_of_raw metas vars = CAst.with_loc_val (fun ?loc -> function
 	 one non-trivial branch. These facts are used in [Constrextern]. *)
       PCase (info, pred, pat_of_raw metas vars c, brs)
 
-  | r -> err ?loc (Pp.str "Non supported pattern.")
-  )
+  | GProj(p,c) ->
+    PProj(p, pat_of_raw metas vars c)
+
+  | GPatVar _ | GIf _ | GLetTuple _ | GCases _ | GEvar _ | GRec _ ->
+      err ?loc (Pp.str "Non supported pattern."))
 
 and pats_of_glob_branches loc metas vars ind brs =
-  let get_arg = function
-    | { CAst.v = PatVar na } ->
+  let get_arg p = match DAst.get p with
+    | PatVar na ->
       Name.iter (fun n -> metas := n::!metas) na;
       na
-    | { CAst.v = PatCstr(_,_,_) ; loc } -> err ?loc (Pp.str "Non supported pattern.")
+    | PatCstr(_,_,_) -> err ?loc:p.CAst.loc (Pp.str "Non supported pattern.")
   in
   let rec get_pat indexes = function
     | [] -> false, []
-    | [(_,(_,[{ CAst.v = PatVar Anonymous }], { CAst.v = GHole _}))] -> true, [] (* ends with _ => _ *)
-    | (_,(_,[{ CAst.v = PatCstr((indsp,j),lv,_) }],br)) :: brs ->
-      let () = match ind with
-      | Some sp when eq_ind sp indsp -> ()
+    | (loc',(_,[p], br)) :: brs ->
+      begin match DAst.get p, DAst.get br, brs with
+      | PatVar Anonymous, GHole _, [] ->
+        true, [] (* ends with _ => _ *)
+      | PatCstr((indsp,j),lv,_), _, _ ->
+        let () = match ind with
+        | Some sp when eq_ind sp indsp -> ()
+        | _ ->
+          err ?loc (Pp.str "All constructors must be in the same inductive type.")
+        in
+        if Int.Set.mem (j-1) indexes then
+          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
+        let pat = rev_it_mkPLambda lna (pat_of_raw metas vars' br) in
+        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)
       | _ ->
-        err ?loc (Pp.str "All constructors must be in the same inductive type.")
-      in
-      if Int.Set.mem (j-1) indexes then
-	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
-      let pat = rev_it_mkPLambda lna (pat_of_raw metas vars' br) in
-      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)
+        err ?loc:loc' (Pp.str "Non supported pattern.")
+      end
     | (loc,(_,_,_)) :: _ -> err ?loc (Pp.str "Non supported pattern.")
   in
   get_pat Int.Set.empty brs
diff --git a/pretyping/patternops.mli b/pretyping/patternops.mli
index 3a1faf1c7..2d1ce1dbc 100644
--- a/pretyping/patternops.mli
+++ b/pretyping/patternops.mli
@@ -12,6 +12,7 @@ open Glob_term
 open Mod_subst
 open Misctypes
 open Pattern
+open Ltac_pretype
 
 (** {5 Functions on patterns} *)
 
@@ -21,6 +22,8 @@ val occur_meta_pattern : constr_pattern -> bool
 
 val subst_pattern : substitution -> constr_pattern -> constr_pattern
 
+val noccurn_pattern : int -> constr_pattern -> bool
+
 exception BoundPattern
 
 (** [head_pattern_bound t] extracts the head variable/constant of the
diff --git a/pretyping/pretype_errors.ml b/pretyping/pretype_errors.ml
index 54b477bed..7149d62a1 100644
--- a/pretyping/pretype_errors.ml
+++ b/pretyping/pretype_errors.ml
@@ -7,20 +7,19 @@
 (************************************************************************)
 
 open Names
-open Term
 open Environ
 open EConstr
 open Type_errors
 
 type unification_error =
-  | OccurCheck of existential_key * constr
+  | OccurCheck of Evar.t * constr
   | NotClean of existential * env * constr (* Constr is a variable not in scope *)
   | NotSameArgSize
   | NotSameHead
   | NoCanonicalStructure
   | ConversionFailed of env * constr * constr (* Non convertible closed terms *)
-  | MetaOccurInBody of existential_key
-  | InstanceNotSameType of existential_key * env * types * types
+  | MetaOccurInBody of Evar.t
+  | InstanceNotSameType of Evar.t * env * types * types
   | UnifUnivInconsistency of Univ.univ_inconsistency
   | CannotSolveConstraint of Evd.evar_constraint * unification_error
   | ProblemBeyondCapabilities
@@ -39,8 +38,8 @@ type pretype_error =
   (* Type inference unification *)
   | ActualTypeNotCoercible of unsafe_judgment * types * unification_error
   (* Tactic unification *)
-  | UnifOccurCheck of existential_key * constr
-  | UnsolvableImplicit of existential_key * Evd.unsolvability_explanation option
+  | UnifOccurCheck of Evar.t * constr
+  | UnsolvableImplicit of Evar.t * Evd.unsolvability_explanation option
   | CannotUnify of constr * constr * unification_error option
   | CannotUnifyLocal of constr * constr * constr
   | CannotUnifyBindingType of constr * constr
@@ -57,7 +56,7 @@ type pretype_error =
   | TypingError of type_error
   | CannotUnifyOccurrences of subterm_unification_error
   | UnsatisfiableConstraints of
-    (existential_key * Evar_kinds.t) option * Evar.Set.t option
+    (Evar.t * Evar_kinds.t) option * Evar.Set.t option
 
 exception PretypeError of env * Evd.evar_map * pretype_error
 
diff --git a/pretyping/pretype_errors.mli b/pretyping/pretype_errors.mli
index 124fa6e06..430755ea0 100644
--- a/pretyping/pretype_errors.mli
+++ b/pretyping/pretype_errors.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
 open EConstr
 open Type_errors
@@ -15,14 +15,14 @@ open Type_errors
 (** {6 The type of errors raised by the pretyper } *)
 
 type unification_error =
-  | OccurCheck of existential_key * constr
+  | OccurCheck of Evar.t * constr
   | NotClean of existential * env * constr
   | NotSameArgSize
   | NotSameHead
   | NoCanonicalStructure
   | ConversionFailed of env * constr * constr
-  | MetaOccurInBody of existential_key
-  | InstanceNotSameType of existential_key * env * types * types
+  | MetaOccurInBody of Evar.t
+  | InstanceNotSameType of Evar.t * env * types * types
   | UnifUnivInconsistency of Univ.univ_inconsistency
   | CannotSolveConstraint of Evd.evar_constraint * unification_error
   | ProblemBeyondCapabilities
@@ -41,8 +41,8 @@ type pretype_error =
   (** Type inference unification *)
   | ActualTypeNotCoercible of unsafe_judgment * types * unification_error
   (** Tactic Unification *)
-  | UnifOccurCheck of existential_key * constr
-  | UnsolvableImplicit of existential_key * Evd.unsolvability_explanation option
+  | UnifOccurCheck of Evar.t * constr
+  | UnsolvableImplicit of Evar.t * Evd.unsolvability_explanation option
   | CannotUnify of constr * constr * unification_error option
   | CannotUnifyLocal of constr * constr * constr
   | CannotUnifyBindingType of constr * constr
@@ -59,7 +59,7 @@ type pretype_error =
   | TypingError of type_error
   | CannotUnifyOccurrences of subterm_unification_error
   | UnsatisfiableConstraints of
-    (existential_key * Evar_kinds.t) option * Evar.Set.t option
+    (Evar.t * Evar_kinds.t) option * Evar.Set.t option
     (** unresolvable evar, connex component *)
 
 exception PretypeError of env * Evd.evar_map * pretype_error
@@ -99,8 +99,8 @@ val error_ill_typed_rec_body :
 
 val error_elim_arity :
   ?loc:Loc.t -> env -> Evd.evar_map ->
-      pinductive -> sorts_family list -> constr ->
-      unsafe_judgment -> (sorts_family * sorts_family * arity_error) option -> 'b
+      pinductive -> Sorts.family list -> constr ->
+      unsafe_judgment -> (Sorts.family * Sorts.family * arity_error) option -> 'b
 
 val error_not_a_type :
   ?loc:Loc.t -> env -> Evd.evar_map -> unsafe_judgment -> 'b
@@ -112,10 +112,10 @@ val error_cannot_coerce : env -> Evd.evar_map -> constr * constr -> 'b
 
 (** {6 Implicit arguments synthesis errors } *)
 
-val error_occur_check : env -> Evd.evar_map -> existential_key -> constr -> 'b
+val error_occur_check : env -> Evd.evar_map -> Evar.t -> constr -> 'b
 
 val error_unsolvable_implicit :
-  ?loc:Loc.t -> env -> Evd.evar_map -> existential_key ->
+  ?loc:Loc.t -> env -> Evd.evar_map -> Evar.t ->
       Evd.unsolvability_explanation option -> 'b
 
 val error_cannot_unify : ?loc:Loc.t -> env -> Evd.evar_map ->
@@ -154,7 +154,7 @@ val error_var_not_found : ?loc:Loc.t -> Id.t -> 'b
 
 (** {6 Typeclass errors } *)
 
-val unsatisfiable_constraints : env -> Evd.evar_map -> Evd.evar option ->
+val unsatisfiable_constraints : env -> Evd.evar_map -> Evar.t option ->
   Evar.Set.t option -> 'a
 
 val unsatisfiable_exception : exn -> bool
diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index 40b8bcad9..6700748eb 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -43,6 +43,7 @@ open Glob_term
 open Glob_ops
 open Evarconv
 open Misctypes
+open Ltac_pretype
 
 module NamedDecl = Context.Named.Declaration
 
@@ -69,7 +70,7 @@ let get_extra env sigma =
   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 (fun d acc -> push_rel_decl_to_named_context sigma d acc)
-    (rel_context env) ~init:(empty_csubst, [], avoid, named_context env)
+    (rel_context env) ~init:(empty_csubst, avoid, named_context env)
 
 let make_env env sigma = { env = env; extra = lazy (get_extra env sigma) }
 let rel_context env = rel_context env.env
@@ -89,12 +90,11 @@ let push_rel_context sigma ctx env = {
 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 (subst, _, nc) = Lazy.force env.extra in
+  let typ' = csubst_subst subst typ in
   let instance = inst_rels @ inst_vars in
   let sign = val_of_named_context nc in
   let sigma = !evdref in
@@ -176,65 +176,79 @@ let _ =
 	    optwrite = (:=) Universes.set_minimization })
 
 (** Miscellaneous interpretation functions *)
-let interp_universe_level_name ~anon_rigidity evd (loc, s) =
-  match s with
-  | Anonymous ->
-     new_univ_level_variable ?loc anon_rigidity evd
-  | Name s ->
-     let s = Id.to_string s in
-     let names, _ = Global.global_universe_names () in
-     if CString.string_contains ~where:s ~what:"." then
-       match List.rev (CString.split '.' s) with
-       | [] -> anomaly (str"Invalid universe name " ++ str s ++ str".")
-       | n :: dp ->
-	  let num = int_of_string n in
-	  let dp = DirPath.make (List.map Id.of_string dp) in
-	  let level = Univ.Level.make dp num in
-	  let evd =
-	    try Evd.add_global_univ evd level
-	    with UGraph.AlreadyDeclared -> evd
-	  in evd, level
-     else
-       try
-	 let level = Evd.universe_of_name evd s in
-	 evd, level
-       with Not_found ->
-	 try
-	   let id = try Id.of_string s with _ -> raise Not_found in
-           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 ~hdr:"interp_universe_level_name"
-		  (Pp.(str "Undeclared universe: " ++ str s))
+
+let interp_known_universe_level evd r =
+  let loc, qid = Libnames.qualid_of_reference r in
+  try
+    match r with
+    | Libnames.Ident (loc, id) -> Evd.universe_of_name evd id
+    | Libnames.Qualid _ -> raise Not_found
+  with Not_found ->
+    let univ, k = Nametab.locate_universe qid in
+    Univ.Level.make univ k
+
+let interp_universe_level_name ~anon_rigidity evd r =
+  try evd, interp_known_universe_level evd r
+  with Not_found ->
+    match r with (* Qualified generated name *)
+    | Libnames.Qualid (loc, qid) ->
+       let dp, i = Libnames.repr_qualid qid in
+       let num =
+         try int_of_string (Id.to_string i)
+         with Failure _ ->
+           user_err ?loc ~hdr:"interp_universe_level_name"
+                    (Pp.(str "Undeclared global universe: " ++ Libnames.pr_reference r))
+       in
+       let level = Univ.Level.make dp num in
+       let evd =
+         try Evd.add_global_univ evd level
+         with UGraph.AlreadyDeclared -> evd
+       in evd, level
+    | Libnames.Ident (loc, id) -> (* Undeclared *)
+        if not (is_strict_universe_declarations ()) then
+          new_univ_level_variable ?loc ~name:id univ_rigid evd
+        else user_err ?loc ~hdr:"interp_universe_level_name"
+                      (Pp.(str "Undeclared universe: " ++ Id.print id))
 
 let interp_universe ?loc evd = function
   | [] -> let evd, l = new_univ_level_variable ?loc univ_rigid evd in
 	    evd, Univ.Universe.make l
   | l ->
-    List.fold_left (fun (evd, u) l -> 
-        (* [univ_flexible_alg] can produce algebraic universes in terms *)
-        let evd', l = interp_universe_level_name ~anon_rigidity:univ_flexible evd l in
-	(evd', Univ.sup u (Univ.Universe.make l)))
+    List.fold_left (fun (evd, u) l ->
+      let evd', u' =
+        match l with
+        | Some (l,n) ->
+           (* [univ_flexible_alg] can produce algebraic universes in terms *)
+           let anon_rigidity = univ_flexible in
+           let evd', l = interp_universe_level_name ~anon_rigidity evd l in
+           let u' = Univ.Universe.make l in
+           (match n with
+            | 0 -> evd', u'
+            | 1 -> evd', Univ.Universe.super u'
+            | _ ->
+               user_err ?loc ~hdr:"interp_universe"
+                        (Pp.(str "Cannot interpret universe increment +" ++ int n)))
+        | None ->
+           let evd, l = new_univ_level_variable ?loc univ_flexible evd in
+           evd, Univ.Universe.make l
+      in (evd', Univ.sup u u'))
     (evd, Univ.Universe.type0m) l
 
-let interp_level_info ?loc evd : Misctypes.level_info -> _ = function
-  | None -> new_univ_level_variable ?loc univ_rigid evd
-  | Some (loc,s) -> interp_universe_level_name ~anon_rigidity:univ_flexible evd (Loc.tag ?loc s)
-
-let interp_sort ?loc evd = function
-  | GProp -> evd, Prop Null
-  | GSet -> evd, Prop Pos
-  | GType n -> 
-    let evd, u = interp_universe ?loc evd n in
-      evd, Type u
+let interp_known_level_info ?loc evd = function
+  | UUnknown | UAnonymous ->
+    user_err ?loc ~hdr:"interp_known_level_info"
+      (str "Anonymous universes not allowed here.")
+  | UNamed ref ->
+    try interp_known_universe_level evd ref
+    with Not_found ->
+      user_err ?loc ~hdr:"interp_known_level_info" (str "Undeclared universe " ++ Libnames.pr_reference ref)
 
-let interp_elimination_sort = function
-  | GProp -> InProp
-  | GSet  -> InSet
-  | GType _ -> InType
+let interp_level_info ?loc evd : Misctypes.level_info -> _ = function
+  | UUnknown -> new_univ_level_variable ?loc univ_rigid evd
+  | UAnonymous -> new_univ_level_variable ?loc univ_flexible evd
+  | UNamed s -> interp_universe_level_name ~anon_rigidity:univ_flexible evd s
 
-type inference_hook = env -> evar_map -> evar -> evar_map * constr
+type inference_hook = env -> evar_map -> Evar.t -> evar_map * constr
 
 type inference_flags = {
   use_typeclasses : bool;
@@ -364,10 +378,10 @@ let check_evars_are_solved env current_sigma init_sigma =
   let frozen = frozen_and_pending_holes (init_sigma, current_sigma) in
   check_evars_are_solved env current_sigma frozen
 
-let process_inference_flags flags env initial_sigma (sigma,c) =
+let process_inference_flags flags env initial_sigma (sigma,c,cty) =
   let sigma = solve_remaining_evars flags env sigma initial_sigma in
   let c = if flags.expand_evars then nf_evar sigma c else c in
-  sigma,c
+  sigma,c,cty
 
 let adjust_evar_source evdref na c =
   match na, kind !evdref c with
@@ -393,9 +407,9 @@ let check_instance loc subst = function
   | [] -> ()
   | (id,_) :: _ ->
       if List.mem_assoc id subst then
-        user_err ?loc  (pr_id id ++ str "appears more than once.")
+        user_err ?loc  (Id.print id ++ str "appears more than once.")
       else
-        user_err ?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: " ++ Id.print id ++ str ".")
 
 (* used to enforce a name in Lambda when the type constraints itself
    is named, hence possibly dependent *)
@@ -421,8 +435,8 @@ 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 ->
-    user_err  (str "Ltac variable " ++ pr_id id0 ++
-		       str " depends on pattern variable name " ++ pr_id id ++
+    user_err  (str "Ltac variable " ++ Id.print id0 ++
+		       str " depends on pattern variable name " ++ Id.print id ++
 		       str " which is not bound in current context.")
 
 let protected_get_type_of env sigma c =
@@ -465,7 +479,7 @@ let pretype_id pretype k0 loc env evdref lvar id =
       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 
-         (str "Variable " ++ pr_id id ++ str " should be bound to a term but is \
+         (str "Variable " ++ Id.print 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 *)
@@ -478,6 +492,11 @@ let pretype_id pretype k0 loc env evdref lvar id =
 (*************************************************************************)
 (* Main pretyping function                                               *)
 
+let interp_known_glob_level ?loc evd = function
+  | GProp -> Univ.Level.prop
+  | GSet -> Univ.Level.set
+  | GType s -> interp_known_level_info ?loc evd s
+
 let interp_glob_level ?loc evd : Misctypes.glob_level -> _ = function
   | GProp -> evd, Univ.Level.prop
   | GSet -> evd, Univ.Level.set
@@ -572,7 +591,7 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
   let pretype = pretype k0 resolve_tc in
   let open Context.Rel.Declaration in
   let loc = t.CAst.loc in
-  match t.CAst.v with
+  match DAst.get t with
   | GRef (ref,u) ->
       inh_conv_coerce_to_tycon ?loc env evdref
 	(pretype_ref ?loc evdref env ref u)
@@ -718,6 +737,11 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
     let j = pretype_sort ?loc evdref s in
       inh_conv_coerce_to_tycon ?loc env evdref j tycon
 
+  | GProj (p, c) ->
+    (* TODO: once GProj is used as an input syntax, use bidirectional typing here *)
+    let cj = pretype empty_tycon env evdref lvar c in
+    judge_of_projection env.ExtraEnv.env !evdref p cj
+
   | GApp (f,args) ->
     let fj = pretype empty_tycon env evdref lvar f in
     let floc = loc_of_glob_constr f in
@@ -899,6 +923,9 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
 	  | [], [] -> []
 	  | _ -> assert false
 	in aux 1 1 (List.rev nal) cs.cs_args, true in
+    let fsign = if Flags.version_strictly_greater Flags.V8_6 || Flags.version_less_or_equal Flags.VOld
+                then Context.Rel.map (whd_betaiota !evdref) fsign
+                else fsign (* beta-iota-normalization regression in 8.5 and 8.6 *) in
     let obj ind p v f =
       if not record then 
         let nal = List.map (fun na -> ltac_interp_name lvar na) nal in
@@ -1008,6 +1035,10 @@ let rec pretype k0 resolve_tc (tycon : type_constraint) (env : ExtraEnv.t) evdre
 	let pi = lift n pred in (* liftn n 2 pred ? *)
 	let pi = beta_applist !evdref (pi, [EConstr.of_constr (build_dependent_constructor cs)]) in
         let cs_args = List.map (fun d -> map_rel_decl EConstr.of_constr d) cs.cs_args in
+        let cs_args =
+          if Flags.version_strictly_greater Flags.V8_6 || Flags.version_less_or_equal Flags.VOld
+          then Context.Rel.map (whd_betaiota !evdref) cs_args
+          else cs_args (* beta-iota-normalization regression in 8.5 and 8.6 *) in
 	let csgn =
           List.map (set_name Anonymous) cs_args
         in
@@ -1093,24 +1124,16 @@ and pretype_instance k0 resolve_tc env evdref lvar loc hyps evk update =
       with Not_found ->
         user_err ?loc  (str "Cannot interpret " ++
           pr_existential_key !evdref evk ++
-          str " in current context: no binding for " ++ pr_id id ++ str ".") in
+          str " in current context: no binding for " ++ Id.print id ++ str ".") in
     ((id,c)::subst, update) in
   let subst,inst = List.fold_right f hyps ([],update) in
   check_instance loc subst inst;
   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 : ExtraEnv.t) evdref lvar = function
-  | { loc; CAst.v = GHole (knd, naming, None) } ->
-      let rec is_Type c = match EConstr.kind !evdref c with
-      | Sort s ->
-        begin match ESorts.kind !evdref s with
-        | Type _ -> true
-        | Prop _ -> false
-        end
-      | Cast (c, _, _) -> is_Type c
-      | _ -> false
-      in
+and pretype_type k0 resolve_tc valcon (env : ExtraEnv.t) evdref lvar c = match DAst.get c with
+  | GHole (knd, naming, None) ->
+      let loc = loc_of_glob_constr c in
       (match valcon with
        | Some v ->
            let s =
@@ -1118,7 +1141,7 @@ and pretype_type k0 resolve_tc valcon (env : ExtraEnv.t) evdref lvar = function
 	     let t = Retyping.get_type_of env.ExtraEnv.env sigma v in
 	       match EConstr.kind sigma (whd_all env.ExtraEnv.env sigma t) with
                | Sort s -> ESorts.kind sigma s
-               | Evar ev when is_Type (existential_type sigma ev) ->
+               | Evar ev when is_Type sigma (existential_type sigma 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
@@ -1134,7 +1157,7 @@ and pretype_type k0 resolve_tc valcon (env : ExtraEnv.t) evdref lvar = function
 	   let s = evd_comb0 (new_sort_variable univ_flexible_alg) evdref in
 	     { utj_val = e_new_evar env evdref ~src:(loc, knd) ~naming (mkSort s);
 	       utj_type = s})
-  | 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.ExtraEnv.env) evdref j in
@@ -1150,15 +1173,18 @@ let ise_pretype_gen flags env sigma lvar kind c =
   let env = make_env env sigma in
   let evdref = ref sigma in
   let k0 = Context.Rel.length (rel_context env) in
-  let c' = match kind with
+  let c', c'_ty = match kind with
     | WithoutTypeConstraint ->
-        (pretype k0 flags.use_typeclasses empty_tycon env evdref lvar c).uj_val
+        let j = pretype k0 flags.use_typeclasses empty_tycon env evdref lvar c in
+        j.uj_val, j.uj_type
     | OfType exptyp ->
-	(pretype k0 flags.use_typeclasses (mk_tycon exptyp) env evdref lvar c).uj_val
+        let j = pretype k0 flags.use_typeclasses (mk_tycon exptyp) env evdref lvar c in
+        j.uj_val, j.uj_type
     | IsType ->
-	(pretype_type k0 flags.use_typeclasses empty_valcon env evdref lvar c).utj_val 
+        let tj = pretype_type k0 flags.use_typeclasses empty_valcon env evdref lvar c in
+        tj.utj_val, mkSort tj.utj_type
   in
-  process_inference_flags flags env.ExtraEnv.env sigma (!evdref,c')
+  process_inference_flags flags env.ExtraEnv.env sigma (!evdref,c',c'_ty)
 
 let default_inference_flags fail = {
   use_typeclasses = true;
@@ -1178,7 +1204,7 @@ let all_and_fail_flags = default_inference_flags true
 let all_no_fail_flags = default_inference_flags false
 
 let ise_pretype_gen_ctx flags env sigma lvar kind c =
-  let evd, c = ise_pretype_gen flags env sigma lvar kind c in
+  let evd, c, _ = ise_pretype_gen flags env sigma lvar kind c in
   let evd, f = Evarutil.nf_evars_and_universes evd in
     f (EConstr.Unsafe.to_constr c), Evd.evar_universe_context evd
 
@@ -1190,12 +1216,15 @@ let understand
     env sigma c =
   ise_pretype_gen_ctx flags env sigma empty_lvar expected_type c
 
-let understand_tcc ?(flags=all_no_fail_flags) env sigma ?(expected_type=WithoutTypeConstraint) c =
-  let (sigma, c) = ise_pretype_gen flags env sigma empty_lvar expected_type c in
-  (sigma, c)
+let understand_tcc_ty ?(flags=all_no_fail_flags) env sigma ?(expected_type=WithoutTypeConstraint) c =
+  ise_pretype_gen flags env sigma empty_lvar expected_type c
+
+let understand_tcc ?flags env sigma ?expected_type c =
+  let sigma, c, _ = understand_tcc_ty ?flags env sigma ?expected_type c in
+  sigma, c
 
 let understand_ltac flags env sigma lvar kind c =
-  let (sigma, c) = ise_pretype_gen flags env sigma lvar kind c in
+  let (sigma, c, _) = ise_pretype_gen flags env sigma lvar kind c in
   (sigma, c)
 
 let pretype k0 resolve_tc typcon env evdref lvar t =
diff --git a/pretyping/pretyping.mli b/pretyping/pretyping.mli
index 7395e94a0..864768fe5 100644
--- a/pretyping/pretyping.mli
+++ b/pretyping/pretyping.mli
@@ -12,13 +12,16 @@
    into elementary ones, insertion of coercions and resolution of
    implicit arguments. *)
 
-open Term
+open Constr
 open Environ
 open Evd
 open EConstr
 open Glob_term
-open Evarutil
-open Misctypes
+open Ltac_pretype
+open Evardefine
+
+val interp_known_glob_level : ?loc:Loc.t -> Evd.evar_map ->
+  Misctypes.glob_level -> Univ.Level.t
 
 (** An auxiliary function for searching for fixpoint guard indexes *)
 
@@ -27,7 +30,7 @@ val search_guard :
 
 type typing_constraint = OfType of types | IsType | WithoutTypeConstraint
 
-type inference_hook = env -> evar_map -> evar -> evar_map * constr
+type inference_hook = env -> evar_map -> Evar.t -> evar_map * constr
 
 type inference_flags = {
   use_typeclasses : bool;
@@ -55,6 +58,11 @@ val all_and_fail_flags : inference_flags
 val understand_tcc : ?flags:inference_flags -> env -> evar_map ->
   ?expected_type:typing_constraint -> glob_constr -> evar_map * constr
 
+(** As [understand_tcc] but also returns the type of the elaborated term.
+    The [expand_evars] flag is not applied to the type (only to the term). *)
+val understand_tcc_ty : ?flags:inference_flags -> env -> evar_map ->
+  ?expected_type:typing_constraint -> glob_constr -> evar_map * constr * types
+
 (** More general entry point with evars from ltac *)
 
 (** Generic call to the interpreter from glob_constr to constr
@@ -113,15 +121,12 @@ val pretype_type :
 
 val ise_pretype_gen :
   inference_flags -> env -> evar_map ->
-  ltac_var_map -> typing_constraint -> glob_constr -> evar_map * constr
+  ltac_var_map -> typing_constraint -> glob_constr -> evar_map * constr * types
 
 (**/**)
 
 (** To embed constr in glob_constr *)
 
-val interp_sort : ?loc:Loc.t -> evar_map -> glob_sort -> evar_map * sorts
-val interp_elimination_sort : glob_sort -> sorts_family
-
 val register_constr_interp0 :
   ('r, 'g, 't) Genarg.genarg_type ->
     (unbound_ltac_var_map -> env -> evar_map -> types -> 'g -> constr * evar_map) -> unit
diff --git a/pretyping/pretyping.mllib b/pretyping/pretyping.mllib
index c8b3307d7..ae4ad0be7 100644
--- a/pretyping/pretyping.mllib
+++ b/pretyping/pretyping.mllib
@@ -1,7 +1,10 @@
+Geninterp
+Ltac_pretype
 Locusops
 Pretype_errors
 Reductionops
 Inductiveops
+InferCumulativity
 Vnorm
 Arguments_renaming
 Nativenorm
@@ -29,3 +32,4 @@ Indrec
 Cases
 Pretyping
 Unification
+Univdecls
diff --git a/pretyping/recordops.ml b/pretyping/recordops.ml
index a23579609..ab1f3cd32 100644
--- a/pretyping/recordops.ml
+++ b/pretyping/recordops.ml
@@ -19,7 +19,7 @@ open Pp
 open Names
 open Globnames
 open Nametab
-open Term
+open Constr
 open Libobject
 open Mod_subst
 open Reductionops
@@ -37,7 +37,7 @@ type struc_typ = {
   s_CONST : constructor;
   s_EXPECTEDPARAM : int;
   s_PROJKIND : (Name.t * bool) list;
-  s_PROJ : constant option list }
+  s_PROJ : Constant.t option list }
 
 let structure_table =
   Summary.ref (Indmap.empty : struc_typ Indmap.t) ~name:"record-structs"
@@ -48,7 +48,7 @@ let projection_table =
    is the inductive always (fst constructor) ? It seems so... *)
 
 type struc_tuple =
-    inductive * constructor * (Name.t * bool) list * constant option list
+    inductive * constructor * (Name.t * bool) list * Constant.t option list
 
 let load_structure i (_,(ind,id,kl,projs)) =
   let n = (fst (Global.lookup_inductive ind)).Declarations.mind_nparams in
@@ -144,7 +144,7 @@ type obj_typ = {
 type cs_pattern =
     Const_cs of global_reference
   | Prod_cs
-  | Sort_cs of sorts_family
+  | Sort_cs of Sorts.family
   | Default_cs
 
 let eq_cs_pattern p1 p2 = match p1, p2 with
@@ -171,8 +171,8 @@ let keep_true_projections projs kinds =
   let filter (p, (_, b)) = if b then Some p else None in
   List.map_filter filter (List.combine projs kinds)
 
-let cs_pattern_of_constr t =
-  match kind_of_term t with
+let cs_pattern_of_constr env t =
+  match kind t with
       App (f,vargs) ->
 	begin
 	  try Const_cs (global_of_constr f) , None, Array.to_list vargs
@@ -180,7 +180,11 @@ let cs_pattern_of_constr t =
 	end
     | Rel n -> Default_cs, Some n, []
     | Prod (_,a,b) when Vars.noccurn 1 b -> Prod_cs, None, [a; Vars.lift (-1) b]
-    | Sort s -> Sort_cs (family_of_sort s), None, []
+    | Proj (p, c) ->
+      let { Environ.uj_type = ty } = Typeops.infer env c in
+      let _, params = Inductive.find_rectype env ty in
+      Const_cs (ConstRef (Projection.constant p)), None, params @ [c]
+    | Sort s -> Sort_cs (Sorts.family s), None, []
     | _ ->
 	begin
 	  try Const_cs (global_of_constr t) , None, []
@@ -190,7 +194,6 @@ let cs_pattern_of_constr t =
 let warn_projection_no_head_constant =
   CWarnings.create ~name:"projection-no-head-constant" ~category:"typechecker"
          (fun (sign,env,t,con,proji_sp) ->
-          let sign = List.map (on_snd EConstr.Unsafe.to_constr) sign in
           let env = Termops.push_rels_assum sign env in
           let con_pp = Nametab.pr_global_env Id.Set.empty (ConstRef con) in
           let proji_sp_pp = Nametab.pr_global_env Id.Set.empty (ConstRef proji_sp) in
@@ -207,14 +210,16 @@ let compute_canonical_projections warn (con,ind) =
   let v = (mkConstU (con,u)) in
   let c = Environ.constant_value_in env (con,u) in
   let sign,t = Reductionops.splay_lam env Evd.empty (EConstr.of_constr c) in
+  let sign = List.map (on_snd EConstr.Unsafe.to_constr) sign in
   let t = EConstr.Unsafe.to_constr t in
-  let lt = List.rev_map (snd %> EConstr.Unsafe.to_constr) sign in
+  let lt = List.rev_map snd sign in
   let args = snd (decompose_app t) in
   let { s_EXPECTEDPARAM = p; s_PROJ = lpj; s_PROJKIND = kl } =
     lookup_structure ind in
   let params, projs = List.chop p args in
   let lpj = keep_true_projections lpj kl in
   let lps = List.combine lpj projs in
+  let nenv = Termops.push_rels_assum sign env in
   let comp =
     List.fold_left
       (fun l (spopt,t) -> (* comp=components *)
@@ -222,7 +227,7 @@ let compute_canonical_projections warn (con,ind) =
            | Some proji_sp ->
 	       begin
 		 try
-		   let patt, n , args = cs_pattern_of_constr t in
+		   let patt, n , args = cs_pattern_of_constr nenv t in
 		     ((ConstRef proji_sp, patt, t, n, args) :: l)
 		 with Not_found ->
                    if warn then warn_projection_no_head_constant (sign,env,t,con,proji_sp);
@@ -281,7 +286,7 @@ let subst_canonical_structure (subst,(cst,ind as obj)) =
 let discharge_canonical_structure (_,(cst,ind)) =
   Some (Lib.discharge_con cst,Lib.discharge_inductive ind)
 
-let inCanonStruc : constant * inductive -> obj =
+let inCanonStruc : Constant.t * inductive -> obj =
   declare_object {(default_object "CANONICAL-STRUCTURE") with
     open_function = open_canonical_structure;
     cache_function = cache_canonical_structure;
@@ -293,29 +298,40 @@ let add_canonical_structure x = Lib.add_anonymous_leaf (inCanonStruc x)
 
 (*s High-level declaration of a canonical structure *)
 
-let error_not_structure ref =
+let error_not_structure ref description =
   user_err ~hdr:"object_declare"
-    (Nameops.pr_id (basename_of_global ref) ++ str" is not a structure object.")
+    (str"Could not declare a canonical structure " ++
+       (Id.print (basename_of_global ref) ++ str"." ++ spc() ++
+          str(description)))
 
 let check_and_decompose_canonical_structure ref =
-  let sp = match ref with ConstRef sp -> sp | _ -> error_not_structure ref in
+  let sp =
+    match ref with
+      ConstRef sp -> sp
+    |  _ -> error_not_structure ref "Expected an instance of a record or structure."
+  in
   let env = Global.env () in
   let u = Univ.make_abstract_instance (Environ.constant_context env sp) in
   let vc = match Environ.constant_opt_value_in env (sp, u) with
     | Some vc -> vc
-    | None -> error_not_structure ref in
+    | None -> error_not_structure ref "Could not find its value in the global environment." in
   let body = snd (splay_lam (Global.env()) Evd.empty (EConstr.of_constr vc)) (** FIXME *) in
   let body = EConstr.Unsafe.to_constr body in
-  let f,args = match kind_of_term body with
+  let f,args = match kind body with
     | App (f,args) -> f,args
-    | _ -> error_not_structure ref in
-  let indsp = match kind_of_term f with
+    | _ ->
+       error_not_structure ref "Expected a record or structure constructor applied to arguments." in
+  let indsp = match kind f with
     | Construct ((indsp,1),u) -> indsp
-    | _ -> error_not_structure ref in
-  let s = try lookup_structure indsp with Not_found -> error_not_structure ref in
+    | _ -> error_not_structure ref "Expected an instance of a record or structure." in
+  let s =
+    try lookup_structure indsp
+    with Not_found ->
+      error_not_structure ref
+        ("Could not find the record or structure " ^ (MutInd.to_string (fst indsp))) in
   let ntrue_projs = List.count snd s.s_PROJKIND in
   if s.s_EXPECTEDPARAM + ntrue_projs > Array.length args then
-    error_not_structure ref;
+    error_not_structure ref "Got too few arguments to the record or structure constructor.";
   (sp,indsp)
 
 let declare_canonical_structure ref =
@@ -324,15 +340,25 @@ let declare_canonical_structure ref =
 let lookup_canonical_conversion (proj,pat) =
   assoc_pat pat (Refmap.find proj !object_table)
 
+let decompose_projection sigma c args =
+  match EConstr.kind sigma c with
+  | Const (c, u) ->
+     let n = find_projection_nparams (ConstRef c) in
+     (** Check if there is some canonical projection attached to this structure *)
+     let _ = Refmap.find (ConstRef c) !object_table in
+     let arg = Stack.nth args n in
+     arg
+  | Proj (p, c) ->
+     let _ = Refmap.find (ConstRef (Projection.constant p)) !object_table in
+     c
+  | _ -> raise Not_found
+
 let is_open_canonical_projection env sigma (c,args) =
   let open EConstr in
   try
-    let (ref, _) = Termops.global_of_constr sigma c in
-    let n = find_projection_nparams ref in
-    (** Check if there is some canonical projection attached to this structure *)
-    let _ = Refmap.find ref !object_table in
+    let arg = decompose_projection sigma c args in
     try
-      let arg = whd_all env sigma (Stack.nth args n) in
+      let arg = whd_all env sigma arg in
       let hd = match EConstr.kind sigma arg with App (hd, _) -> hd | _ -> arg in
       not (isConstruct sigma hd)
     with Failure _ -> false
diff --git a/pretyping/recordops.mli b/pretyping/recordops.mli
index 5480b14af..f15418577 100644
--- a/pretyping/recordops.mli
+++ b/pretyping/recordops.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Globnames
 
 (** Operations concerning records and canonical structures *)
@@ -20,10 +20,10 @@ type struc_typ = {
   s_CONST : constructor;
   s_EXPECTEDPARAM : int;
   s_PROJKIND : (Name.t * bool) list;
-  s_PROJ : constant option list }
+  s_PROJ : Constant.t option list }
 
 type struc_tuple =
-    inductive * constructor * (Name.t * bool) list * constant option list
+    inductive * constructor * (Name.t * bool) list * Constant.t option list
 
 val declare_structure : struc_tuple -> unit
 
@@ -35,7 +35,7 @@ val lookup_structure : inductive -> struc_typ
 (** [lookup_projections isp] returns the projections associated to the
    inductive path [isp] if it corresponds to a structure, otherwise
    it fails with [Not_found] *)
-val lookup_projections : inductive -> constant option list
+val lookup_projections : inductive -> Constant.t option list
 
 (** raise [Not_found] if not a projection *)
 val find_projection_nparams : global_reference -> int
@@ -52,7 +52,7 @@ val find_projection : global_reference -> struc_typ
 type cs_pattern =
     Const_cs of global_reference
   | Prod_cs
-  | Sort_cs of sorts_family
+  | Sort_cs of Sorts.family
   | Default_cs
 
 type obj_typ = {
@@ -65,7 +65,7 @@ type obj_typ = {
   o_TCOMPS : constr list } (** ordered *)
 
 (** Return the form of the component of a canonical structure *)
-val cs_pattern_of_constr : constr -> cs_pattern * int option * constr list
+val cs_pattern_of_constr : Environ.env -> constr -> cs_pattern * int option * constr list
 
 val pr_cs_pattern : cs_pattern -> Pp.t
 
diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index 356323543..418ea271c 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -9,7 +9,7 @@
 open CErrors
 open Util
 open Names
-open Term
+open Constr
 open Termops
 open Univ
 open Evd
@@ -121,10 +121,10 @@ module ReductionBehaviour = struct
     let r' = fst (subst_global subst r) in if r==r' then orig else (r',o)
 
   let discharge = function
-    | _,(ReqGlobal (ConstRef c, req), (_, b)) ->
+    | _,(ReqGlobal (ConstRef c as gr, req), (_, b)) ->
       let b =
-        if Lib.is_in_section (ConstRef c) then
-          let vars, _, _ = Lib.section_segment_of_constant c in
+        if Lib.is_in_section gr then
+          let vars = Lib.variable_section_segment_of_reference gr in
           let extra = List.length vars in
           let nargs' =
              if b.b_nargs = max_int then max_int
@@ -284,8 +284,6 @@ sig
   | Proj of int * int * projection * Cst_stack.t
   | Fix of ('a, 'a) pfixpoint * 'a t * Cst_stack.t
   | Cst of cst_member * int * int list * 'a t * Cst_stack.t
-  | Shift of int
-  | Update of 'a
   and 'a t = 'a member list
 
   exception IncompatibleFold2
@@ -296,12 +294,12 @@ sig
   val append_app : 'a array -> 'a t -> 'a t
   val decomp : 'a t -> ('a * 'a t) option
   val decomp_node_last : 'a app_node -> 'a t -> ('a * 'a t)
-  val equal : ('a * int -> 'a * int -> bool) -> (('a, 'a) pfixpoint * int -> ('a, 'a) pfixpoint * int -> bool)
-    -> 'a t -> 'a t -> (int * int) option
+  val equal : ('a -> 'a -> bool) -> (('a, 'a) pfixpoint -> ('a, 'a) pfixpoint -> bool)
+    -> 'a t -> 'a t -> bool
   val compare_shape : 'a t -> 'a t -> bool
   val map : ('a -> 'a) -> 'a t -> 'a t
   val fold2 : ('a -> constr -> constr -> 'a) -> 'a ->
-    constr t -> constr t -> 'a * int * int
+    constr t -> constr t -> 'a
   val append_app_list : 'a list -> 'a t -> 'a t
   val strip_app : 'a t -> 'a t * 'a t
   val strip_n_app : int -> 'a t -> ('a t * 'a * 'a t) option
@@ -339,12 +337,10 @@ struct
 
   type 'a member =
   | App of 'a app_node
-  | Case of Term.case_info * 'a * 'a array * Cst_stack.t
+  | Case of case_info * 'a * 'a array * Cst_stack.t
   | Proj of int * int * projection * Cst_stack.t
   | Fix of ('a, 'a) pfixpoint * 'a t * Cst_stack.t
   | Cst of cst_member * int * int list * 'a t * Cst_stack.t
-  | Shift of int
-  | Update of 'a
   and 'a t = 'a member list
 
   let rec pr_member pr_c member =
@@ -358,7 +354,7 @@ struct
        ++ str ")"
     | Proj (n,m,p,cst) ->
       str "ZProj(" ++ int n ++ pr_comma () ++ int m ++
-	pr_comma () ++ pr_con (Projection.constant p) ++ str ")"
+	pr_comma () ++ Constant.print (Projection.constant p) ++ str ")"
     | Fix (f,args,cst) ->
        str "ZFix(" ++ Termops.pr_fix pr_c f
        ++ pr_comma () ++ pr pr_c args ++ str ")"
@@ -367,8 +363,6 @@ struct
       ++ pr_comma () ++
 	prlist_with_sep pr_semicolon int remains ++
 	pr_comma () ++ pr pr_c params ++ str ")"
-    | Shift i -> str "ZShift(" ++ int i ++ str ")"
-    | Update t -> str "ZUpdate(" ++ pr_c t ++ str ")"
   and pr pr_c l =
     let open Pp in
     prlist_with_sep pr_semicolon (fun x -> hov 1 (pr_member pr_c x)) l
@@ -403,54 +397,42 @@ struct
     else (l.(j), sk)
 
   let equal f f_fix sk1 sk2 =
-    let equal_cst_member x lft1 y lft2 =
+    let equal_cst_member x y =
       match x, y with
       | Cst_const (c1,u1), Cst_const (c2, u2) ->
-	Constant.equal c1 c2 && Univ.Instance.equal u1 u2
+        Constant.equal c1 c2 && Univ.Instance.equal u1 u2
       | Cst_proj p1, Cst_proj p2 ->
-	Constant.equal (Projection.constant p1) (Projection.constant p2)
+        Constant.equal (Projection.constant p1) (Projection.constant p2)
       | _, _ -> false
     in
-    let rec equal_rec sk1 lft1 sk2 lft2  =
+    let rec equal_rec sk1 sk2 =
       match sk1,sk2 with
-      | [],[] -> Some (lft1,lft2)
-      | (Update _ :: _, _ | _, Update _ :: _) -> assert false
-      | Shift k :: s1, _ -> equal_rec  s1  (lft1+k)  sk2 lft2
-      | _, Shift k :: s2 -> equal_rec sk1 lft1 s2 (lft2+k)
+      | [],[] -> true
       | App a1 :: s1, App a2 :: s2 ->
-	let t1,s1' = decomp_node_last a1 s1 in
-	let t2,s2' = decomp_node_last a2 s2 in
-	if f (t1,lft1) (t2,lft2) then equal_rec s1' lft1 s2' lft2 else None
+        let t1,s1' = decomp_node_last a1 s1 in
+        let t2,s2' = decomp_node_last a2 s2 in
+        (f t1 t2) && (equal_rec s1' s2')
       | Case (_,t1,a1,_) :: s1, Case (_,t2,a2,_) :: s2 ->
-	if f (t1,lft1) (t2,lft2) && CArray.equal (fun x y -> f (x,lft1) (y,lft2)) a1 a2
-	then equal_rec s1 lft1 s2 lft2
-	else None
+        f t1 t2 && CArray.equal (fun x y -> f x y) a1 a2 && equal_rec s1 s2
       | (Proj (n1,m1,p,_)::s1, Proj(n2,m2,p2,_)::s2) ->
-	if Int.equal n1 n2 && Int.equal m1 m2
-	  && Constant.equal (Projection.constant p) (Projection.constant p2)
-	then equal_rec s1 lft1 s2 lft2
-	else None
+         Int.equal n1 n2 && Int.equal m1 m2
+           && Constant.equal (Projection.constant p) (Projection.constant p2)
+           && equal_rec s1 s2
       | Fix (f1,s1,_) :: s1', Fix (f2,s2,_) :: s2' ->
-	if f_fix (f1,lft1) (f2,lft2) then
-	  match equal_rec (List.rev s1) lft1 (List.rev s2) lft2 with
-	  | None -> None
-	  | Some (lft1',lft2') -> equal_rec s1' lft1' s2' lft2'
-	else None
+        f_fix f1 f2
+          && equal_rec (List.rev s1) (List.rev s2)
+          && equal_rec s1' s2'
       | Cst (c1,curr1,remains1,params1,_)::s1', Cst (c2,curr2,remains2,params2,_)::s2' ->
-	if equal_cst_member c1 lft1 c2 lft2 then
-	  match equal_rec (List.rev params1) lft1 (List.rev params2) lft2 with
-	  | Some (lft1',lft2') -> equal_rec s1' lft1' s2' lft2'
-	  | None -> None
-	else None
-      | ((App _|Case _|Proj _|Fix _|Cst _)::_|[]), _ -> None
-    in equal_rec (List.rev sk1) 0 (List.rev sk2) 0
+        equal_cst_member c1 c2
+          && equal_rec (List.rev params1) (List.rev params2)
+          && equal_rec s1' s2'
+      | ((App _|Case _|Proj _|Fix _|Cst _)::_|[]), _ -> false
+    in equal_rec (List.rev sk1) (List.rev sk2)
 
   let compare_shape stk1 stk2 =
     let rec compare_rec bal stk1 stk2 =
       match (stk1,stk2) with
 	([],[]) -> Int.equal bal 0
-      | ((Update _|Shift _)::s1, _) -> compare_rec bal s1 stk2
-      | (_, (Update _|Shift _)::s2) -> compare_rec bal stk1 s2
       | (App (i,_,j)::s1, _) -> compare_rec (bal + j + 1 - i) s1 stk2
       | (_, App (i,_,j)::s2) -> compare_rec (bal - j - 1 + i) stk1 s2
       | (Case(c1,_,_,_)::s1, Case(c2,_,_,_)::s2) ->
@@ -466,40 +448,29 @@ struct
 
   exception IncompatibleFold2
   let fold2 f o sk1 sk2 =
-    let rec aux o lft1 sk1 lft2 sk2 =
-      let fold_array =
-	Array.fold_left2 (fun a x y -> f a (Vars.lift lft1 x) (Vars.lift lft2 y))
-      in
+    let rec aux o sk1 sk2 =
       match sk1,sk2 with
-      | [], [] -> o,lft1,lft2
-      | Shift n :: q1, _ -> aux o (lft1+n) q1 lft2 sk2
-      | _, Shift n :: q2 -> aux o lft1 sk1 (lft2+n) q2
+      | [], [] -> o
       | App n1 :: q1, App n2 :: q2 ->
-	 let t1,l1 = decomp_node_last n1 q1 in
-	 let t2,l2 = decomp_node_last n2 q2 in
-	 aux (f o (Vars.lift lft1 t1) (Vars.lift lft2 t2))
-	     lft1 l1 lft2 l2
+        let t1,l1 = decomp_node_last n1 q1 in
+        let t2,l2 = decomp_node_last n2 q2 in
+        aux (f o t1 t2) l1 l2
       | Case (_,t1,a1,_) :: q1, Case (_,t2,a2,_) :: q2 ->
-	aux (fold_array
-	       (f o (Vars.lift lft1 t1) (Vars.lift lft2 t2))
-	       a1 a2) lft1 q1 lft2 q2
+        aux (Array.fold_left2 f (f o t1 t2) a1 a2) q1 q2
       | Proj (n1,m1,p1,_) :: q1, Proj (n2,m2,p2,_) :: q2 ->
-	aux o lft1 q1 lft2 q2
+        aux o q1 q2
       | Fix ((_,(_,a1,b1)),s1,_) :: q1, Fix ((_,(_,a2,b2)),s2,_) :: q2 ->
-	let (o',lft1',lft2') = aux (fold_array (fold_array o b1 b2) a1 a2)
-	  lft1 (List.rev s1) lft2 (List.rev s2) in
-	aux o' lft1' q1 lft2' q2
+        let o' = aux (Array.fold_left2 f (Array.fold_left2 f o b1 b2) a1 a2) (List.rev s1) (List.rev s2) in
+        aux o' q1 q2
       | Cst (cst1,_,_,params1,_) :: q1, Cst (cst2,_,_,params2,_) :: q2 ->
-	let (o',lft1',lft2') =
-	  aux o lft1 (List.rev params1) lft2 (List.rev params2)
-	in aux o' lft1' q1 lft2' q2
-      | (((Update _|App _|Case _|Proj _|Fix _| Cst _) :: _|[]), _) ->
-	raise IncompatibleFold2
-    in aux o 0 (List.rev sk1) 0 (List.rev sk2)
+        let o' = aux o (List.rev params1) (List.rev params2) in
+        aux o' q1 q2
+      | (((App _|Case _|Proj _|Fix _| Cst _) :: _|[]), _) ->
+              raise IncompatibleFold2
+    in aux o (List.rev sk1) (List.rev sk2)
 
   let rec map f x = List.map (function
-			       | Update _ -> assert false
-			       | (Proj (_,_,_,_) | Shift _) as e -> e
+                               | (Proj (_,_,_,_)) as e -> e
 			       | App (i,a,j) ->
 				  let le = j - i + 1 in
 				  App (0,Array.map f (Array.sub a i le), le-1)
@@ -516,18 +487,15 @@ struct
 
   let rec args_size = function
     | App (i,_,j)::s -> j + 1 - i + args_size s
-    | Shift(_)::s -> args_size s
-    | Update(_)::s -> args_size s
     | (Case _|Fix _|Proj _|Cst _)::_ | [] -> 0
 
   let strip_app s =
     let rec aux out = function
-      | ( App _ | Shift _ as e) :: s -> aux (e :: out) s
+      | ( App _ as e) :: s -> aux (e :: out) s
       | s -> List.rev out,s
     in aux [] s
   let strip_n_app n s =
     let rec aux n out = function
-      | Shift k as e :: s -> aux n (e :: out) s
       | App (i,a,j) as e :: s ->
 	 let nb = j  - i + 1 in
 	 if n >= nb then
@@ -552,14 +520,12 @@ struct
   let list_of_app_stack s =
     let rec aux = function
       | App (i,a,j) :: s ->
-	 let (k,(args',s')) = aux s in
-	 let a' = Array.map (Vars.lift k) (Array.sub a i (j - i + 1)) in
-	 k,(Array.fold_right (fun x y -> x::y) a' args', s')
-      | Shift n :: s ->
-	 let (k,(args',s')) = aux s in (k+n,(args', s'))
-      | s -> (0,([],s)) in
-    let (lft,(out,s')) = aux s in
-    let init = match s' with [] when Int.equal lft 0 -> true | _ -> false in
+        let (args',s') = aux s in
+        let a' = Array.sub a i (j - i + 1) in
+        (Array.fold_right (fun x y -> x::y) a' args', s')
+      | s -> ([],s) in
+    let (out,s') = aux s in
+    let init = match s' with [] -> true | _ -> false in
     Option.init init out
 
   let assign s p c =
@@ -568,20 +534,18 @@ struct
     | None -> assert false
 
   let tail n0 s0 =
-    let rec aux lft n s =
-      let out s = if Int.equal lft 0 then s else Shift lft :: s in
-      if Int.equal n 0 then out s else
+    let rec aux n s =
+      if Int.equal n 0 then s else
 	match s with
       | App (i,a,j) :: s ->
 	 let nb = j  - i + 1 in
 	 if n >= nb then
-	   aux lft (n - nb) s
+           aux (n - nb) s
 	 else
 	   let p = i+n in
 	   if j >= p then App(p,a,j)::s else s
-	| Shift k :: s' -> aux (lft+k) n s'
 	| _ -> raise (Invalid_argument "Reductionops.Stack.tail")
-    in aux 0 n0 s0
+    in aux n0 s0
 
   let nth s p =
     match strip_n_app p s with
@@ -627,11 +591,9 @@ struct
     zip (best_state sigma (constr_of_cst_member cst (params @ (append_app [|f|] s))) cst_l)
   | f, (Cst (cst,_,_,params,_)::s) ->
     zip (constr_of_cst_member cst (params @ (append_app [|f|] s)))
-  | f, (Shift n::s) -> zip (lift n f, s)
   | f, (Proj (n,m,p,cst_l)::s) when refold ->
     zip (best_state sigma (mkProj (p,f),s) cst_l)
   | f, (Proj (n,m,p,_)::s) -> zip (mkProj (p,f),s)
-  | _, (Update _::_) -> assert false
   in
   zip s
 
@@ -868,11 +830,9 @@ let _ = Goptions.declare_bool_option {
 }
 
 let equal_stacks sigma (x, l) (y, l') =
-  let f_equal (x,lft1) (y,lft2) = eq_constr sigma (Vars.lift lft1 x) (Vars.lift lft2 y) in
-  let eq_fix (a,b) (c,d) = f_equal (mkFix a, b) (mkFix c, d) in
-    match Stack.equal f_equal eq_fix l l' with
-    | None -> false
-    | Some (lft1,lft2) -> f_equal (x, lft1) (y, lft2) 
+  let f_equal x y = eq_constr sigma x y in
+  let eq_fix a b = f_equal (mkFix a) (mkFix b) in
+  Stack.equal f_equal eq_fix l l' && f_equal x y
 
 let rec whd_state_gen ?csts ~refold ~tactic_mode flags env sigma =
   let open Context.Named.Declaration in
@@ -1074,7 +1034,7 @@ let rec whd_state_gen ?csts ~refold ~tactic_mode flags env sigma =
 		(arg,
 		 Stack.Cst (const,next,remains',s' @ (Stack.append_app [|x'|] bef),cst_l) :: s''')
 	  end
-	|_, (Stack.App _|Stack.Update _|Stack.Shift _)::_ -> assert false
+        |_, (Stack.App _)::_ -> assert false
 	|_, _ -> fold ()
       else fold ()
 
@@ -1155,7 +1115,7 @@ let local_whd_state_gen flags sigma =
 	|args, (Stack.Fix (f,s',cst)::s'') when use_fix ->
 	  let x' = Stack.zip sigma (x,args) in
 	  whrec (contract_fix sigma f, s' @ (Stack.append_app [|x'|] s''))
-	|_, (Stack.App _|Stack.Update _|Stack.Shift _|Stack.Cst _)::_ -> assert false
+        |_, (Stack.App _|Stack.Cst _)::_ -> assert false
 	|_, _ -> s
       else s
 
@@ -1167,7 +1127,8 @@ let local_whd_state_gen flags sigma =
 	|_ -> s
       else s
 
-    | x -> s
+    | Rel _ | Var _ | Sort _ | Prod _ | LetIn _ | Const _  | Ind _ | Proj _ -> s
+
   in
   whrec
 
@@ -1280,9 +1241,9 @@ let clos_whd_flags flgs env sigma t =
       (CClosure.inject (EConstr.Unsafe.to_constr t)))
   with e when is_anomaly e -> user_err Pp.(str "Tried to normalize ill-typed term")
 
-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_beta = clos_norm_flags CClosure.beta
+let nf_betaiota = clos_norm_flags CClosure.betaiota
+let nf_betaiotazeta = clos_norm_flags CClosure.betaiotazeta
 let nf_all env sigma =
   clos_norm_flags CClosure.all env sigma
 
@@ -1291,11 +1252,11 @@ let nf_all env sigma =
 (*                         Conversion                               *)
 (********************************************************************)
 (*
-let fkey = Profile.declare_profile "fhnf";;
-let fhnf info v = Profile.profile2 fkey fhnf info v;;
+let fkey = CProfile.declare_profile "fhnf";;
+let fhnf info v = CProfile.profile2 fkey fhnf info v;;
 
-let fakey = Profile.declare_profile "fhnf_apply";;
-let fhnf_apply info k h a = Profile.profile4 fakey fhnf_apply info k h a;;
+let fakey = CProfile.declare_profile "fhnf_apply";;
+let fhnf_apply info k h a = CProfile.profile4 fakey fhnf_apply info k h a;;
 *)
 
 let is_transparent e k =
@@ -1305,7 +1266,7 @@ let is_transparent e k =
 
 (* Conversion utility functions *)
 
-type conversion_test = constraints -> constraints
+type conversion_test = Constraint.t -> Constraint.t
 
 let pb_is_equal pb = pb == Reduction.CONV
 
@@ -1314,7 +1275,9 @@ let pb_equal = function
   | Reduction.CONV -> Reduction.CONV
 
 let report_anomaly e =
-  let e = UserError (None, Pp.(str "Conversion test raised an anomaly" ++ print e)) in
+  let msg = Pp.(str "Conversion test raised an anomaly:" ++
+                spc () ++ CErrors.print e) in
+  let e = UserError (None,msg) in
   let e = CErrors.push e in
   iraise e
 
@@ -1361,94 +1324,28 @@ let sigma_compare_instances ~flex i0 i1 sigma =
      | Univ.UniverseInconsistency _ ->
 	raise Reduction.NotConvertible
 
-let sigma_check_inductive_instances cv_pb uinfind u u' sigma =
-  let len_instance =
-    Univ.AUContext.size (Univ.ACumulativityInfo.univ_context uinfind)
-  in
-  let ind_sbctx =  Univ.ACumulativityInfo.subtyp_context uinfind  in
-  if not ((len_instance = Univ.Instance.length u) &&
-          (len_instance = Univ.Instance.length u')) then
-     anomaly (Pp.str "Invalid inductive subtyping encountered!")
-  else
-    let comp_cst =
-      let comp_subst = (Univ.Instance.append u u') in
-      Univ.AUContext.instantiate comp_subst ind_sbctx
-    in
-    let comp_cst =
-      match cv_pb with
-        Reduction.CONV -> 
-        let comp_subst = (Univ.Instance.append u' u) in
-        let comp_cst' = Univ.AUContext.instantiate comp_subst ind_sbctx in
-        Univ.Constraint.union comp_cst comp_cst'
-      | Reduction.CUMUL -> comp_cst
-    in
-    try Evd.add_constraints sigma comp_cst
-    with Evd.UniversesDiffer
-       | Univ.UniverseInconsistency _ ->
-      raise Reduction.NotConvertible
-
-let sigma_conv_inductives
-    cv_pb (mind, ind) u1 sv1 u2 sv2 sigma =
-  try sigma_compare_instances ~flex:false u1 u2 sigma with
-    Reduction.NotConvertible ->
-    match mind.Declarations.mind_universes with
-    | Declarations.Monomorphic_ind _ ->
-      raise Reduction.NotConvertible
-    | Declarations.Polymorphic_ind _ ->
-      raise Reduction.NotConvertible
-    | Declarations.Cumulative_ind cumi ->
-      let num_param_arity =
-        mind.Declarations.mind_nparams + 
-        mind.Declarations.mind_packets.(ind).Declarations.mind_nrealargs
-      in
-      if not (num_param_arity = sv1 && num_param_arity = sv2) then
-        raise Reduction.NotConvertible
-      else
-        sigma_check_inductive_instances cv_pb cumi u1 u2 sigma 
-
-let sigma_conv_constructors
-    (mind, ind, cns) u1 sv1 u2 sv2 sigma =
-  try sigma_compare_instances ~flex:false u1 u2 sigma with
-    Reduction.NotConvertible ->
-    match mind.Declarations.mind_universes with
-    | Declarations.Monomorphic_ind _ ->
-      raise Reduction.NotConvertible
-    | Declarations.Polymorphic_ind _ ->
-      raise Reduction.NotConvertible
-    | Declarations.Cumulative_ind cumi ->
-      let num_cnstr_args =
-        let nparamsctxt =
-          mind.Declarations.mind_nparams + 
-          mind.Declarations.mind_packets.(ind).Declarations.mind_nrealargs
-        in
-        nparamsctxt + 
-        mind.Declarations.mind_packets.(ind).Declarations.mind_consnrealargs.(cns - 1)
-      in
-      if not (num_cnstr_args = sv1 && num_cnstr_args = sv2) then
-        raise Reduction.NotConvertible
-      else
-        sigma_check_inductive_instances Reduction.CONV cumi u1 u2 sigma
+let sigma_check_inductive_instances csts sigma =
+  try Evd.add_constraints sigma csts
+  with Evd.UniversesDiffer
+     | Univ.UniverseInconsistency _ ->
+    raise Reduction.NotConvertible
 
 let sigma_univ_state = 
-  { Reduction.compare = sigma_compare_sorts;
-    Reduction.compare_instances = sigma_compare_instances;
-    Reduction.conv_inductives = sigma_conv_inductives;
-    Reduction.conv_constructors = sigma_conv_constructors}
+  let open Reduction in
+  { compare_sorts = sigma_compare_sorts;
+    compare_instances = sigma_compare_instances;
+    compare_cumul_instances = sigma_check_inductive_instances; }
 
 let infer_conv_gen conv_fun ?(catch_incon=true) ?(pb=Reduction.CUMUL)
     ?(ts=full_transparent_state) env sigma x y =
   (** FIXME *)
-  let open Universes in
-  let x = EConstr.Unsafe.to_constr x in
-  let y = EConstr.Unsafe.to_constr y in
   try
-    let fold cstr accu = Some (Constraints.fold Constraints.add cstr accu) in
     let b, sigma = 
       let ans =
 	if pb == Reduction.CUMUL then 
-	  Universes.leq_constr_univs_infer (Evd.universes sigma) fold x y Constraints.empty
+	  EConstr.leq_constr_universes sigma x y
 	else
-	  Universes.eq_constr_univs_infer (Evd.universes sigma) fold x y Constraints.empty
+	  EConstr.eq_constr_universes sigma x y
       in
       let ans = match ans with
       | None -> None
@@ -1462,6 +1359,8 @@ let infer_conv_gen conv_fun ?(catch_incon=true) ?(pb=Reduction.CUMUL)
     in
       if b then sigma, true
       else
+        let x = EConstr.Unsafe.to_constr x in
+        let y = EConstr.Unsafe.to_constr y in
 	let sigma' = 
 	  conv_fun pb ~l2r:false sigma ts
 	    env (sigma, sigma_univ_state) x y in
@@ -1684,7 +1583,7 @@ let whd_betaiota_deltazeta_for_iota_state ts env sigma csts s =
 	if isConstruct sigma t_o then
 	  whrec Cst_stack.empty (Stack.nth stack_o (n+m), stack'')
 	else s,csts'
-      |_, ((Stack.App _| Stack.Shift _|Stack.Update _|Stack.Cst _) :: _|[]) -> s,csts'
+      |_, ((Stack.App _|Stack.Cst _) :: _|[]) -> s,csts'
   in whrec csts s
 
 let find_conclusion env sigma =
@@ -1771,8 +1670,8 @@ let meta_reducible_instance evd b =
           let is_coerce = match s with CoerceToType -> true | _ -> false in
           if not is_coerce then irec g else u
 	 with Not_found -> u)
-    | Proj (p,c) when isMeta evd c || isCast evd c && isMeta evd (pi1 (destCast evd c)) ->
-	let m = try destMeta evd c with _ -> destMeta evd (pi1 (destCast evd c)) in
+    | Proj (p,c) when isMeta evd c || isCast evd c && isMeta evd (pi1 (destCast evd c)) (* What if two nested casts? *) ->
+      let m = try destMeta evd c with _ -> destMeta evd (pi1 (destCast evd c)) (* idem *) in
 	  (match
 	  try
 	    let g, s = Metamap.find m metas in
diff --git a/pretyping/reductionops.mli b/pretyping/reductionops.mli
index 1828196fe..0565baf45 100644
--- a/pretyping/reductionops.mli
+++ b/pretyping/reductionops.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open EConstr
 open Univ
 open Evd
@@ -82,8 +82,6 @@ module Stack : sig
   | Fix of ('a, 'a) pfixpoint * 'a t * Cst_stack.t
   | Cst of cst_member * int (** current foccussed arg *) * int list (** remaining args *)
     * 'a t * Cst_stack.t
-  | Shift of int
-  | Update of 'a
   and 'a t = 'a member list
 
   val pr : ('a -> Pp.t) -> 'a t -> Pp.t
@@ -102,12 +100,12 @@ module Stack : sig
       @return the result and the lifts to apply on the terms
       @raise IncompatibleFold2 when [sk1] and [sk2] have incompatible shapes *)
   val fold2 : ('a -> constr -> constr -> 'a) -> 'a ->
-    constr t -> constr t -> 'a * int * int
+    constr t -> constr t -> 'a
   val map : ('a -> 'a) -> 'a t -> 'a t
   val append_app_list : 'a list -> 'a t -> 'a t
 
   (** if [strip_app s] = [(a,b)], then [s = a @ b] and [b] does not
-      start by App or Shift *)
+      start by App *)
   val strip_app : 'a t -> 'a t * 'a t
   (** @return (the nth first elements, the (n+1)th element, the remaining stack)  *)
   val strip_n_app : int -> 'a t -> ('a t * 'a * 'a t) option
@@ -170,9 +168,9 @@ val clos_norm_flags : CClosure.RedFlags.reds -> reduction_function
 val clos_whd_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_beta : reduction_function
+val nf_betaiota : reduction_function
+val nf_betaiotazeta : reduction_function
 val nf_all : reduction_function
 val nf_evar : evar_map -> constr -> constr
 
@@ -258,11 +256,11 @@ val contract_fix : ?env:Environ.env -> evar_map -> ?reference:Constant.t -> fixp
 val fix_recarg : ('a, 'a) pfixpoint -> 'b Stack.t -> (int * 'b) option
 
 (** {6 Querying the kernel conversion oracle: opaque/transparent constants } *)
-val is_transparent : Environ.env -> constant tableKey -> bool
+val is_transparent : Environ.env -> Constant.t tableKey -> bool
 
 (** {6 Conversion Functions (uses closures, lazy strategy) } *)
 
-type conversion_test = constraints -> constraints
+type conversion_test = Constraint.t -> Constraint.t
 
 val pb_is_equal : conv_pb -> bool
 val pb_equal : conv_pb -> conv_pb
diff --git a/pretyping/retyping.ml b/pretyping/retyping.ml
index 079524f34..00b175c48 100644
--- a/pretyping/retyping.ml
+++ b/pretyping/retyping.ml
@@ -10,6 +10,7 @@ open Pp
 open CErrors
 open Util
 open Term
+open Constr
 open Inductive
 open Inductiveops
 open Names
@@ -146,7 +147,7 @@ let retype ?(polyprop=true) sigma =
     | Cast (c,_, s) when isSort sigma s -> destSort sigma s
     | Sort s ->
       begin match ESorts.kind sigma s with
-      | Prop _ -> type1_sort
+      | Prop _ -> Sorts.type1
       | Type u -> Type (Univ.super u)
       end
     | Prod (name,t,c2) ->
@@ -165,23 +166,6 @@ let retype ?(polyprop=true) sigma =
     | Lambda _ | Fix _ | Construct _ -> retype_error NotAType
     | _ -> decomp_sort env sigma (type_of env t)
 
-  and sort_family_of env t =
-    match EConstr.kind sigma t with
-    | Cast (c,_, s) when isSort sigma s -> family_of_sort (destSort sigma s)
-    | Sort _ -> InType
-    | Prod (name,t,c2) ->
-	let s2 = sort_family_of (push_rel (LocalAssum (name,t)) env) c2 in
-	if not (is_impredicative_set env) &&
-	   s2 == InSet && sort_family_of env t == InType then InType else s2
-    | App(f,args) when is_template_polymorphic env sigma f ->
-	let t = type_of_global_reference_knowing_parameters env f args in
-        family_of_sort (sort_of_atomic_type env sigma t args)
-    | App(f,args) ->
-	family_of_sort (sort_of_atomic_type env sigma (type_of env f) args)
-    | Lambda _ | Fix _ | Construct _ -> retype_error NotAType
-    | _ -> 
-      family_of_sort (decomp_sort env sigma (type_of env t))
-
   and type_of_global_reference_knowing_parameters env c args =
     let argtyps =
       Array.map (fun c -> lazy (EConstr.to_constr sigma (type_of env c))) args in
@@ -197,15 +181,34 @@ let retype ?(polyprop=true) sigma =
       EConstr.of_constr (type_of_constructor env (cstr, u))
     | _ -> assert false
 
-  in type_of, sort_of, sort_family_of,
-     type_of_global_reference_knowing_parameters
+  in type_of, sort_of, type_of_global_reference_knowing_parameters
+
+let get_sort_family_of ?(truncation_style=false) ?(polyprop=true) env sigma t =
+  let type_of,_,type_of_global_reference_knowing_parameters = retype ~polyprop sigma in
+  let rec sort_family_of env t =
+    match EConstr.kind sigma t with
+    | Cast (c,_, s) when isSort sigma s -> Sorts.family (destSort sigma s)
+    | Sort _ -> InType
+    | Prod (name,t,c2) ->
+	let s2 = sort_family_of (push_rel (LocalAssum (name,t)) env) c2 in
+	if not (is_impredicative_set env) &&
+	   s2 == InSet && sort_family_of env t == InType then InType else s2
+    | App(f,args) when is_template_polymorphic env sigma f ->
+        if truncation_style then InType else
+	let t = type_of_global_reference_knowing_parameters env f args in
+        Sorts.family (sort_of_atomic_type env sigma t args)
+    | App(f,args) ->
+	Sorts.family (sort_of_atomic_type env sigma (type_of env f) args)
+    | Lambda _ | Fix _ | Construct _ -> retype_error NotAType
+    | Ind _ when truncation_style && is_template_polymorphic env sigma t -> InType
+    | _ -> 
+      Sorts.family (decomp_sort env sigma (type_of env t))
+  in sort_family_of env t
 
 let get_sort_of ?(polyprop=true) env sigma t =
-  let _,f,_,_ = retype ~polyprop sigma in anomaly_on_error (f env) t
-let get_sort_family_of ?(polyprop=true) env sigma c =
-  let _,_,f,_ = retype ~polyprop sigma in anomaly_on_error (f env) c
+  let _,f,_ = retype ~polyprop sigma in anomaly_on_error (f env) t
 let type_of_global_reference_knowing_parameters env sigma c args =
-  let _,_,_,f = retype sigma in anomaly_on_error (f env c) args
+  let _,_,f = retype sigma in anomaly_on_error (f env c) args
 
 let type_of_global_reference_knowing_conclusion env sigma c conclty =
   match EConstr.kind sigma c with
@@ -214,7 +217,6 @@ let type_of_global_reference_knowing_conclusion env sigma c conclty =
           type_of_inductive_knowing_conclusion env sigma (spec, EInstance.kind sigma u) conclty
     | Const (cst, u) ->
         let t = constant_type_in env (cst, EInstance.kind sigma u) in
-        (* TODO *)
           sigma, EConstr.of_constr t
     | Var id -> sigma, type_of_var env id
     | Construct (cstr, u) -> sigma, EConstr.of_constr (type_of_constructor env (cstr, EInstance.kind sigma u))
@@ -225,14 +227,14 @@ let type_of_global_reference_knowing_conclusion env sigma c conclty =
 (*   let f,_,_,_ = retype ~polyprop sigma in *)
 (*     if lax then f env c else anomaly_on_error (f env) c  *)
 
-(* let get_type_of_key = Profile.declare_profile "get_type_of" *)
-(* let get_type_of = Profile.profile5 get_type_of_key get_type_of *)
+(* let get_type_of_key = CProfile.declare_profile "get_type_of" *)
+(* let get_type_of = CProfile.profile5 get_type_of_key get_type_of *)
 
 (* let get_type_of ?(polyprop=true) ?(lax=false) env sigma c = *)
 (*   get_type_of polyprop lax env sigma c *)
 
 let get_type_of ?(polyprop=true) ?(lax=false) env sigma c =
-  let f,_,_,_ = retype ~polyprop sigma in
+  let f,_,_ = retype ~polyprop sigma in
     if lax then f env c else anomaly_on_error (f env) c
 
 (* Makes an unsafe judgment from a constr *)
diff --git a/pretyping/retyping.mli b/pretyping/retyping.mli
index ed3a9d0f9..6fdde9046 100644
--- a/pretyping/retyping.mli
+++ b/pretyping/retyping.mli
@@ -6,7 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Term
 open Evd
 open Environ
 open EConstr
@@ -30,10 +29,13 @@ val get_type_of :
   ?polyprop:bool -> ?lax:bool -> env -> evar_map -> constr -> types
 
 val get_sort_of :
-  ?polyprop:bool -> env -> evar_map -> types -> sorts
+  ?polyprop:bool -> env -> evar_map -> types -> Sorts.t
 
+(* When [truncation_style] is [true], tells if the type has been explicitly
+   truncated to Prop or (impredicative) Set; in particular, singleton type and
+   small inductive types, which have all eliminations to Type, are in Type *)
 val get_sort_family_of :
-  ?polyprop:bool -> env -> evar_map -> types -> sorts_family
+  ?truncation_style:bool -> ?polyprop:bool -> env -> evar_map -> types -> Sorts.family
 
 (** Makes an unsafe judgment from a constr *)
 val get_judgment_of : env -> evar_map -> constr -> unsafe_judgment
@@ -44,7 +46,7 @@ val type_of_global_reference_knowing_parameters : env -> evar_map -> constr ->
 val type_of_global_reference_knowing_conclusion :
   env -> evar_map -> constr -> types -> evar_map * types
 
-val sorts_of_context : env -> evar_map -> rel_context -> sorts list
+val sorts_of_context : env -> evar_map -> rel_context -> Sorts.t list
 
 val expand_projection : env -> evar_map -> Names.projection -> constr -> constr list -> constr
 
diff --git a/pretyping/tacred.ml b/pretyping/tacred.ml
index 708788ab8..9b9408698 100644
--- a/pretyping/tacred.ml
+++ b/pretyping/tacred.ml
@@ -60,9 +60,7 @@ let value_of_evaluable_ref env evref u =
   match evref with
   | EvalConstRef con -> 
     let u = Unsafe.to_instance u in
-    EConstr.of_constr (try constant_value_in env (con,u)
-    with NotEvaluableConst IsProj -> 
-      raise (Invalid_argument "value_of_evaluable_ref"))
+    EConstr.of_constr (constant_value_in env (con, u))
   | EvalVarRef id -> env |> lookup_named id |> NamedDecl.get_value |> Option.get
 
 let evaluable_of_global_reference env = function
@@ -75,13 +73,13 @@ let global_of_evaluable_reference = function
   | EvalVarRef id -> VarRef id
 
 type evaluable_reference =
-  | EvalConst of constant
+  | EvalConst of Constant.t
   | EvalVar of Id.t
   | EvalRel of int
   | EvalEvar of EConstr.existential
 
 let evaluable_reference_eq sigma r1 r2 = match r1, r2 with
-| EvalConst c1, EvalConst c2 -> eq_constant c1 c2
+| EvalConst c1, EvalConst c2 -> Constant.equal c1 c2
 | EvalVar id1, EvalVar id2 -> Id.equal id1 id2
 | EvalRel i1, EvalRel i2 -> Int.equal i1 i2
 | EvalEvar (e1, ctx1), EvalEvar (e2, ctx2) ->
@@ -240,7 +238,7 @@ let invert_name labs l na0 env sigma ref = function
 	  | EvalRel _ | EvalEvar _ -> None
 	  | EvalVar id' -> Some (EvalVar id)
 	  | EvalConst kn ->
-	      Some (EvalConst (con_with_label kn (Label.of_id id))) in
+	      Some (EvalConst (Constant.change_label kn (Label.of_id id))) in
 	match refi with
 	  | None -> None
 	  | Some ref ->
@@ -476,7 +474,7 @@ let contract_fix_use_function env sigma f
   let nbodies = Array.length recindices in
   let make_Fi j = (mkFix((recindices,j),typedbodies), f j) in
   let lbodies = List.init nbodies make_Fi in
-  substl_checking_arity env (List.rev lbodies) sigma (nf_beta sigma bodies.(bodynum))
+  substl_checking_arity env (List.rev lbodies) sigma (nf_beta env sigma bodies.(bodynum))
 
 let reduce_fix_use_function env sigma f whfun fix stack =
   match fix_recarg fix (Stack.append_app_list stack Stack.empty) with
@@ -500,7 +498,7 @@ let contract_cofix_use_function env sigma f
   let make_Fi j = (mkCoFix(j,typedbodies), f j) in
   let subbodies = List.init nbodies make_Fi in
   substl_checking_arity env (List.rev subbodies)
-    sigma (nf_beta sigma bodies.(bodynum))
+    sigma (nf_beta env sigma bodies.(bodynum))
 
 let reduce_mind_case_use_function func env sigma mia =
   match EConstr.kind sigma mia.mconstr with
@@ -521,7 +519,7 @@ let reduce_mind_case_use_function func env sigma mia =
 		       the block was indeed initially built as a global
 		       definition *)
                     let (kn, u) = destConst sigma func in
-                    let kn = con_with_label kn (Label.of_id id) in
+                    let kn = Constant.change_label kn (Label.of_id id) in
                     let cst = (kn, EInstance.kind sigma u) in
 		    try match constant_opt_value_in env cst with
 		      | None -> None
@@ -697,7 +695,7 @@ let rec red_elim_const env sigma ref u largs =
 	let whfun = whd_construct_stack env sigma in
 	(match reduce_fix_use_function env sigma f whfun (destFix sigma d) lrest with
 	   | NotReducible -> raise Redelimination
-           | Reduced (c,rest) -> (nf_beta sigma c, rest), nocase)
+           | Reduced (c,rest) -> (nf_beta env sigma c, rest), nocase)
     | EliminationMutualFix (min,refgoal,refinfos) when nargs >= min ->
 	let rec descend (ref,u) args =
 	  let c = reference_value env sigma ref u in
@@ -712,7 +710,7 @@ let rec red_elim_const env sigma ref u largs =
 	let whfun = whd_construct_stack env sigma in
 	(match reduce_fix_use_function env sigma f whfun (destFix sigma d) lrest with
 	   | NotReducible -> raise Redelimination
-	   | Reduced (c,rest) -> (nf_beta sigma c, rest), nocase)
+           | Reduced (c,rest) -> (nf_beta env sigma c, rest), nocase)
     | NotAnElimination when unfold_nonelim ->
          let c = reference_value env sigma ref u in
            (whd_betaiotazeta sigma (applist (c, largs)), []), nocase
@@ -927,8 +925,8 @@ let whd_simpl_orelse_delta_but_fix_old env sigma c =
 
 let whd_simpl_stack = 
   if Flags.profile then 
-    let key = Profile.declare_profile "whd_simpl_stack" in
-      Profile.profile3 key whd_simpl_stack
+    let key = CProfile.declare_profile "whd_simpl_stack" in
+      CProfile.profile3 key whd_simpl_stack
   else whd_simpl_stack
 
 (* Same as [whd_simpl] but also reduces constants that do not hide a
@@ -944,7 +942,7 @@ let whd_simpl_orelse_delta_but_fix env sigma c =
       | CoFix _ | Fix _ -> s'
       | Proj (p,t) when
 	  (match EConstr.kind sigma constr with
-	  | Const (c', _) -> eq_constant (Projection.constant p) c'
+	  | Const (c', _) -> Constant.equal (Projection.constant p) c'
 	  | _ -> false) ->
 	let pb = Environ.lookup_projection p env in
 	  if List.length stack <= pb.Declarations.proj_npars then
@@ -1050,8 +1048,8 @@ let contextually byhead occs f env sigma t =
 
 let match_constr_evaluable_ref sigma c evref = 
   match EConstr.kind sigma c, evref with
-  | Const (c,u), EvalConstRef c' when eq_constant c c' -> Some u
-  | Var id, EvalVarRef id' when id_eq id id' -> Some EInstance.empty
+  | Const (c,u), EvalConstRef c' when Constant.equal c c' -> Some u
+  | Var id, EvalVarRef id' when Id.equal id id' -> Some EInstance.empty
   | _, _ -> None
 
 let substlin env sigma evalref n (nowhere_except_in,locs) c =
@@ -1103,7 +1101,7 @@ let unfoldoccs env sigma (occs,name) c =
     | [] -> ()
     | _ -> error_invalid_occurrence rest
     in
-    nf_betaiotazeta sigma uc
+    nf_betaiotazeta env sigma uc
   in
   match occs with
     | NoOccurrences -> c
@@ -1284,7 +1282,7 @@ let reduce_to_ref_gen allow_product env sigma ref t =
 	    else raise Not_found
 	  with Not_found ->
           try
-	    let t' = nf_betaiota sigma (one_step_reduce env sigma t) in
+            let t' = nf_betaiota env sigma (one_step_reduce env sigma t) in
             elimrec env t' l
           with NotStepReducible -> error_cannot_recognize ref
   in
diff --git a/pretyping/tacred.mli b/pretyping/tacred.mli
index 91726e8c6..a6b8262f7 100644
--- a/pretyping/tacred.mli
+++ b/pretyping/tacred.mli
@@ -15,6 +15,7 @@ open Pattern
 open Globnames
 open Locus
 open Univ
+open Ltac_pretype
 
 type reduction_tactic_error =
     InvalidAbstraction of env * evar_map * constr * (env * Type_errors.type_error)
diff --git a/pretyping/typeclasses.ml b/pretyping/typeclasses.ml
index 375a8a983..3f947fd23 100644
--- a/pretyping/typeclasses.ml
+++ b/pretyping/typeclasses.ml
@@ -11,6 +11,7 @@ open Names
 open Globnames
 open Decl_kinds
 open Term
+open Constr
 open Vars
 open Evd
 open Util
@@ -64,14 +65,14 @@ type typeclass = {
   cl_impl : global_reference;
 
   (* Context in which the definitions are typed. Includes both typeclass parameters and superclasses. *)
-  cl_context : (global_reference * bool) option list * Context.Rel.t;
+  cl_context : global_reference option list * Context.Rel.t;
 
   (* Context of definitions and properties on defs, will not be shared *)
   cl_props : Context.Rel.t;
 
   (* The method implementaions as projections. *)
   cl_projs : (Name.t * (direction * Vernacexpr.hint_info_expr) option
-	      * constant option) list;
+	      * Constant.t option) list;
   
   cl_strict : bool;
 
@@ -86,7 +87,6 @@ type instance = {
   (* Sections where the instance should be redeclared,
      None for discard, Some 0 for none. *)
   is_global: int option;
-  is_poly: bool;
   is_impl: global_reference;
 }
 
@@ -96,7 +96,7 @@ let instance_impl is = is.is_impl
 
 let hint_priority is = is.is_info.Vernacexpr.hint_priority
 
-let new_instance cl info glob poly impl =
+let new_instance cl info glob impl =
   let global =
     if glob then Some (Lib.sections_depth ())
     else None
@@ -106,7 +106,6 @@ let new_instance cl info glob poly impl =
     { is_class = cl.cl_impl;
       is_info = info ;
       is_global = global ;
-      is_poly = poly;
       is_impl = impl }
 
 (*
@@ -174,7 +173,7 @@ let subst_class (subst,cl) =
   and do_subst_gr gr = fst (subst_global subst gr) 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,
+    List.smartmap (Option.smartmap do_subst_gr) grs,
     do_subst_ctx ctx in
   let do_subst_projs projs = List.smartmap (fun (x, y, z) -> 
     (x, y, Option.smartmap do_subst_con z)) projs in
@@ -212,15 +211,16 @@ let discharge_class (_,cl) =
       let newgrs = List.map (fun decl ->
 			     match decl |> RelDecl.get_type |> EConstr.of_constr |> class_of_constr Evd.empty with
 			     | None -> None
-			     | Some (_, ((tc,_), _)) -> Some (tc.cl_impl, true))
+                             | Some (_, ((tc,_), _)) -> Some tc.cl_impl)
 			    ctx'
       in
-      List.smartmap (Option.smartmap (fun (gr, b) -> Lib.discharge_global gr, b)) grs
+      List.smartmap (Option.smartmap Lib.discharge_global) grs
       @ newgrs
     in grs', discharge_rel_context subst 1 ctx @ ctx' in
   let cl_impl' = Lib.discharge_global cl.cl_impl in
   if cl_impl' == cl.cl_impl then cl else
-    let ctx, _, _ as info = abs_context cl in
+    let info = abs_context cl in
+    let ctx = info.Lib.abstr_ctx in
     let ctx, subst = rel_of_variable_context ctx in
     let usubst, cl_univs' = Lib.discharge_abstract_universe_context info cl.cl_univs in
     let context = discharge_context ctx (subst, usubst) cl.cl_context in
@@ -419,7 +419,7 @@ let declare_instance info local glob =
     match class_of_constr Evd.empty (EConstr.of_constr ty) with
     | Some (rels, ((tc,_), args) as _cl) ->
       assert (not (isVarRef glob) || local);
-      add_instance (new_instance tc info (not local) (Flags.use_polymorphic_flag ()) glob)
+      add_instance (new_instance tc info (not local) glob)
     | None -> ()
 
 let add_class cl =
@@ -441,19 +441,20 @@ let add_class cl =
 
 let instance_constructor (cl,u) args =
   let lenpars = List.count is_local_assum (snd cl.cl_context) in
+  let open EConstr in
   let pars = fst (List.chop lenpars args) in
     match cl.cl_impl with
       | IndRef ind -> 
         let ind = ind, u in
-          (Some (applistc (mkConstructUi (ind, 1)) args),
-	   applistc (mkIndU ind) pars)
+          (Some (applist (mkConstructUi (ind, 1), args)),
+           applist (mkIndU ind, pars))
       | ConstRef cst -> 
         let cst = cst, u in
 	let term = match args with
 	  | [] -> None
 	  | _ -> Some (List.last args)
 	in
-	  (term, applistc (mkConstU cst) pars)
+          (term, applist (mkConstU cst, pars))
       | _ -> assert false
 
 let typeclasses () = Refmap.fold (fun _ l c -> l :: c) !classes []
@@ -520,7 +521,7 @@ let mark_unresolvable evi = mark_resolvability false evi
 let mark_resolvable evi = mark_resolvability true evi
 
 open Evar_kinds
-type evar_filter = existential_key -> Evar_kinds.t -> bool
+type evar_filter = Evar.t -> Evar_kinds.t -> bool
 
 let all_evars _ _ = true
 let all_goals _ = function VarInstance _ | GoalEvar -> true | _ -> false
@@ -551,8 +552,8 @@ 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 solve_classeskey = CProfile.declare_profile "solve_typeclasses" *)
+(* let solve_problem = CProfile.profile5 solve_classeskey solve_problem *)
 
 let resolve_typeclasses ?(fast_path = true) ?(filter=no_goals) ?(unique=get_typeclasses_unique_solutions ())
     ?(split=true) ?(fail=true) env evd =
diff --git a/pretyping/typeclasses.mli b/pretyping/typeclasses.mli
index 99cdbd3a3..ee28ec173 100644
--- a/pretyping/typeclasses.mli
+++ b/pretyping/typeclasses.mli
@@ -8,7 +8,7 @@
 
 open Names
 open Globnames
-open Term
+open Constr
 open Evd
 open Environ
 
@@ -25,9 +25,8 @@ type typeclass = {
   cl_impl : global_reference;
 
   (** Context in which the definitions are typed. Includes both typeclass parameters and superclasses.
-     The boolean indicates if the typeclass argument is a direct superclass and the global reference
-     gives a direct link to the class itself. *)
-  cl_context : (global_reference * bool) option list * Context.Rel.t;
+      The global reference gives a direct link to the class itself. *)
+  cl_context : global_reference option list * Context.Rel.t;
 
   (** Context of definitions and properties on defs, will not be shared *)
   cl_props : Context.Rel.t;
@@ -36,7 +35,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 * Vernacexpr.hint_info_expr) option * constant option) list;
+  cl_projs : (Name.t * (direction * Vernacexpr.hint_info_expr) option * Constant.t option) list;
 
   (** Whether we use matching or full unification during resolution *)
   cl_strict : bool; 
@@ -54,7 +53,7 @@ val all_instances : unit -> instance list
 
 val add_class : typeclass -> unit
 
-val new_instance : typeclass -> Vernacexpr.hint_info_expr -> bool -> Decl_kinds.polymorphic ->
+val new_instance : typeclass -> Vernacexpr.hint_info_expr -> bool ->
   global_reference -> instance
 val add_instance : instance -> unit
 val remove_instance : instance -> unit
@@ -68,7 +67,7 @@ val class_info : global_reference -> typeclass (** raises a UserError if not a c
 val dest_class_app : env -> evar_map -> EConstr.constr -> (typeclass * EConstr.EInstance.t) * constr list
 
 (** Get the instantiated typeclass structure for a given universe instance. *)
-val typeclass_univ_instance : typeclass puniverses -> typeclass
+val typeclass_univ_instance : typeclass Univ.puniverses -> typeclass
 
 (** Just return None if not a class *)
 val class_of_constr : evar_map -> EConstr.constr -> (EConstr.rel_context * ((typeclass * EConstr.EInstance.t) * constr list)) option
@@ -83,11 +82,11 @@ val is_instance : global_reference -> bool
 (** Returns the term and type for the given instance of the parameters and fields
    of the type class. *)
 
-val instance_constructor : typeclass puniverses -> constr list -> 
-  constr option * types
+val instance_constructor : typeclass EConstr.puniverses -> EConstr.t list ->
+  EConstr.t option * EConstr.t
 
 (** Filter which evars to consider for resolution. *)
-type evar_filter = existential_key -> Evar_kinds.t -> bool
+type evar_filter = Evar.t -> Evar_kinds.t -> bool
 val all_evars : evar_filter
 val all_goals : evar_filter
 val no_goals : evar_filter
diff --git a/pretyping/typing.ml b/pretyping/typing.ml
index 1f35fa19a..3cc152017 100644
--- a/pretyping/typing.ml
+++ b/pretyping/typing.ml
@@ -23,11 +23,6 @@ open Arguments_renaming
 open Pretype_errors
 open Context.Rel.Declaration
 
-let push_rec_types pfix env =
-  let (i, c, t) = pfix in
-  let inj c = EConstr.Unsafe.to_constr c in
-  push_rec_types (i, Array.map inj c, Array.map inj t) env
-
 let meta_type evd mv =
   let ty =
     try Evd.meta_ftype evd mv
@@ -39,7 +34,7 @@ let inductive_type_knowing_parameters env sigma (ind,u) jl =
   let u = Unsafe.to_instance u in
   let mspec = lookup_mind_specif env ind in
   let paramstyp = Array.map (fun j -> lazy (EConstr.to_constr sigma j.uj_type)) jl in
-  EConstr.of_constr (Inductive.type_of_inductive_knowing_parameters env (mspec,u) paramstyp)
+  Inductive.type_of_inductive_knowing_parameters env (mspec,u) paramstyp
 
 let e_type_judgment env evdref j =
   match EConstr.kind !evdref (whd_all env !evdref j.uj_type) with
@@ -54,6 +49,30 @@ let e_assumption_of_judgment env evdref j =
   with Type_errors.TypeError _ | PretypeError _ ->
     error_assumption env !evdref j
 
+let e_judge_of_applied_inductive_knowing_parameters env evdref funj ind argjv =
+  let rec apply_rec n typ = function
+  | [] ->
+      { uj_val  = mkApp (j_val funj, Array.map j_val argjv);
+        uj_type =
+          let ar = inductive_type_knowing_parameters env !evdref ind argjv in
+          hnf_prod_appvect env !evdref (EConstr.of_constr ar) (Array.map j_val argjv) }
+  | hj::restjl ->
+      match EConstr.kind !evdref (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
+         else
+           error_cant_apply_bad_type env !evdref (n, c1, hj.uj_type) funj argjv
+      | Evar ev ->
+          let (evd',t) = Evardefine.define_evar_as_product !evdref ev in
+          evdref := evd';
+          let (_,_,c2) = destProd evd' t in
+          apply_rec (n+1) (subst1 hj.uj_val c2) restjl
+      | _ ->
+          error_cant_apply_not_functional env !evdref funj argjv
+  in
+  apply_rec 1 funj.uj_type (Array.to_list argjv)
+
 let e_judge_of_apply env evdref funj argjv =
   let rec apply_rec n typ = function
   | [] ->
@@ -160,7 +179,7 @@ let check_type_fixpoint ?loc env evdref lna lar vdefj =
 (* 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
-  let ksort = family_of_sort (ESorts.kind sigma (sort_of_arity env sigma pj.uj_type)) in
+  let ksort = Sorts.family (ESorts.kind sigma (sort_of_arity env sigma pj.uj_type)) in
   let specif = Global.lookup_inductive (fst ind) in
   let sorts = elim_sorts specif in
   if not (List.exists ((==) ksort) sorts) then
@@ -195,11 +214,11 @@ let check_cofix env sigma pcofix =
 
 let judge_of_prop =
   { uj_val = EConstr.mkProp;
-    uj_type = EConstr.mkSort type1_sort }
+    uj_type = EConstr.mkSort Sorts.type1 }
 
 let judge_of_set =
   { uj_val = EConstr.mkSet;
-    uj_type = EConstr.mkSort type1_sort }
+    uj_type = EConstr.mkSort Sorts.type1 }
 
 let judge_of_prop_contents = function
   | Null -> judge_of_prop
@@ -305,16 +324,14 @@ let rec execute env evdref cstr =
 
     | App (f,args) ->
         let jl = execute_array env evdref args in
-	let j =
-	  match EConstr.kind !evdref f with
-	    | Ind (ind, u) when EInstance.is_empty u && Environ.template_polymorphic_ind ind env ->
-		make_judge f
-		  (inductive_type_knowing_parameters env !evdref (ind, u) jl)
-	    | _ ->
-                (* No template polymorphism *)
-		execute env evdref f
-	in
-	e_judge_of_apply env evdref j jl
+        (match EConstr.kind !evdref f with
+            | Ind (ind, u) when EInstance.is_empty u && Environ.template_polymorphic_ind ind env ->
+               let fj = execute env evdref f in
+               e_judge_of_applied_inductive_knowing_parameters env evdref fj (ind, u) jl
+            | _ ->
+               (* No template polymorphism *)
+               let fj = execute env evdref f in
+               e_judge_of_apply env evdref fj jl)
 
     | Lambda (name,c1,c2) ->
         let j = execute env evdref c1 in
diff --git a/pretyping/typing.mli b/pretyping/typing.mli
index 1e2078826..153a48a71 100644
--- a/pretyping/typing.mli
+++ b/pretyping/typing.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
 open EConstr
 open Evd
@@ -26,7 +26,7 @@ val type_of : ?refresh:bool -> env -> evar_map -> constr -> evar_map * types
 val e_type_of : ?refresh:bool -> env -> evar_map ref -> constr -> types
 
 (** Typecheck a type and return its sort *)
-val e_sort_of : env -> evar_map ref -> types -> sorts
+val e_sort_of : env -> evar_map ref -> types -> Sorts.t
 
 (** Typecheck a term has a given type (assuming the type is OK) *)
 val e_check   : env -> evar_map ref -> constr -> types -> unit
@@ -53,3 +53,4 @@ val judge_of_abstraction : Environ.env -> Name.t ->
   unsafe_type_judgment -> unsafe_judgment -> unsafe_judgment
 val judge_of_product : Environ.env -> Name.t ->
   unsafe_type_judgment -> unsafe_type_judgment -> unsafe_judgment
+val judge_of_projection : env -> evar_map -> projection -> unsafe_judgment -> unsafe_judgment
diff --git a/pretyping/unification.ml b/pretyping/unification.ml
index f090921e5..e1720ec95 100644
--- a/pretyping/unification.ml
+++ b/pretyping/unification.ml
@@ -6,13 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-module CVars = Vars
-
 open CErrors
 open Pp
 open Util
 open Names
-open Term
+open Constr
 open Termops
 open Environ
 open EConstr
@@ -68,10 +66,10 @@ let _ = Goptions.declare_bool_option {
 
 let unsafe_occur_meta_or_existential c =
   let c = EConstr.Unsafe.to_constr c in
-  let rec occrec c = match kind_of_term c with
+  let rec occrec c = match Constr.kind c with
     | Evar _ -> raise Occur
     | Meta _ -> raise Occur
-    | _ -> iter_constr occrec c
+    | _ -> Constr.iter occrec c
   in try occrec c; false with Occur -> true
 
 
@@ -79,7 +77,7 @@ let occur_meta_or_undefined_evar evd c =
   (** This is performance-critical. Using the evar-insensitive API changes the
       resulting heuristic. *)
   let c = EConstr.Unsafe.to_constr c in
-  let rec occrec c = match kind_of_term c with
+  let rec occrec c = match Constr.kind c with
     | Meta _ -> raise Occur
     | Evar (ev,args) ->
         (match evar_body (Evd.find evd ev) with
@@ -194,6 +192,10 @@ let pose_all_metas_as_evars env evd t =
         let {rebus=ty;freemetas=mvs} = Evd.meta_ftype evd mv in
         let ty = EConstr.of_constr ty in
         let ty = if Evd.Metaset.is_empty mvs then ty else aux ty in
+        let ty =
+          if Flags.version_strictly_greater Flags.V8_6 || Flags.version_less_or_equal Flags.VOld
+          then nf_betaiota env evd ty (* How it was in Coq <= 8.4 (but done in logic.ml at this time) *)
+          else ty (* some beta-iota-normalization "regression" in 8.5 and 8.6 *) in
         let src = Evd.evar_source_of_meta mv !evdref in
         let ev = Evarutil.e_new_evar env evdref ~src ty in
         evdref := meta_assign mv (EConstr.Unsafe.to_constr ev,(Conv,TypeNotProcessed)) !evdref;
@@ -501,6 +503,10 @@ let expand_key ts env sigma = function
     in if EConstr.eq_constr sigma (EConstr.mkProj (p, c)) red then None else Some red
   | None -> None
 
+let isApp_or_Proj sigma c =
+  match kind sigma c with
+  | App _ | Proj _ -> true
+  | _ -> false
   
 type unirec_flags = {
   at_top: bool;
@@ -550,10 +556,10 @@ let oracle_order env cf1 cf2 =
       | Some k2 ->
 	match k1, k2 with
 	| IsProj (p, _), IsKey (ConstKey (p',_)) 
-	  when eq_constant (Projection.constant p) p' -> 
+	  when Constant.equal (Projection.constant p) p' -> 
 	  Some (not (Projection.unfolded p))
 	| IsKey (ConstKey (p,_)), IsProj (p', _) 
-	  when eq_constant p (Projection.constant p') -> 
+	  when Constant.equal p (Projection.constant p') -> 
 	  Some (Projection.unfolded p')
 	| _ ->
           Some (Conv_oracle.oracle_order (fun x -> x)
@@ -565,7 +571,9 @@ let is_rigid_head sigma flags t =
   | Ind (i,u) -> true
   | Construct _ -> true
   | Fix _ | CoFix _ -> true
-  | _ -> false
+  | Rel _ | Var _ | Meta _ | Evar _ | Sort _ | Cast (_, _, _) | Prod (_, _, _)
+    | Lambda (_, _, _) | LetIn (_, _, _, _) | App (_, _) | Case (_, _, _, _)
+    | Proj (_, _) -> false (* Why aren't Prod, Sort rigid heads ? *)
 
 let force_eqs c = 
   Universes.Constraints.fold
@@ -605,7 +613,7 @@ let subst_defined_metas_evars sigma (bl,el) c =
   (** This seems to be performance-critical, and using the evar-insensitive
       primitives blow up the time passed in this function. *)
   let c = EConstr.Unsafe.to_constr c in
-  let rec substrec c = match kind_of_term c with
+  let rec substrec c = match Constr.kind c with
     | Meta i ->
       let select (j,_,_) = Int.equal i j in
       substrec (EConstr.Unsafe.to_constr (pi2 (List.find select bl)))
@@ -646,14 +654,17 @@ let rec is_neutral env sigma ts t =
     | Evar _ | Meta _ -> true
     | Case (_, p, c, cl) -> is_neutral env sigma ts c
     | Proj (p, c) -> is_neutral env sigma ts c
-    | _ -> false
+    | Lambda _ | LetIn _ | Construct _ | CoFix _ -> false
+    | Sort _ | Cast (_, _, _) | Prod (_, _, _) | Ind _ -> false (* Really? *)
+    | Fix _ -> false (* This is an approximation *)
+    | App _ -> assert false
 
 let is_eta_constructor_app env sigma ts f l1 term =
   match EConstr.kind sigma f with
   | Construct (((_, i as ind), j), u) when i == 0 && j == 1 ->
     let mib = lookup_mind (fst ind) env in
       (match mib.Declarations.mind_record with
-      | Some (Some (_,exp,projs)) when mib.Declarations.mind_finite == Decl_kinds.BiFinite &&
+      | Some (Some (_,exp,projs)) when mib.Declarations.mind_finite == Declarations.BiFinite &&
           Array.length projs == Array.length l1 - mib.Declarations.mind_nparams ->
 	(** Check that the other term is neutral *)
 	is_neutral env sigma ts term
@@ -780,7 +791,7 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst : subst0) conv_at_top e
 	| _, LetIn (_,a,_,c) -> unirec_rec curenvnb pb opt substn cM (subst1 a c)
 
 	(** Fast path for projections. *)
-	| Proj (p1,c1), Proj (p2,c2) when eq_constant
+	| Proj (p1,c1), Proj (p2,c2) when Constant.equal
 	    (Projection.constant p1) (Projection.constant p2) ->
 	  (try unify_same_proj curenvnb cv_pb {opt with at_top = true}
 	       substn c1 c2
@@ -1020,7 +1031,7 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst : subst0) conv_at_top e
 
   and canonical_projections (curenv, _ as curenvnb) pb opt cM cN (sigma,_,_ as substn) =
     let f1 () =
-      if isApp sigma cM then
+      if isApp_or_Proj sigma cM then
 	let f1l1 = whd_nored_state sigma (cM,Stack.empty) in
 	  if is_open_canonical_projection curenv sigma f1l1 then
 	    let f2l2 = whd_nored_state sigma (cN,Stack.empty) in
@@ -1036,7 +1047,7 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst : subst0) conv_at_top e
 	error_cannot_unify (fst curenvnb) sigma (cM,cN)
       else
 	try f1 () with e when precatchable_exception e ->
-	  if isApp sigma cN then
+	  if isApp_or_Proj sigma cN then
 	    let f2l2 = whd_nored_state sigma (cN, Stack.empty) in
 	      if is_open_canonical_projection curenv sigma f2l2 then
 		let f1l1 = whd_nored_state sigma (cM, Stack.empty) in
@@ -1064,13 +1075,13 @@ let rec unify_0_with_initial_metas (sigma,ms,es as subst : subst0) conv_at_top e
       in
       try
       let opt' = {opt with with_types = false} in
-      let (substn,_,_) = Reductionops.Stack.fold2
+      let substn = Reductionops.Stack.fold2
 			   (fun s u1 u -> unirec_rec curenvnb pb opt' s u1 (substl ks u))
 			   (evd,ms,es) us2 us in
-      let (substn,_,_) = Reductionops.Stack.fold2
+      let substn = Reductionops.Stack.fold2
 			   (fun s u1 u -> unirec_rec curenvnb pb opt' s u1 (substl ks u))
 			   substn params1 params in
-      let (substn,_,_) = Reductionops.Stack.fold2 (fun s u1 u2 -> unirec_rec curenvnb pb opt' s u1 u2) substn ts ts1 in
+      let substn = Reductionops.Stack.fold2 (fun s u1 u2 -> unirec_rec curenvnb pb opt' s u1 u2) substn ts ts1 in
       let app = mkApp (c, Array.rev_of_list ks) in
       (* let substn = unirec_rec curenvnb pb b false substn t cN in *)
 	unirec_rec curenvnb pb opt' substn c1 app
@@ -1266,7 +1277,7 @@ let w_coerce env evd mv c =
 let unify_to_type env sigma flags c status u =
   let sigma, c = refresh_universes (Some false) env sigma c in
   let t = get_type_of env sigma (nf_meta sigma c) in
-  let t = nf_betaiota sigma (nf_meta sigma t) in
+  let t = nf_betaiota env sigma (nf_meta sigma t) in
     unify_0 env sigma CUMUL flags t u
 
 let unify_type env sigma flags mv status c =
@@ -1514,7 +1525,7 @@ let indirectly_dependent sigma c d decls =
 let finish_evar_resolution ?(flags=Pretyping.all_and_fail_flags) env current_sigma (pending,c) =
   let sigma = Pretyping.solve_remaining_evars flags env current_sigma pending in
   let sigma, subst = nf_univ_variables sigma in
-  (sigma, EConstr.of_constr (CVars.subst_univs_constr subst (EConstr.Unsafe.to_constr (nf_evar sigma c))))
+  (sigma, EConstr.of_constr (Universes.subst_univs_constr subst (EConstr.Unsafe.to_constr (nf_evar sigma c))))
 
 let default_matching_core_flags sigma =
   let ts = Names.full_transparent_state in {
@@ -1604,7 +1615,7 @@ let make_pattern_test from_prefix_of_ind is_correct_type env sigma (pending,c) =
   | Some (sigma,_,l) ->
      let c = applist (nf_evar sigma (local_strong whd_meta sigma c), l) in
      let univs, subst = nf_univ_variables sigma in
-     Some (sigma,EConstr.of_constr (CVars.subst_univs_constr subst (EConstr.Unsafe.to_constr c))))
+     Some (sigma,EConstr.of_constr (Universes.subst_univs_constr subst (EConstr.Unsafe.to_constr c))))
 
 let make_eq_test env evd c =
   let out cstr =
@@ -1616,11 +1627,11 @@ let make_abstraction_core name (test,out) env sigma c ty occs check_occs concl =
   let id =
     let t = match ty with Some t -> t | None -> get_type_of env sigma c in
     let x = id_of_name_using_hdchar (Global.env()) sigma t name in
-    let ids = ids_of_named_context (named_context env) in
+    let ids = Environ.ids_of_named_context_val (named_context_val env) in
     if name == Anonymous then next_ident_away_in_goal x ids else
     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.")
+        (str "The variable " ++ Id.print x ++ str " is already declared.")
     else
       x
   in
@@ -1780,7 +1791,9 @@ let w_unify_to_subterm env evd ?(flags=default_unify_flags ()) (op,cl) =
 	       with ex when precatchable_exception ex ->
 		 matchrec c)
 
-          | _ -> user_err Pp.(str "Match_subterm")))
+          | Cast (_, _, _) (* Is this expected? *)
+          | Rel _ | Var _ | Meta _ | Evar _ | Sort _ | Const _ | Ind _
+            | Construct _ -> user_err Pp.(str "Match_subterm")))
   in
   try matchrec cl
   with ex when precatchable_exception ex ->
@@ -1846,7 +1859,11 @@ let w_unify_to_subterm_all env evd ?(flags=default_unify_flags ()) (op,cl) =
             | Lambda (_,t,c) ->
 		bind (matchrec t) (matchrec c)
 
-            | _ -> fail "Match_subterm"))
+          | Cast (_, _, _)  -> fail "Match_subterm" (* Is this expected? *)
+
+          | Rel _ | Var _ | Meta _ | Evar _ | Sort _ | Const _ | Ind _
+            | Construct _ -> fail "Match_subterm"))
+
   in
   let res = matchrec cl [] in
   match res with
@@ -1996,8 +2013,8 @@ let w_unify env evd cv_pb flags ty1 ty2 =
 
 let w_unify = 
   if Flags.profile then
-    let wunifkey = Profile.declare_profile "w_unify" in
-      Profile.profile6 wunifkey w_unify
+    let wunifkey = CProfile.declare_profile "w_unify" in
+      CProfile.profile6 wunifkey w_unify
   else w_unify
 
 let w_unify env evd cv_pb ?(flags=default_unify_flags ()) ty1 ty2 =
diff --git a/pretyping/unification.mli b/pretyping/unification.mli
index fce17d564..085e8c5b8 100644
--- a/pretyping/unification.mli
+++ b/pretyping/unification.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Term
+open Constr
 open EConstr
 open Environ
 open Evd
diff --git a/pretyping/univdecls.ml b/pretyping/univdecls.ml
new file mode 100644
index 000000000..89f1185a9
--- /dev/null
+++ b/pretyping/univdecls.ml
@@ -0,0 +1,50 @@
+(************************************************************************)
+(*  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 CErrors
+
+(** Local universes and constraints declarations *)
+type universe_decl =
+  (Misctypes.lident list, Univ.Constraint.t) Misctypes.gen_universe_decl
+
+let default_univ_decl =
+  let open Misctypes in
+  { univdecl_instance = [];
+    univdecl_extensible_instance = true;
+    univdecl_constraints = Univ.Constraint.empty;
+    univdecl_extensible_constraints = true }
+
+let interp_univ_constraints env evd cstrs =
+  let interp (evd,cstrs) (u, d, u') =
+    let ul = Pretyping.interp_known_glob_level evd u in
+    let u'l = Pretyping.interp_known_glob_level evd u' in
+    let cstr = (ul,d,u'l) in
+    let cstrs' = Univ.Constraint.add cstr cstrs in
+    try let evd = Evd.add_constraints evd (Univ.Constraint.singleton cstr) in
+        evd, cstrs'
+    with Univ.UniverseInconsistency e ->
+      user_err ~hdr:"interp_constraint"
+        (Univ.explain_universe_inconsistency (Termops.pr_evd_level evd) e)
+  in
+  List.fold_left interp (evd,Univ.Constraint.empty) cstrs
+
+let interp_univ_decl env decl =
+  let open Misctypes in
+  let pl : lident list = decl.univdecl_instance in
+  let evd = Evd.from_ctx (Evd.make_evar_universe_context env (Some pl)) in
+  let evd, cstrs = interp_univ_constraints env evd decl.univdecl_constraints in
+  let decl = { univdecl_instance = pl;
+    univdecl_extensible_instance = decl.univdecl_extensible_instance;
+    univdecl_constraints = cstrs;
+    univdecl_extensible_constraints = decl.univdecl_extensible_constraints }
+  in evd, decl
+
+let interp_univ_decl_opt env l =
+  match l with
+  | None -> Evd.from_env env, default_univ_decl
+  | Some decl -> interp_univ_decl env decl
diff --git a/pretyping/univdecls.mli b/pretyping/univdecls.mli
new file mode 100644
index 000000000..706d3a157
--- /dev/null
+++ b/pretyping/univdecls.mli
@@ -0,0 +1,19 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(** Local universe and constraint declarations. *)
+type universe_decl =
+  (Misctypes.lident list, Univ.Constraint.t) Misctypes.gen_universe_decl
+
+val default_univ_decl : universe_decl
+
+val interp_univ_decl : Environ.env -> Vernacexpr.universe_decl_expr ->
+                       Evd.evar_map * universe_decl
+
+val interp_univ_decl_opt : Environ.env -> Vernacexpr.universe_decl_expr option ->
+                       Evd.evar_map * universe_decl
diff --git a/pretyping/vnorm.ml b/pretyping/vnorm.ml
index 66cc42cb6..c93b41786 100644
--- a/pretyping/vnorm.ml
+++ b/pretyping/vnorm.ml
@@ -10,10 +10,12 @@ open Util
 open Names
 open Declarations
 open Term
+open Constr
 open Vars
 open Environ
 open Inductive
 open Reduction
+open Vmvalues
 open Vm
 open Context.Rel.Declaration
 
@@ -51,7 +53,7 @@ let invert_tag cst tag reloc_tbl =
 
 let find_rectype_a env c =
   let (t, l) = decompose_appvect (whd_all env c) in
-  match kind_of_term t with
+  match kind t with
   | Ind ind -> (ind, l)
   | _ -> assert false
 
@@ -133,7 +135,7 @@ let build_case_type dep p realargs c =
 
 (* La fonction de normalisation *)
 
-let rec nf_val env sigma v t = nf_whd env sigma (whd_val v) t
+let rec nf_val env sigma v t = nf_whd env sigma (Vmvalues.whd_val v) t
 
 and nf_vtype env sigma v =  nf_val env sigma v crazy_type
 
@@ -143,7 +145,7 @@ and nf_whd env sigma whd typ =
   | Vprod p ->
       let dom = nf_vtype env sigma (dom p) in
       let name = Name (Id.of_string "x") in
-      let vc = body_of_vfun (nb_rel env) (codom p) in
+      let vc = reduce_fun (nb_rel env) (codom p) in
       let codom = nf_vtype (push_rel (LocalAssum (name,dom)) env) sigma vc  in
       mkProd(name,dom,codom)
   | Vfun f -> nf_fun env sigma f typ
@@ -190,7 +192,7 @@ and nf_univ_args ~nb_univs mk env sigma stk =
     else match stk with
     | Zapp args :: _ ->
        let inst =
-	 Array.init nb_univs (fun i -> Vm.uni_lvl_val (arg args i))
+         Array.init nb_univs (fun i -> uni_lvl_val (arg args i))
        in
        Univ.Instance.of_array inst
     | _ -> assert false
@@ -238,8 +240,9 @@ and nf_stk ?from:(from=0) env sigma c t stk  =
       let (mib,mip) = Inductive.lookup_mind_specif env ind in
       let nparams = mib.mind_nparams in
       let params,realargs = Util.Array.chop nparams allargs in
+      let nparamdecls = Context.Rel.length (Inductive.inductive_paramdecls (mib,u)) in
       let pT =
-	hnf_prod_applist env (type_of_ind env (ind,u)) (Array.to_list params) in
+        hnf_prod_applist_assum env nparamdecls (type_of_ind env (ind,u)) (Array.to_list params) in
       let pT = whd_all env pT in
       let dep, p = nf_predicate env sigma (ind,u) mip params (type_of_switch sw) pT in
       (* Calcul du type des branches *)
@@ -253,7 +256,7 @@ and nf_stk ?from:(from=0) env sigma c t stk  =
       in
       let branchs = Array.mapi mkbranch bsw in
       let tcase = build_case_type dep p realargs c in
-      let ci = case_info sw in
+      let ci = sw.sw_annot.Cbytecodes.ci in
       nf_stk env sigma (mkCase(ci, p, c, branchs)) tcase stk
   | Zproj p :: stk ->
      assert (from = 0) ;
@@ -262,17 +265,17 @@ and nf_stk ?from:(from=0) env sigma c t stk  =
      nf_stk env sigma (mkProj(p',c)) ty stk
 
 and nf_predicate env sigma ind mip params v pT =
-  match whd_val v, kind_of_term pT with
+  match whd_val v, kind pT with
   | Vfun f, Prod _ ->
       let k = nb_rel env in
-      let vb = body_of_vfun k f in
+      let vb = reduce_fun k f in
       let name,dom,codom = decompose_prod env pT in
       let dep,body =
 	nf_predicate (push_rel (LocalAssum (name,dom)) env) sigma ind mip params vb codom in
       dep, mkLambda(name,dom,body)
   | Vfun f, _ ->
       let k = nb_rel env in
-      let vb = body_of_vfun k f in
+      let vb = reduce_fun k f in
       let name = Name (Id.of_string "c") in
       let n = mip.mind_nrealargs in
       let rargs = Array.init n (fun i -> mkRel (n-i)) in
@@ -306,7 +309,7 @@ and nf_bargs env sigma b ofs t =
 
 and nf_fun env sigma f typ =
   let k = nb_rel env in
-  let vb = body_of_vfun k f in
+  let vb = reduce_fun k f in
   let name,dom,codom =
     try decompose_prod env typ
     with DestKO ->
@@ -364,4 +367,4 @@ let vm_infer_conv ?(pb=Reduction.CUMUL) env sigma t1 t2 =
   Reductionops.infer_conv_gen (fun pb ~l2r sigma ts -> Vconv.vm_conv_gen pb)
     ~catch_incon:true ~pb env sigma t1 t2
 
-let _ = Reductionops.set_vm_infer_conv vm_infer_conv
+let _ = if Coq_config.bytecode_compiler then Reductionops.set_vm_infer_conv vm_infer_conv
diff --git a/printing/genprint.ml b/printing/genprint.ml
index 543b05024..37a94fe21 100644
--- a/printing/genprint.ml
+++ b/printing/genprint.ml
@@ -8,13 +8,106 @@
 
 open Pp
 open Genarg
+open Geninterp
 
-type 'a printer = 'a -> Pp.t
+(* We register printers at two levels:
+   - generic arguments for general printers
+   - generic values for printing ltac values *)
+
+(* Printing generic values *)
+
+type 'a with_level =
+  { default_already_surrounded : Notation_term.tolerability;
+    default_ensure_surrounded : Notation_term.tolerability;
+    printer : 'a }
+
+type printer_result =
+| PrinterBasic of (unit -> Pp.t)
+| PrinterNeedsLevel of (Notation_term.tolerability -> Pp.t) with_level
+
+type printer_fun_with_level = Environ.env -> Evd.evar_map -> Notation_term.tolerability -> Pp.t
+
+type top_printer_result =
+| TopPrinterBasic of (unit -> Pp.t)
+| TopPrinterNeedsContext of (Environ.env -> Evd.evar_map -> Pp.t)
+| TopPrinterNeedsContextAndLevel of printer_fun_with_level with_level
+
+type 'a printer = 'a -> printer_result
+
+type 'a top_printer = 'a -> top_printer_result
+
+module ValMap = ValTMap (struct type 'a t = 'a -> top_printer_result end)
+
+let print0_val_map = ref ValMap.empty
+
+let find_print_val_fun tag =
+  try ValMap.find tag !print0_val_map
+  with Not_found ->
+    let msg s = Pp.(str "print function not found for a value interpreted as " ++ str s ++ str ".") in
+    CErrors.anomaly (msg (Val.repr tag))
+
+let generic_val_print v =
+  let Val.Dyn (tag,v) = v in
+  find_print_val_fun tag v
+
+let register_val_print0 s pr =
+  print0_val_map := ValMap.add s pr !print0_val_map
+
+let combine_dont_needs pr_pair pr1 = function
+  | TopPrinterBasic pr2 ->
+     TopPrinterBasic (fun () -> pr_pair (pr1 ()) (pr2 ()))
+  | TopPrinterNeedsContext pr2 ->
+     TopPrinterNeedsContext (fun env sigma ->
+         pr_pair (pr1 ()) (pr2 env sigma))
+  | TopPrinterNeedsContextAndLevel { default_ensure_surrounded; printer } ->
+     TopPrinterNeedsContext (fun env sigma ->
+         pr_pair (pr1 ()) (printer env sigma default_ensure_surrounded))
+
+let combine_needs pr_pair pr1 = function
+  | TopPrinterBasic pr2 ->
+     TopPrinterNeedsContext (fun env sigma -> pr_pair (pr1 env sigma) (pr2 ()))
+  | TopPrinterNeedsContext pr2 ->
+     TopPrinterNeedsContext (fun env sigma ->
+         pr_pair (pr1 env sigma) (pr2 env sigma))
+  | TopPrinterNeedsContextAndLevel { default_ensure_surrounded; printer } ->
+     TopPrinterNeedsContext (fun env sigma ->
+         pr_pair (pr1 env sigma) (printer env sigma default_ensure_surrounded))
+
+let combine pr_pair pr1 v2 =
+  match pr1 with
+  | TopPrinterBasic pr1 ->
+     combine_dont_needs pr_pair pr1 (generic_val_print v2)
+  | TopPrinterNeedsContext pr1 ->
+     combine_needs pr_pair pr1 (generic_val_print v2)
+  | TopPrinterNeedsContextAndLevel { default_ensure_surrounded; printer } ->
+     combine_needs pr_pair (fun env sigma -> printer env sigma default_ensure_surrounded)
+       (generic_val_print v2)
+
+let _ =
+  let pr_cons a b = Pp.(a ++ spc () ++ b) in
+  register_val_print0 Val.typ_list
+    (function
+     | [] -> TopPrinterBasic mt
+     | a::l ->
+        List.fold_left (combine pr_cons) (generic_val_print a) l)
+
+let _ =
+  register_val_print0 Val.typ_opt
+    (function
+     | None -> TopPrinterBasic Pp.mt
+     | Some v -> generic_val_print v)
+
+let _ =
+  let pr_pair a b = Pp.(a ++ spc () ++ b) in
+  register_val_print0 Val.typ_pair
+    (fun (v1,v2) -> combine pr_pair (generic_val_print v1) v2)
+
+(* Printing generic arguments *)
 
 type ('raw, 'glb, 'top) genprinter = {
-  raw : 'raw printer;
-  glb : 'glb printer;
-  top : 'top printer;
+  raw : 'raw -> printer_result;
+  glb : 'glb -> printer_result;
+  top : 'top -> top_printer_result;
 }
 
 module PrintObj =
@@ -25,9 +118,9 @@ struct
   | ExtraArg tag ->
     let name = ArgT.repr tag in
     let printer = {
-      raw = (fun _ -> str "<genarg:" ++ str name ++ str ">");
-      glb = (fun _ -> str "<genarg:" ++ str name ++ str ">");
-      top = (fun _ -> str "<genarg:" ++ str name ++ str ">");
+      raw = (fun _ -> PrinterBasic (fun () -> str "<genarg:" ++ str name ++ str ">"));
+      glb = (fun _ -> PrinterBasic (fun () -> str "<genarg:" ++ str name ++ str ">"));
+      top = (fun _ -> TopPrinterBasic (fun () -> str "<genarg:" ++ str name ++ str ">"));
     } in
     Some printer
   | _ -> assert false
@@ -37,6 +130,18 @@ module Print = Register (PrintObj)
 
 let register_print0 wit raw glb top =
   let printer = { raw; glb; top; } in
+  Print.register0 wit printer;
+  match val_tag (Topwit wit), wit with
+  | Val.Base t, ExtraArg t' when Geninterp.Val.repr t = ArgT.repr t' ->
+     register_val_print0 t top
+  | _ ->
+     (* An alias, thus no primitive printer attached *)
+     ()
+
+let register_vernac_print0 wit raw =
+  let glb _ = CErrors.anomaly (Pp.str "vernac argument needs not globwit printer.") in
+  let top _ = CErrors.anomaly (Pp.str "vernac argument needs not wit printer.") in
+  let printer = { raw; glb; top; } in
   Print.register0 wit printer
 
 let raw_print wit v = (Print.obj wit).raw v
diff --git a/printing/genprint.mli b/printing/genprint.mli
index 130a89c92..baa60fcb2 100644
--- a/printing/genprint.mli
+++ b/printing/genprint.mli
@@ -10,20 +10,43 @@
 
 open Genarg
 
-type 'a printer = 'a -> Pp.t
+type 'a with_level =
+  { default_already_surrounded : Notation_term.tolerability;
+    default_ensure_surrounded : Notation_term.tolerability;
+    printer : 'a }
 
-val raw_print : ('raw, 'glb, 'top) genarg_type -> 'raw -> Pp.t
+type printer_result =
+| PrinterBasic of (unit -> Pp.t)
+| PrinterNeedsLevel of (Notation_term.tolerability -> Pp.t) with_level
+
+type printer_fun_with_level = Environ.env -> Evd.evar_map -> Notation_term.tolerability -> Pp.t
+
+type top_printer_result =
+| TopPrinterBasic of (unit -> Pp.t)
+| TopPrinterNeedsContext of (Environ.env -> Evd.evar_map -> Pp.t)
+| TopPrinterNeedsContextAndLevel of printer_fun_with_level with_level
+
+type 'a printer = 'a -> printer_result
+
+type 'a top_printer = 'a -> top_printer_result
+
+val raw_print : ('raw, 'glb, 'top) genarg_type -> 'raw printer
 (** Printer for raw level generic arguments. *)
 
-val glb_print : ('raw, 'glb, 'top) genarg_type -> 'glb -> Pp.t
+val glb_print : ('raw, 'glb, 'top) genarg_type -> 'glb printer
 (** Printer for glob level generic arguments. *)
 
-val top_print : ('raw, 'glb, 'top) genarg_type -> 'top -> Pp.t
+val top_print : ('raw, 'glb, 'top) genarg_type -> 'top top_printer
 (** Printer for top level generic arguments. *)
 
+val register_print0 : ('raw, 'glb, 'top) genarg_type ->
+  'raw printer -> 'glb printer -> 'top top_printer -> unit
+val register_val_print0 : 'top Geninterp.Val.typ ->
+  'top top_printer -> unit
+val register_vernac_print0 : ('raw, 'glb, 'top) genarg_type ->
+  'raw printer -> unit
+
 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 printer -> 'glb printer -> 'top printer -> unit
+val generic_top_print : tlevel generic_argument top_printer
+val generic_val_print : Geninterp.Val.t top_printer
diff --git a/printing/ppconstr.ml b/printing/ppconstr.ml
index 4a103cdd2..3c7095505 100644
--- a/printing/ppconstr.ml
+++ b/printing/ppconstr.ml
@@ -10,6 +10,7 @@
 open CErrors
 open Util
 open Pp
+open CAst
 open Names
 open Nameops
 open Libnames
@@ -86,8 +87,8 @@ let tag_var = tag Tag.variable
 
   open Notation
 
-  let print_hunks n pr pr_binders (terms, termlists, binders) unps =
-    let env = ref terms and envlist = ref termlists and bll = ref binders in
+  let print_hunks n pr pr_patt pr_binders (terms, termlists, binders, binderlists) unps =
+    let env = ref terms and envlist = ref termlists and bl = ref binders and bll = ref binderlists in
     let pop r = let a = List.hd !r in r := List.tl !r; a in
     let return unp pp1 pp2 = (tag_unparsing unp pp1) ++ pp2 in
     (* Warning:
@@ -102,6 +103,11 @@ let tag_var = tag Tag.variable
         let pp2 = aux l in
         let pp1 = pr (n, prec) c in
         return unp pp1 pp2
+      | UnpBinderMetaVar (_, prec) as unp :: l ->
+        let c = pop bl in
+        let pp2 = aux l in
+        let pp1 = pr_patt (n, prec) c in
+        return unp pp1 pp2
       | UnpListMetaVar (_, prec, sl) as unp :: l ->
         let cl = pop envlist in
         let pp1 = prlist_with_sep (fun () -> aux sl) (pr (n,prec)) cl in
@@ -117,7 +123,7 @@ let tag_var = tag Tag.variable
         let pp1 = str s in
         return unp pp1 pp2
       | UnpBox (b,sub) as unp :: l ->
-        let pp1 = ppcmd_of_box b (aux sub) in
+        let pp1 = ppcmd_of_box b (aux (List.map snd sub)) in
         let pp2 = aux l in
         return unp pp1 pp2
       | UnpCut cut as unp :: l ->
@@ -127,9 +133,9 @@ let tag_var = tag Tag.variable
     in
     aux unps
 
-  let pr_notation pr pr_binders s env =
+  let pr_notation pr pr_patt pr_binders s env =
     let unpl, level = find_notation_printing_rule s in
-    print_hunks level pr pr_binders env unpl, level
+    print_hunks level pr pr_patt pr_binders env unpl, level
 
   let pr_delimiters key strm =
     strm ++ str ("%"^key)
@@ -146,14 +152,19 @@ let tag_var = tag Tag.variable
     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.tag ?loc pp)
+  let pr_with_comments ?loc pp = pr_located (fun x -> x) (loc, pp)
 
   let pr_sep_com sep f c = pr_with_comments ?loc:(constr_loc c) (sep() ++ f c)
 
+  let pr_univ_expr = function
+    | Some (x,n) ->
+       pr_reference x ++ (match n with 0 -> mt () | _ -> str"+" ++ int n)
+    | None -> str"_"
+
   let pr_univ l =
     match l with
-      | [_,x] -> Name.print x
-      | l -> str"max(" ++ prlist_with_sep (fun () -> str",") (fun x -> Name.print (snd x)) l ++ str")"
+      | [x] -> pr_univ_expr x
+      | l -> str"max(" ++ prlist_with_sep (fun () -> str",") pr_univ_expr l ++ str")"
 
   let pr_univ_annot pr x = str "@{" ++ pr x ++ str "}"
 
@@ -166,22 +177,23 @@ let tag_var = tag Tag.variable
   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 (Name.print u)
+    | GType UUnknown -> tag_type (str "Type")
+    | GType UAnonymous -> tag_type (str "_")
+    | GType (UNamed u) -> tag_type (pr_reference u)
 
   let pr_qualid sp =
     let (sl, id) = repr_qualid sp in
-    let id = tag_ref (pr_id id) in
+    let id = tag_ref (Id.print id) in
     let sl = match List.rev (DirPath.repr sl) with
     | [] -> mt ()
     | sl ->
-      let pr dir = tag_path (pr_id dir) ++ str "." in
+      let pr dir = tag_path (Id.print dir) ++ str "." in
       prlist pr sl
     in
     sl ++ id
 
-  let pr_id = pr_id
-  let pr_name = pr_name
+  let pr_id = Id.print
+  let pr_name = Name.print
   let pr_qualid = pr_qualid
   let pr_patvar = pr_id
 
@@ -192,8 +204,9 @@ let tag_var = tag Tag.variable
       tag_type (str "Set")
     | GType u ->
       (match u with
-        | Some (_,u) -> Name.print u
-        | None -> tag_type (str "Type"))
+        | UNamed u -> pr_reference u
+        | UAnonymous -> tag_type (str "Type")
+        | UUnknown -> tag_type (str "_"))
 
   let pr_universe_instance l =
     pr_opt_no_spc (pr_univ_annot (prlist_with_sep spc pr_glob_sort_instance)) l
@@ -208,28 +221,28 @@ let tag_var = tag Tag.variable
   let pr_expl_args pr (a,expl) =
     match expl with
       | None -> pr (lapp,L) a
-      | Some (_,ExplByPos (n,_id)) ->
+      | Some {v=ExplByPos (n,_id)} ->
         anomaly (Pp.str "Explicitation by position not implemented.")
-      | Some (_,ExplByName id) ->
+      | Some {v=ExplByName id} ->
         str "(" ++ pr_id id ++ str ":=" ++ pr ltop a ++ str ")"
 
   let pr_opt_type_spc pr = function
     | { CAst.v = CHole (_,Misctypes.IntroAnonymous,_) } -> mt ()
     | t ->  str " :" ++ pr_sep_com (fun()->brk(1,2)) (pr ltop) t
 
-  let pr_lident (loc,id) =
+  let pr_lident {loc; v=id} =
     match loc with
     | None     -> pr_id id
     | Some loc -> let (b,_) = Loc.unloc loc in
-                  pr_located pr_id @@ Loc.tag ~loc:(Loc.make_loc (b,b + String.length (Id.to_string id))) id
+                  pr_located pr_id (Some (Loc.make_loc (b,b + String.length (Id.to_string id))), id)
 
   let pr_lname = function
-    | (loc,Name id) -> pr_lident (loc,id)
-    | lna -> pr_located Name.print lna
+    | {CAst.loc; v=Name id} -> pr_lident CAst.(make ?loc id)
+    | x -> pr_ast Name.print x
 
   let pr_or_var pr = function
     | ArgArg x -> pr x
-    | ArgVar (loc,s) -> pr_lident (loc,s)
+    | ArgVar id -> pr_lident id
 
   let pr_prim_token = function
     | Numeral (n,s) -> str (if s then n else "-"^n)
@@ -256,8 +269,8 @@ let tag_var = tag Tag.variable
         in
         str "{| " ++ prlist_with_sep pr_semicolon pp l ++ str " |}", lpatrec
 
-      | CPatAlias (p, id) ->
-        pr_patt mt (las,E) p ++ str " as " ++ pr_id id, las
+      | CPatAlias (p, na) ->
+        pr_patt mt (las,E) p ++ str " as " ++ pr_lname na, las
 
       | CPatCstr (c, None, []) ->
         pr_reference c, latom
@@ -279,13 +292,13 @@ let tag_var = tag Tag.variable
         pr_reference r, latom
 
       | CPatOr pl ->
-        hov 0 (prlist_with_sep pr_bar (pr_patt spc (lpator,L)) pl), lpator
+        hov 0 (prlist_with_sep pr_spcbar (pr_patt mt (lpator,L)) pl), lpator
 
       | CPatNotation ("( _ )",([p],[]),[]) ->
         pr_patt (fun()->str"(") (max_int,E) p ++ str")", latom
 
       | CPatNotation (s,(l,ll),args) ->
-        let strm_not, l_not = pr_notation (pr_patt mt) (fun _ _ _ -> mt()) s (l,ll,[]) in
+        let strm_not, l_not = pr_notation (pr_patt mt) (fun _ _ -> mt ()) (fun _ _ _ -> mt()) s (l,ll,[],[]) in
         (if List.is_empty args||prec_less l_not (lapp,L) then strm_not else surround strm_not)
         ++ prlist (pr_patt spc (lapp,L)) args, if not (List.is_empty args) then lapp else l_not
 
@@ -303,21 +316,20 @@ let tag_var = tag Tag.variable
 
   let pr_patt = pr_patt mt
 
-  let pr_eqn pr (loc,(pl,rhs)) =
-    let pl = List.map snd pl in
+  let pr_eqn pr {loc;v=(pl,rhs)} =
     spc() ++ hov 4
       (pr_with_comments ?loc
          (str "| " ++
-            hov 0 (prlist_with_sep pr_bar (prlist_with_sep sep_v (pr_patt ltop)) pl
+            hov 0 (prlist_with_sep pr_spcbar (prlist_with_sep sep_v (pr_patt ltop)) pl
                    ++ str " =>") ++
             pr_sep_com spc (pr ltop) rhs))
 
-  let begin_of_binder l_bi = 
+  let begin_of_binder l_bi =
     let b_loc l = fst (Option.cata Loc.unloc (0,0) l) in
     match l_bi with
-    | CLocalDef((loc,_),_,_) -> b_loc loc
-    | CLocalAssum((loc,_)::_,_,_) -> b_loc loc
-    | CLocalPattern(loc,(_,_)) -> b_loc loc
+    | CLocalDef({loc},_,_) -> b_loc loc
+    | CLocalAssum({loc}::_,_,_) -> b_loc loc
+    | CLocalPattern{loc} -> b_loc loc
     | _ -> assert false
 
   let begin_of_binders = function
@@ -339,12 +351,12 @@ let tag_var = tag Tag.variable
       | Generalized (b, b', t') ->
         assert (match b with Implicit -> true | _ -> false);
         begin match nal with
-          |[loc,Anonymous] ->
+          |[{loc; v=Anonymous}] ->
             hov 1 (str"`" ++ (surround_impl b'
                                 ((if t' then str "!" else mt ()) ++ pr t)))
-          |[loc,Name id] ->
+          |[{loc; v=Name id}] ->
             hov 1 (str "`" ++ (surround_impl b'
-                                 (pr_lident (loc,id) ++ str " : " ++
+                                 (pr_lident CAst.(make ?loc id) ++ str " : " ++
                                     (if t' then str "!" else mt()) ++ pr t)))
           |_ -> anomaly (Pp.str "List of generalized binders have alwais one element.")
         end
@@ -364,7 +376,7 @@ let tag_var = tag Tag.variable
       surround (pr_lname na ++
                 pr_opt_no_spc (fun t -> str " :" ++ ws 1 ++ pr_c t) topt ++
                 str" :=" ++ spc() ++ pr_c c)
-    | CLocalPattern (loc,(p,tyo)) ->
+    | CLocalPattern {CAst.loc; v = p,tyo} ->
       let p = pr_patt lsimplepatt p in
       match tyo with
         | None ->
@@ -380,76 +392,14 @@ let tag_var = tag Tag.variable
     match bl with
       | [CLocalAssum (nal,k,t)] ->
         kw n ++ pr_binder false pr_c (nal,k,t)
-      | (CLocalAssum _ | CLocalPattern _) :: _ as bdl ->
+      | (CLocalAssum _ | CLocalPattern _ | CLocalDef _) :: _ as bdl ->
         kw n ++ pr_undelimited_binders sep pr_c bdl
-      | _ -> assert false
+      | [] -> assert false
 
   let pr_binders_gen pr_c sep is_open =
     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 = let open CAst in function
-  (*  | CLetIn (loc,na,b,c) as x ->
-      let bl,c = extract_prod_binders c in
-      if bl = [] then [], x else CLocalDef (na,b) :: bl, c*)
-    | { v = CProdN ([],c) } ->
-      extract_prod_binders c
-    | { loc; v = CProdN ([[_,Name id],bk,t],
-              { v = CCases (LetPatternStyle,None, [{ v = 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
-      CLocalPattern (loc, (p,None)) :: bl, c
-    | { loc; v = CProdN ((nal,bk,t)::bl,c) } ->
-      let bl,c = extract_prod_binders (CAst.make ?loc @@ CProdN(bl,c)) in
-      CLocalAssum (nal,bk,t) :: bl, c
-    | c -> [], c
-
-  let rec extract_lam_binders ce = let open CAst in match ce.v with
-  (*  | CLetIn (loc,na,b,c) as x ->
-      let bl,c = extract_lam_binders c in
-      if bl = [] then [], x else CLocalDef (na,b) :: bl, c*)
-    | CLambdaN ([],c) ->
-      extract_lam_binders c
-    | CLambdaN ([[_,Name id],bk,t],
-                { v = CCases (LetPatternStyle,None, [{ v = 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
-      CLocalPattern (ce.loc,(p,None)) :: bl, c
-    | CLambdaN ((nal,bk,t)::bl,c) ->
-      let bl,c = extract_lam_binders (CAst.make ?loc:ce.loc @@ CLambdaN(bl,c)) in
-      CLocalAssum (nal,bk,t) :: bl, c
-    | _ -> [], ce
-
-  let split_lambda = CAst.with_loc_val (fun ?loc -> function
-    | CLambdaN ([[na],bk,t],c) -> (na,t,c)
-    | CLambdaN (([na],bk,t)::bl,c) -> (na,t, CAst.make ?loc @@ CLambdaN(bl,c))
-    | CLambdaN ((na::nal,bk,t)::bl,c) -> (na,t, CAst.make ?loc @@ CLambdaN((nal,bk,t)::bl,c))
-    | _ -> anomaly (Pp.str "ill-formed fixpoint body.")
-    )
-
-  let rename na na' t c =
-    match (na,na') with
-      | (_,Name id), (_,Name id') ->
-        (na',t,Topconstr.replace_vars_constr_expr (Id.Map.singleton id id') c)
-      | (_,Name id), (_,Anonymous) -> (na,t,c)
-      | _ -> (na',t,c)
-
-  let split_product na' = CAst.with_loc_val (fun ?loc -> function
-    | CProdN ([[na],bk,t],c) -> rename na na' t c
-    | CProdN (([na],bk,t)::bl,c) -> rename na na' t (CAst.make ?loc @@ CProdN(bl,c))
-    | CProdN ((na::nal,bk,t)::bl,c) ->
-      rename na na' t (CAst.make ?loc @@ CProdN((nal,bk,t)::bl,c))
-    | _ -> anomaly (Pp.str "ill-formed fixpoint body.")
-    )
-
-  let rec split_fix n typ def =
-    if Int.equal n 0 then ([],typ,def)
-    else
-      let (na,_,def) = split_lambda def in
-      let (na,t,typ) = split_product na typ in
-      let (bl,typ,def) = split_fix (n-1) typ def in
-      (CLocalAssum ([na],default_binder_kind,t)::bl,typ,def)
-
   let pr_recursive_decl pr pr_dangling dangling_with_for id bl annot t c =
     let pr_body =
       if dangling_with_for then pr_dangling else pr in
@@ -461,7 +411,7 @@ let tag_var = tag Tag.variable
   let pr_guard_annot pr_aux bl (n,ro) =
     match n with
       | None -> mt ()
-      | Some (loc, id) ->
+      | Some {loc; v = id} ->
         match (ro : Constrexpr.recursion_order_expr) with
           | CStructRec ->
             let names_of_binder = function
@@ -478,11 +428,11 @@ let tag_var = tag Tag.variable
             spc() ++ str "{" ++ keyword "measure" ++ spc () ++ pr_aux m ++ spc() ++ pr_id id++
               (match r with None -> mt() | Some r -> str" on " ++ pr_aux r) ++ str"}"
 
-  let pr_fixdecl pr prd dangling_with_for ((_,id),ro,bl,t,c) =
+  let pr_fixdecl pr prd dangling_with_for ({v=id},ro,bl,t,c) =
     let annot = pr_guard_annot (pr lsimpleconstr) bl ro in
     pr_recursive_decl pr prd dangling_with_for id bl annot t c
 
-  let pr_cofixdecl pr prd dangling_with_for ((_,id),bl,t,c) =
+  let pr_cofixdecl pr prd dangling_with_for ({v=id},bl,t,c) =
     pr_recursive_decl pr prd dangling_with_for id bl (mt()) t c
 
   let pr_recursive pr_decl id = function
@@ -512,7 +462,7 @@ let tag_var = tag Tag.variable
 
   let pr_simple_return_type pr na po =
     (match na with
-      | Some (_,Name id) ->
+      | Some {v=Name id} ->
         spc () ++ keyword "as" ++ spc () ++ pr_id id
       | _ -> mt ()) ++
       pr_case_type pr po
@@ -543,7 +493,7 @@ let tag_var = tag Tag.variable
   let pr_fun_sep = spc () ++ str "=>"
 
   let pr_dangling_with_for sep pr inherited a =
-    match a.CAst.v with
+    match a.v with
       | (CFix (_,[_])|CCoFix(_,[_])) ->
         pr sep (latom,E) a
       | _ ->
@@ -558,18 +508,17 @@ let tag_var = tag Tag.variable
         return (
           hov 0 (keyword "fix" ++ spc () ++
                    pr_recursive
-                   (pr_fixdecl (pr mt) (pr_dangling_with_for mt pr)) (snd id) fix),
+                   (pr_fixdecl (pr mt) (pr_dangling_with_for mt pr)) id.v fix),
           lfix
         )
       | CCoFix (id,cofix) ->
         return (
           hov 0 (keyword "cofix" ++ spc () ++
                    pr_recursive
-                   (pr_cofixdecl (pr mt) (pr_dangling_with_for mt pr)) (snd id) cofix),
+                   (pr_cofixdecl (pr mt) (pr_dangling_with_for mt pr)) id.v cofix),
           lfix
         )
-      | CProdN _ ->
-        let (bl,a) = extract_prod_binders a in
+      | CProdN (bl,a) ->
         return (
           hov 0 (
             hov 2 (pr_delimited_binders pr_forall spc
@@ -577,8 +526,7 @@ let tag_var = tag Tag.variable
               str "," ++ pr spc ltop a),
           lprod
         )
-      | CLambdaN _ ->
-        let (bl,a) = extract_lam_binders a in
+      | CLambdaN (bl,a) ->
         return (
           hov 0 (
             hov 2 (pr_delimited_binders pr_fun spc
@@ -586,8 +534,8 @@ let tag_var = tag Tag.variable
               pr_fun_sep ++ pr spc ltop a),
           llambda
         )
-      | CLetIn ((_,Name x), ({ CAst.v = CFix((_,x'),[_])}
-                          |  { CAst.v = CCoFix((_,x'),[_]) } as fx), t, b)
+      | CLetIn ({v=Name x}, ({ v = CFix({v=x'},[_])}
+                          |  { v = CCoFix({v=x'},[_]) } as fx), t, b)
           when Id.equal x x' ->
         return (
           hv 0 (
@@ -643,7 +591,7 @@ let tag_var = tag Tag.variable
           hv 0 (str"{|" ++ pr_record_body_gen (pr spc) l ++ str" |}"),
           latom
         )
-      | CCases (LetPatternStyle,rtntypopt,[c,as_clause,in_clause],[(_,([(loc,[p])],b))]) ->
+      | CCases (LetPatternStyle,rtntypopt,[c,as_clause,in_clause],[{v=([[p]],b)}]) ->
         return (
           hv 0 (
             keyword "let" ++ spc () ++ str"'" ++
@@ -716,16 +664,19 @@ let tag_var = tag Tag.variable
                     | CastCoerce -> str ":>"),
           lcast
         )
-      | CNotation ("( _ )",([t],[],[])) ->
+      | CNotation ("( _ )",([t],[],[],[])) ->
         return (pr (fun()->str"(") (max_int,L) t ++ str")", latom)
       | CNotation (s,env) ->
-        pr_notation (pr mt) (pr_binders_gen (pr mt ltop)) s env
+        pr_notation (pr mt) pr_patt (pr_binders_gen (pr mt ltop)) s env
       | CGeneralization (bk,ak,c) ->
         return (pr_generalization bk ak (pr mt ltop c), latom)
       | CPrim p ->
         return (pr_prim_token p, prec_of_prim_token p)
       | CDelimiters (sc,a) ->
         return (pr_delimiters sc (pr mt (ldelim,E) a), ldelim)
+      | CProj (p,c) ->
+        let p = pr_proj (pr mt) pr_app c (CAst.make (CRef (p,None))) [] in
+        return (p, lproj)
     in
     let loc = constr_loc a in
     pr_with_comments ?loc
@@ -738,34 +689,40 @@ let tag_var = tag Tag.variable
     pr_lconstr_pattern_expr : constr_pattern_expr -> Pp.t
   }
 
-  type precedence =  Notation_term.precedence * Notation_term.parenRelation
   let modular_constr_pr = pr
   let rec fix rf x = rf (fix rf) x
   let pr = fix modular_constr_pr mt
 
+  let pr prec = function
+    (* A toplevel printer hack mimicking parsing, incidentally meaning
+       that we cannot use [pr] correctly anymore in a recursive loop
+       if the current expr is followed by other exprs which would be
+       interpreted as arguments *)
+    | { CAst.v = CAppExpl ((None,f,us),[]) } -> str "@" ++ pr_cref f us
+    | c -> pr prec c
+
   let transf env c =
     if !Flags.beautify_file then
       let r = Constrintern.for_grammar (Constrintern.intern_constr env) c in
       Constrextern.extern_glob_constr (Termops.vars_of_env env) r
     else c
 
-  let pr prec c = pr prec (transf (Global.env()) c)
+  let pr_expr prec c = pr prec (transf (Global.env()) c)
 
-  let pr_simpleconstr = function
-    | { CAst.v = CAppExpl ((None,f,us),[]) } -> str "@" ++ pr_cref f us
-    | c -> pr lsimpleconstr c
+  let pr_simpleconstr = pr_expr lsimpleconstr
 
   let default_term_pr = {
     pr_constr_expr   = pr_simpleconstr;
-    pr_lconstr_expr  = pr ltop;
+    pr_lconstr_expr  = pr_expr ltop;
     pr_constr_pattern_expr  = pr_simpleconstr;
-    pr_lconstr_pattern_expr = pr ltop
+    pr_lconstr_pattern_expr = pr_expr ltop
   }
 
   let term_pr = ref default_term_pr
 
   let set_term_pr = (:=) term_pr
 
+  let pr_constr_expr_n n c = pr_expr n c
   let pr_constr_expr c   = !term_pr.pr_constr_expr   c
   let pr_lconstr_expr c  = !term_pr.pr_lconstr_expr  c
   let pr_constr_pattern_expr c  = !term_pr.pr_constr_pattern_expr  c
@@ -775,5 +732,5 @@ let tag_var = tag Tag.variable
 
   let pr_record_body = pr_record_body_gen pr
 
-  let pr_binders = pr_undelimited_binders spc (pr ltop)
+  let pr_binders = pr_undelimited_binders spc (pr_expr ltop)
 
diff --git a/printing/ppconstr.mli b/printing/ppconstr.mli
index 7546c748d..cedeed5f3 100644
--- a/printing/ppconstr.mli
+++ b/printing/ppconstr.mli
@@ -10,29 +10,20 @@
     objects and their subcomponents. *)
 
 (** The default pretty-printers produce pretty-printing commands ({!Pp.t}). *)
-open Loc
 open Libnames
 open Constrexpr
 open Names
 open Misctypes
 open Notation_term
 
-val extract_lam_binders :
-  constr_expr -> local_binder_expr list * constr_expr
-val extract_prod_binders :
-  constr_expr -> local_binder_expr list * constr_expr
-val split_fix :
-  int -> constr_expr -> constr_expr ->
-  local_binder_expr list *  constr_expr * constr_expr
-
 val prec_less : precedence -> tolerability -> bool
 
 val pr_tight_coma : unit -> Pp.t
 
 val pr_or_var : ('a -> Pp.t) -> 'a or_var -> Pp.t
 
-val pr_lident : Id.t located -> Pp.t
-val pr_lname : Name.t located -> Pp.t
+val pr_lident : lident -> Pp.t
+val pr_lname : lname -> Pp.t
 
 val pr_with_comments : ?loc:Loc.t -> Pp.t -> Pp.t
 val pr_com_at : int -> Pp.t
@@ -43,6 +34,8 @@ val pr_sep_com :
 
 val pr_id : Id.t -> Pp.t
 val pr_name : Name.t -> Pp.t
+[@@ocaml.deprecated "alias of Names.Name.print"]
+
 val pr_qualid : qualid -> Pp.t
 val pr_patvar : patvar -> Pp.t
 
@@ -50,7 +43,7 @@ val pr_glob_level : glob_level -> Pp.t
 val pr_glob_sort : glob_sort -> Pp.t
 val pr_guard_annot : (constr_expr -> Pp.t) ->
   local_binder_expr list ->
-  ('a * Names.Id.t) option * recursion_order_expr ->
+  lident option * recursion_order_expr ->
   Pp.t
 
 val pr_record_body : (reference * constr_expr) list -> Pp.t
@@ -60,6 +53,7 @@ val pr_lconstr_pattern_expr : constr_pattern_expr -> Pp.t
 val pr_constr_expr : constr_expr -> Pp.t
 val pr_lconstr_expr : constr_expr -> Pp.t
 val pr_cases_pattern_expr : cases_pattern_expr -> Pp.t
+val pr_constr_expr_n : tolerability -> constr_expr -> Pp.t
 
 type term_pr = {
   pr_constr_expr   : constr_expr -> Pp.t;
@@ -86,9 +80,8 @@ val default_term_pr : term_pr
   Which has the same type. We can turn a modular printer into a printer by
   taking its fixpoint. *)
 
-type precedence
-val lsimpleconstr : precedence
-val ltop : precedence
+val lsimpleconstr : tolerability
+val ltop : tolerability
 val modular_constr_pr :
-  ((unit->Pp.t) -> precedence -> constr_expr -> Pp.t) ->
-  (unit->Pp.t) -> precedence  -> constr_expr -> Pp.t
+  ((unit->Pp.t) -> tolerability -> constr_expr -> Pp.t) ->
+  (unit->Pp.t) -> tolerability -> constr_expr -> Pp.t
diff --git a/printing/pputils.ml b/printing/pputils.ml
index 9ef9162ae..e779fc5fc 100644
--- a/printing/pputils.ml
+++ b/printing/pputils.ml
@@ -9,7 +9,6 @@
 open Util
 open Pp
 open Genarg
-open Nameops
 open Misctypes
 open Locus
 open Genredexpr
@@ -25,9 +24,11 @@ let pr_located pr (loc, x) =
     before ++ x ++ after
   | _ -> pr x
 
+let pr_ast pr { CAst.loc; v } = pr_located pr (loc, v)
+
 let pr_or_var pr = function
   | ArgArg x -> pr x
-  | ArgVar (_,s) -> pr_id s
+  | ArgVar {CAst.v=s} -> Names.Id.print s
 
 let pr_with_occurrences pr keyword (occs,c) =
   match occs with
@@ -104,6 +105,9 @@ let pr_red_expr (pr_constr,pr_lconstr,pr_ref,pr_pattern) keyword = function
   | CbvNative o ->
     keyword "native_compute" ++ pr_opt (pr_with_occurrences (pr_union pr_ref pr_pattern) keyword) o
 
+let pr_red_expr_env env sigma (pr_constr,pr_lconstr,pr_ref,pr_pattern) =
+  pr_red_expr (pr_constr env sigma, pr_lconstr env sigma, pr_ref, pr_pattern env sigma)
+
 let pr_or_by_notation f = function
   | AN v -> f v
   | ByNotation (_,(s,sc)) -> qs s ++ pr_opt (fun sc -> str "%" ++ str sc) sc
@@ -128,7 +132,10 @@ let rec pr_raw_generic env (GenArg (Rawwit wit, x)) =
       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 open Genprint in
+       match generic_raw_print (in_gen (rawwit wit) x) with
+       | PrinterBasic pp -> pp ()
+       | PrinterNeedsLevel { default_ensure_surrounded; printer } -> printer default_ensure_surrounded
 
 
 let rec pr_glb_generic env (GenArg (Glbwit wit, x)) =
@@ -150,4 +157,7 @@ let rec pr_glb_generic env (GenArg (Glbwit wit, x)) =
       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)
+       let open Genprint in
+       match generic_glb_print (in_gen (glbwit wit) x) with
+       | PrinterBasic pp -> pp ()
+       | PrinterNeedsLevel { default_ensure_surrounded; printer } -> printer default_ensure_surrounded
diff --git a/printing/pputils.mli b/printing/pputils.mli
index 1f4fa1390..ec5c32fc4 100644
--- a/printing/pputils.mli
+++ b/printing/pputils.mli
@@ -12,6 +12,7 @@ open Locus
 open Genredexpr
 
 val pr_located : ('a -> Pp.t) -> 'a Loc.located -> Pp.t
+val pr_ast : ('a -> Pp.t) -> 'a CAst.t -> Pp.t
 (** Prints an object surrounded by its commented location *)
 
 val pr_or_var : ('a -> Pp.t) -> 'a or_var -> Pp.t
@@ -21,8 +22,16 @@ val pr_with_occurrences :
 
 val pr_short_red_flag : ('a -> Pp.t) -> 'a glob_red_flag -> Pp.t
 val pr_red_flag : ('a -> Pp.t) -> 'a glob_red_flag -> Pp.t
+
 val pr_red_expr :
   ('a -> Pp.t) * ('a -> Pp.t) * ('b -> Pp.t) * ('c -> Pp.t) ->
+  (string -> Pp.t) -> ('a,'b,'c) red_expr_gen -> Pp.t
+
+val pr_red_expr_env : Environ.env -> Evd.evar_map ->
+  (Environ.env -> Evd.evar_map -> 'a -> Pp.t) *
+  (Environ.env -> Evd.evar_map -> 'a -> Pp.t) *
+  ('b -> Pp.t) *
+  (Environ.env -> Evd.evar_map -> 'c -> Pp.t) ->
   (string -> Pp.t) ->
   ('a,'b,'c) red_expr_gen -> Pp.t
 
diff --git a/printing/ppvernac.ml b/printing/ppvernac.ml
index 4c50c2f36..83cac7ddd 100644
--- a/printing/ppvernac.ml
+++ b/printing/ppvernac.ml
@@ -11,6 +11,8 @@ open Names
 
 open CErrors
 open Util
+open CAst
+
 open Extend
 open Vernacexpr
 open Pputils
@@ -31,18 +33,35 @@ open Decl_kinds
   let pr_lconstr = pr_lconstr_expr
   let pr_spc_lconstr = pr_sep_com spc pr_lconstr_expr
 
-  let pr_lident (loc,id) =
-    match loc with
-    | None     -> pr_id id
-    | Some loc -> let (b,_) = Loc.unloc loc in
-                  pr_located pr_id @@ Loc.tag ~loc:(Loc.make_loc (b,b + String.length (Id.to_string id))) id
-
-  let pr_plident (lid, l) =
-    pr_lident lid ++
-    (match l with
-     | Some l -> prlist_with_sep spc pr_lident l
-     | None -> mt())
-    
+  let pr_uconstraint (l, d, r) =
+    pr_glob_level l ++ spc () ++ Univ.pr_constraint_type d ++ spc () ++
+      pr_glob_level r
+
+  let pr_univ_name_list = function
+    | None -> mt ()
+    | Some l ->
+      str "@{" ++ prlist_with_sep spc pr_lname l ++ str"}"
+
+  let pr_univdecl_instance l extensible =
+    prlist_with_sep spc pr_lident l ++
+    (if extensible then str"+" else mt ())
+
+  let pr_univdecl_constraints l extensible =
+    if List.is_empty l && extensible then mt ()
+    else str"|" ++ spc () ++ prlist_with_sep (fun () -> str",") pr_uconstraint l ++
+           (if extensible then str"+" else mt())
+
+  let pr_universe_decl l =
+    let open Misctypes in
+    match l with
+    | None -> mt ()
+    | Some l ->
+      str"@{" ++ pr_univdecl_instance l.univdecl_instance l.univdecl_extensible_instance ++
+        pr_univdecl_constraints l.univdecl_constraints l.univdecl_extensible_constraints ++ str "}"
+
+  let pr_ident_decl (lid, l) =
+    pr_lident lid ++ pr_universe_decl l
+
   let string_of_fqid fqid =
     String.concat "." (List.map Id.to_string fqid)
 
@@ -54,9 +73,8 @@ open Decl_kinds
     | Some loc -> let (b,_) = Loc.unloc loc in
                   pr_located pr_fqid @@ Loc.tag ~loc:(Loc.make_loc (b,b + String.length (string_of_fqid fqid))) fqid
 
-  let pr_lname = function
-    | (loc,Name id) -> pr_lident (loc,id)
-    | lna -> pr_located Name.print lna
+  let pr_lname_decl (n, u) =
+    pr_lname n ++ pr_universe_decl u
 
   let pr_smart_global = Pputils.pr_or_by_notation pr_reference
 
@@ -68,7 +86,7 @@ open Decl_kinds
 
   let sep_end = function
     | VernacBullet _
-    | VernacSubproof None
+    | VernacSubproof _
     | VernacEndSubproof -> str""
     | _ -> str"."
 
@@ -77,16 +95,35 @@ open Decl_kinds
   let sep = fun _ -> spc()
   let sep_v2 = fun _ -> str"," ++ spc()
 
-  let pr_set_entry_type = function
+  let pr_at_level = function
+    | NumLevel n -> keyword "at" ++ spc () ++ keyword "level" ++ spc () ++ int n
+    | NextLevel -> keyword "at" ++ spc () ++ keyword "next" ++ spc () ++ keyword "level"
+
+  let pr_constr_as_binder_kind = function
+    | AsIdent -> keyword "as ident"
+    | AsIdentOrPattern -> keyword "as pattern"
+    | AsStrictPattern -> keyword "as strict pattern"
+
+  let pr_strict b = if b then str "strict " else mt ()
+
+  let pr_set_entry_type pr = function
     | ETName -> str"ident"
     | ETReference -> str"global"
-    | ETPattern -> str"pattern"
-    | ETConstr _ -> str"constr"
+    | ETPattern (b,None) -> pr_strict b ++ str"pattern"
+    | ETPattern (b,Some n) -> pr_strict b ++ str"pattern" ++ spc () ++ pr_at_level (NumLevel n)
+    | ETConstr lev -> str"constr" ++ pr lev
     | ETOther (_,e) -> str e
+    | ETConstrAsBinder (bk,lev) -> pr lev ++ spc () ++ pr_constr_as_binder_kind bk
     | ETBigint -> str "bigint"
     | ETBinder true -> str "binder"
     | ETBinder false -> str "closed binder"
-    | ETBinderList _ | ETConstrList _ -> failwith "Internal entry type"
+
+  let pr_at_level_opt = function
+    | None -> mt ()
+    | Some n -> spc () ++ pr_at_level n
+
+  let pr_set_simple_entry_type =
+    pr_set_entry_type pr_at_level_opt
 
   let pr_comment pr_c = function
     | CommentConstr c -> pr_c c
@@ -201,7 +238,7 @@ open Decl_kinds
       keyword "Module" ++ spc() ++ pr_lfqid id ++ str" := " ++
         pr_located pr_qualid qid
 
-  let rec pr_module_ast leading_space pr_c = let open CAst in function
+  let rec pr_module_ast leading_space pr_c = function
     | { loc ; v = CMident qid } ->
       if leading_space then
         spc () ++ pr_located pr_qualid (loc, qid)
@@ -252,10 +289,10 @@ open Decl_kinds
     prlist_strict (pr_module_vardecls pr_c) l
 
   let pr_type_option pr_c = function
-    | { CAst.v = CHole (k, Misctypes.IntroAnonymous, _) } -> mt()
+    | { v = CHole (k, Misctypes.IntroAnonymous, _) } -> mt()
     | _ as c -> brk(0,2) ++ str" :" ++ pr_c c
 
-  let pr_decl_notation prc ((loc,ntn),c,scopt) =
+  let pr_decl_notation prc ({loc; v=ntn},c,scopt) =
     fnl () ++ keyword "where " ++ qs ntn ++ str " := "
     ++ Flags.without_option Flags.beautify prc c ++
       pr_opt (fun sc -> str ": " ++ str sc) scopt
@@ -275,7 +312,7 @@ open Decl_kinds
         ) ++
           hov 0 ((if dep then keyword "Induction for" else keyword "Minimality for")
                  ++ spc() ++ pr_smart_global ind) ++ spc() ++
-          hov 0 (keyword "Sort" ++ spc() ++ pr_glob_sort s)
+          hov 0 (keyword "Sort" ++ spc() ++ Termops.pr_sort_family s)
       | CaseScheme (dep,ind,s) ->
         (match idop with
           | Some id -> hov 0 (pr_lident id ++ str" :=") ++ spc()
@@ -283,7 +320,7 @@ open Decl_kinds
         ) ++
           hov 0 ((if dep then keyword "Elimination for" else keyword "Case for")
                  ++ spc() ++ pr_smart_global ind) ++ spc() ++
-          hov 0 (keyword "Sort" ++ spc() ++ pr_glob_sort s)
+          hov 0 (keyword "Sort" ++ spc() ++ Termops.pr_sort_family s)
       | EqualityScheme ind ->
         (match idop with
           | Some id -> hov 0 (pr_lident id ++ str" :=") ++ spc()
@@ -294,30 +331,25 @@ open Decl_kinds
 
   let begin_of_inductive = function
     | [] -> 0
-    | (_,((loc,_),_))::_ -> Option.cata (fun loc -> fst (Loc.unloc loc)) 0 loc
+    | (_,({loc},_))::_ -> Option.cata (fun loc -> fst (Loc.unloc loc)) 0 loc
 
   let pr_class_rawexpr = function
     | FunClass -> keyword "Funclass"
     | SortClass -> keyword "Sortclass"
     | RefClass qid -> pr_smart_global qid
 
-  let pr_assumption_token many (l,a) =
-    let l = match l with Some x -> x | None -> Decl_kinds.Global in
-    match l, a with
-      | (Discharge,Logical) ->
-        keyword (if many then "Hypotheses" else "Hypothesis")
-      | (Discharge,Definitional) ->
-        keyword (if many then "Variables" else "Variable")
-      | (Global,Logical) ->
+  let pr_assumption_token many discharge kind =
+    match discharge, kind with
+      | (NoDischarge,Logical) ->
         keyword (if many then "Axioms" else "Axiom")
-      | (Global,Definitional) ->
+      | (NoDischarge,Definitional) ->
         keyword (if many then "Parameters" else "Parameter")
-      | (Local, Logical) ->
-        keyword (if many then "Local Axioms" else "Local Axiom")
-      | (Local,Definitional) ->
-        keyword (if many then "Local Parameters" else "Local Parameter")
-      | (Global,Conjectural) -> str"Conjecture"
-      | ((Discharge | Local),Conjectural) ->
+      | (NoDischarge,Conjectural) -> str"Conjecture"
+      | (DoDischarge,Logical) ->
+        keyword (if many then "Hypotheses" else "Hypothesis")
+      | (DoDischarge,Definitional) ->
+        keyword (if many then "Variables" else "Variable")
+      | (DoDischarge,Conjectural) ->
         anomaly (Pp.str "Don't know how to beautify a local conjecture.")
 
   let pr_params pr_c (xl,(c,t)) =
@@ -349,46 +381,38 @@ open Decl_kinds
   let pr_thm_token k = keyword (Kindops.string_of_theorem_kind k)
 
   let pr_syntax_modifier = function
-    | SetItemLevel (l,NextLevel) ->
-      prlist_with_sep sep_v2 str l ++
-        spc() ++ keyword "at next level"
-    | SetItemLevel (l,NumLevel n) ->
+    | SetItemLevel (l,n) ->
+      prlist_with_sep sep_v2 str l ++ spc () ++ pr_at_level n
+    | SetItemLevelAsBinder (l,bk,n) ->
       prlist_with_sep sep_v2 str l ++
-        spc() ++ keyword "at level" ++ spc() ++ int n
-    | SetLevel n -> keyword "at level" ++ spc() ++ int n
+      spc() ++ pr_at_level_opt n ++ spc() ++ pr_constr_as_binder_kind bk
+    | SetLevel n -> pr_at_level (NumLevel n)
     | SetAssoc LeftA -> keyword "left associativity"
     | SetAssoc RightA -> keyword "right associativity"
     | SetAssoc NonA -> keyword "no associativity"
-    | SetEntryType (x,typ) -> str x ++ spc() ++ pr_set_entry_type typ
+    | SetEntryType (x,typ) -> str x ++ spc() ++ pr_set_simple_entry_type typ
     | 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
+    | SetFormat("text",s) -> keyword "format " ++ pr_ast qs s
+    | SetFormat(k,s) -> keyword "format " ++ qs k ++ spc() ++ pr_ast qs s
 
   let pr_syntax_modifiers = function
     | [] -> mt()
     | l -> spc() ++
       hov 1 (str"(" ++ prlist_with_sep sep_v2 pr_syntax_modifier l ++ str")")
 
-  let pr_univs pl =
-    match pl with
-    | 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_rec_definition ((iddecl,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_ident_decl iddecl ++ 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)) =
-    assert (not (Option.is_empty idpl));
-    let id, pl = Option.get idpl in
     hov 2
-      (head ++ spc() ++ pr_lident id ++ pr_univs pl ++ spc() ++
+      (head ++ spc() ++ pr_ident_decl idpl ++ spc() ++
          (match bl with [] -> mt() | _ -> pr_binders bl ++ spc()) ++
          str":" ++ pr_spc_lconstr c)
 
@@ -434,7 +458,7 @@ open Decl_kinds
     | PrintGrammar ent ->
       keyword "Print Grammar" ++ spc() ++ str ent
     | PrintLoadPath dir ->
-      keyword "Print LoadPath" ++ pr_opt pr_dirpath dir
+      keyword "Print LoadPath" ++ pr_opt DirPath.print dir
     | PrintModules ->
       keyword "Print Modules"
     | PrintMLLoadPath ->
@@ -475,8 +499,8 @@ open Decl_kinds
         else "Print Universes"
       in
       keyword cmd ++ pr_opt str fopt
-    | PrintName qid ->
-      keyword "Print" ++ spc()  ++ pr_smart_global qid
+    | PrintName (qid,udecl) ->
+      keyword "Print" ++ spc()  ++ pr_smart_global qid ++ pr_univ_name_list udecl
     | PrintModuleType qid ->
       keyword "Print Module Type" ++ spc() ++ pr_reference qid
     | PrintModule qid ->
@@ -489,9 +513,9 @@ open Decl_kinds
       keyword "Print Scope" ++ spc() ++ str s
     | PrintVisibility s ->
       keyword "Print Visibility" ++ pr_opt str s
-    | PrintAbout (qid,gopt) ->
+    | PrintAbout (qid,l,gopt) ->
        pr_opt (fun g -> Proof_bullet.pr_goal_selector g ++ str ":"++ spc()) gopt
-       ++ keyword "About" ++ spc()  ++ pr_smart_global qid
+       ++ keyword "About" ++ spc()  ++ pr_smart_global qid ++ pr_univ_name_list l
     | PrintImplicit qid ->
       keyword "Print Implicit" ++ spc()  ++ pr_smart_global qid
     (* spiwack: command printing all the axioms and section variables used in a
@@ -505,30 +529,50 @@ open Decl_kinds
       in
       keyword cmd ++ spc() ++ pr_smart_global qid
     | PrintNamespace dp ->
-      keyword "Print Namespace" ++ pr_dirpath dp
+      keyword "Print Namespace" ++ DirPath.print 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 pr_using e =
+    let rec aux = function
+      | SsEmpty -> "()"
+      | SsType -> "(Type)"
+      | SsSingl { v=id } -> "("^Id.to_string id^")"
+      | SsCompl e -> "-" ^ aux e^""
+      | SsUnion(e1,e2) -> "("^aux e1 ^" + "^ aux e2^")"
+      | SsSubstr(e1,e2) -> "("^aux e1 ^" - "^ aux e2^")"
+      | SsFwdClose e -> "("^aux e^")*"
+    in Pp.str (aux e)
+
+  let 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 identity (aux rl cl))
+    with Not_found ->
+      hov 1 (str "TODO(" ++ str (fst s) ++ spc () ++ prlist_with_sep sep pr_arg cl ++ str ")")
 
-  let rec pr_vernac_body v =
+  let pr_vernac_expr v =
     let return = 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 Wait ->
-        return (keyword "Stm Wait")
+      | VernacLoad (f,s) ->
+        return (
+          keyword "Load"
+          ++ if f then
+              (spc() ++ keyword "Verbose" ++ spc())
+            else
+              spc() ++ qs s
+        )
 
       (* Proof management *)
       | VernacAbortAll ->
@@ -539,8 +583,6 @@ open Decl_kinds
         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 ->
@@ -558,7 +600,7 @@ open Decl_kinds
           | OpenSubgoals -> mt ()
           | NthGoal n -> spc () ++ int n
           | GoalId id -> spc () ++ pr_id id
-          | GoalUid n -> spc () ++ str n in
+        in
         let pr_showable = function
           | ShowGoal n -> keyword "Show" ++ pr_goal_reference n
           | ShowProof -> keyword "Show Proof"
@@ -591,26 +633,8 @@ open Decl_kinds
       | 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)
-
     (* Syntax *)
-      | VernacOpenCloseScope (_,(opening,sc)) ->
+      | VernacOpenCloseScope (opening,sc) ->
         return (
           keyword (if opening then "Open " else "Close ") ++
             keyword "Scope" ++ spc() ++ str sc
@@ -639,7 +663,7 @@ open Decl_kinds
           ++ spc() ++ pr_smart_global q
           ++ spc() ++ str"[" ++ prlist_with_sep sep pr_opt_scope scl ++ str"]"
         )
-      | VernacInfix (_,((_,s),mv),q,sn) -> (* A Verifier *)
+      | VernacInfix (({v=s},mv),q,sn) -> (* A Verifier *)
         return (
           hov 0 (hov 0 (keyword "Infix "
                         ++ qs s ++ str " :=" ++ pr_constrarg q) ++
@@ -648,7 +672,7 @@ open Decl_kinds
                      | None -> mt()
                      | Some sc -> spc() ++ str":" ++ spc() ++ str sc))
         )
-      | VernacNotation (_,c,((_,s),l),opt) ->
+      | VernacNotation (c,({v=s},l),opt) ->
         return (
           hov 2 (keyword "Notation" ++ spc() ++ qs s ++
                    str " :=" ++ Flags.without_option Flags.beautify pr_constrarg c ++ pr_syntax_modifiers l ++
@@ -656,9 +680,9 @@ open Decl_kinds
                      | None -> mt()
                      | Some sc -> str" :" ++ spc() ++ str sc))
         )
-      | VernacSyntaxExtension (_,(s,l)) ->
+      | VernacSyntaxExtension (_, (s, l)) ->
         return (
-          keyword "Reserved Notation" ++ spc() ++ pr_located qs s ++
+          keyword "Reserved Notation" ++ spc() ++ pr_ast qs s ++
             pr_syntax_modifiers l
         )
       | VernacNotationAddFormat(s,k,v) ->
@@ -667,10 +691,12 @@ open Decl_kinds
         )
 
       (* 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))
+      | VernacDefinition ((discharge,kind),id,b) -> (* A verifier... *)
+        let pr_def_token dk =
+          keyword (
+            if Name.is_anonymous (fst id).v
+            then "Goal"
+            else Kindops.string_of_definition_object_kind dk)
         in
         let pr_reduce = function
           | None -> mt()
@@ -687,12 +713,13 @@ open Decl_kinds
             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 typ u = if (fst id).v = Anonymous then (assert (bl = []); u) else (str" :" ++ u) in
+            (pr_binders_arg bl, typ (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
+            pr_def_token kind ++ spc()
+            ++ pr_lname_decl id ++ binds ++ typ
             ++ (match c with
               | None -> mt()
               | Some cc -> str" :=" ++ spc() ++ cc))
@@ -711,21 +738,18 @@ open Decl_kinds
         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)
+              | Opaque      -> keyword "Qed")
           | Some id -> (if opac <> Transparent then keyword "Save" else keyword "Defined") ++ spc() ++ pr_lident id
       )
       | VernacExactProof c ->
         return (hov 2 (keyword "Proof" ++ pr_lconstrarg c))
-      | VernacAssumption (stre,t,l) ->
+      | VernacAssumption ((discharge,kind),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() ++
+          hov 2 (prlist_with_sep sep pr_ident_decl 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 ++
+        return (hov 2 (pr_assumption_token (n > 1) discharge kind ++
                        pr_non_empty_arg pr_assumption_inline t ++ spc() ++ assumptions))
       | VernacInductive (cum, p,f,l) ->
         let pr_constructor (coe,(id,c)) =
@@ -743,10 +767,10 @@ open Decl_kinds
           | RecordDecl (c,fs) ->
             pr_record_decl b c fs
         in
-        let pr_oneind key (((coe,(id,pl)),indpar,s,k,lc),ntn) =
+        let pr_oneind key (((coe,iddecl),indpar,s,k,lc),ntn) =
           hov 0 (
             str key ++ spc() ++
-              (if coe then str"> " else str"") ++ pr_lident id ++ pr_univs pl ++
+              (if coe then str"> " else str"") ++ pr_ident_decl iddecl ++
               pr_and_type_binders_arg indpar ++
               pr_opt (fun s -> str":" ++ spc() ++ pr_lconstr_expr s) s ++
               str" :=") ++ pr_constructor_list k lc ++
@@ -775,9 +799,8 @@ open Decl_kinds
 
       | VernacFixpoint (local, recs) ->
         let local = match local with
-          | Some Discharge -> "Let "
-          | Some Local -> "Local "
-          | None | Some Global -> ""
+          | DoDischarge -> "Let "
+          | NoDischarge -> ""
         in
         return (
           hov 0 (str local ++ keyword "Fixpoint" ++ spc () ++
@@ -787,12 +810,11 @@ open Decl_kinds
 
       | VernacCoFixpoint (local, corecs) ->
         let local = match local with
-          | Some Discharge -> keyword "Let" ++ spc ()
-          | Some Local -> keyword "Local" ++ spc ()
-          | None | Some Global -> str ""
+          | DoDischarge -> keyword "Let" ++ spc ()
+          | NoDischarge -> str ""
         in
-        let pr_onecorec ((((loc,id),pl),bl,c,def),ntn) =
-          pr_id id ++ pr_univs pl ++ spc() ++ pr_binders bl ++ spc() ++ str":" ++
+        let pr_onecorec ((iddecl,bl,c,def),ntn) =
+          pr_ident_decl iddecl ++ 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
@@ -818,10 +840,6 @@ open Decl_kinds
                    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)
@@ -854,14 +872,14 @@ open Decl_kinds
         return (
           keyword "Canonical Structure" ++ spc() ++ pr_smart_global q
         )
-      | VernacCoercion (_,id,c1,c2) ->
+      | 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) ->
+      | VernacIdentityCoercion (id,c1,c2) ->
         return (
           hov 1 (
             keyword "Identity Coercion" ++ spc() ++ pr_lident id ++
@@ -873,16 +891,16 @@ open Decl_kinds
         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 ++
+            keyword "Instance" ++
+            (match instid with
+             | {loc; v = Name id}, l -> spc () ++ pr_ident_decl (CAst.(make ?loc id),l) ++ spc ()
+             | { v = 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, { CAst.v = CRecord l}) -> spc () ++ str":=" ++ spc () ++ str"{" ++ pr_record_body l ++ str "}"
+                | Some (true, { v = 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()))
@@ -955,7 +973,7 @@ open Decl_kinds
                keyword "LoadPath" ++ spc() ++ qs s ++
                (match d with
                  | None -> mt()
-                 | Some dir -> spc() ++ keyword "as" ++ spc() ++ pr_dirpath dir))
+                 | Some dir -> spc() ++ keyword "as" ++ spc() ++ DirPath.print dir))
         )
       | VernacRemoveLoadPath s ->
         return (keyword "Remove LoadPath" ++ qs s)
@@ -985,9 +1003,9 @@ open Decl_kinds
                    prlist_with_sep spc (fun r -> pr_id (coerce_reference_to_id r)) ids ++
                    pr_opt_hintbases dbnames)
         )
-      | VernacHints (_, dbnames,h) ->
+      | VernacHints (dbnames,h) ->
         return (pr_hints dbnames h pr_constr pr_constr_pattern_expr)
-      | VernacSyntacticDefinition (id,(ids,c),_,compat) ->
+      | VernacSyntacticDefinition (id,(ids,c),compat) ->
         return (
           hov 2
             (keyword "Notation" ++ spc () ++ pr_lident id ++ spc () ++
@@ -1015,7 +1033,7 @@ open Decl_kinds
           hov 2 (
             keyword "Arguments" ++ spc() ++
               pr_smart_global q ++
-              let pr_s = function None -> str"" | Some (_,s) -> str "%" ++ str s in
+              let pr_s = function None -> str"" | Some {v=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 "]"
@@ -1156,7 +1174,7 @@ open Decl_kinds
           | 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
+          | LocateOther (s, qid) -> keyword s ++ spc () ++ pr_ltac_ref qid
         in
         return (keyword "Locate" ++ spc() ++ pr_locate loc)
       | VernacRegister (id, RegisterInline) ->
@@ -1202,26 +1220,34 @@ open Decl_kinds
       | VernacSubproof None ->
         return (str "{")
       | VernacSubproof (Some i) ->
-        return (keyword "BeginSubproof" ++ spc () ++ int i)
+        return (Proof_bullet.pr_goal_selector i ++ str ":" ++ spc () ++ str "{")
       | 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 identity (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_flag =
+  function
+  | VernacPolymorphic true -> keyword "Polymorphic"
+  | VernacPolymorphic false -> keyword "Monomorphic"
+  | VernacProgram -> keyword "Program"
+  | VernacLocal local -> pr_locality local
 
-  let pr_vernac v =
-    try pr_vernac_body v ++ sep_end v
-    with e -> CErrors.print e
+  let rec pr_vernac_control v =
+    let return = tag_vernac v in
+    match v with
+    | VernacExpr (f, v') ->
+      List.fold_right
+        (fun f a -> pr_vernac_flag f ++ spc() ++ a)
+        f
+        (pr_vernac_expr v' ++ sep_end v')
+    | VernacTime (_,{v}) ->
+      return (keyword "Time" ++ spc() ++ pr_vernac_control v)
+    | VernacRedirect (s, {v}) ->
+      return (keyword "Redirect" ++ spc() ++ qs s ++ spc() ++ pr_vernac_control v)
+    | VernacTimeout(n,v) ->
+      return (keyword "Timeout " ++ int n ++ spc() ++ pr_vernac_control v)
+    | VernacFail v ->
+      return (keyword "Fail" ++ spc() ++ pr_vernac_control v)
+
+    let pr_vernac v =
+      try pr_vernac_control v
+      with e -> CErrors.print e
diff --git a/printing/ppvernac.mli b/printing/ppvernac.mli
index b88eed484..603be6308 100644
--- a/printing/ppvernac.mli
+++ b/printing/ppvernac.mli
@@ -9,11 +9,16 @@
 (** This module implements pretty-printers for vernac_expr syntactic
     objects and their subcomponents. *)
 
+val pr_set_entry_type : ('a -> Pp.t) -> 'a Extend.constr_entry_key_gen -> Pp.t
+
 (** Prints a fixpoint body *)
 val pr_rec_definition : (Vernacexpr.fixpoint_expr * Vernacexpr.decl_notation list) -> Pp.t
 
-(** Prints a vernac expression *)
-val pr_vernac_body : Vernacexpr.vernac_expr -> Pp.t
+(** Prints a vernac expression without dot *)
+val pr_vernac_expr : Vernacexpr.vernac_expr -> Pp.t
+
+(** Prints a "proof using X" clause. *)
+val pr_using : Vernacexpr.section_subset_expr -> Pp.t
 
 (** Prints a vernac expression and closes it with a dot. *)
-val pr_vernac : Vernacexpr.vernac_expr -> Pp.t
+val pr_vernac : Vernacexpr.vernac_control -> Pp.t
diff --git a/printing/prettyp.ml b/printing/prettyp.ml
index 09859157c..114a071ee 100644
--- a/printing/prettyp.ml
+++ b/printing/prettyp.ml
@@ -15,7 +15,6 @@ open CErrors
 open Util
 open Names
 open Nameops
-open Term
 open Termops
 open Declarations
 open Environ
@@ -33,15 +32,15 @@ open Context.Rel.Declaration
 module NamedDecl = Context.Named.Declaration
 
 type object_pr = {
-  print_inductive           : mutual_inductive -> Pp.t;
-  print_constant_with_infos : constant -> Pp.t;
-  print_section_variable    : variable -> Pp.t;
-  print_syntactic_def       : kernel_name -> Pp.t;
-  print_module              : bool -> Names.module_path -> Pp.t;
-  print_modtype             : module_path -> Pp.t;
-  print_named_decl          : Context.Named.Declaration.t -> Pp.t;
-  print_library_entry       : bool -> (object_name * Lib.node) -> Pp.t option;
-  print_context             : bool -> int option -> Lib.library_segment -> Pp.t;
+  print_inductive           : MutInd.t -> Universes.univ_name_list option -> Pp.t;
+  print_constant_with_infos : Constant.t -> Universes.univ_name_list option -> Pp.t;
+  print_section_variable    : env -> Evd.evar_map -> variable -> Pp.t;
+  print_syntactic_def       : env -> KerName.t -> Pp.t;
+  print_module              : bool -> ModPath.t -> Pp.t;
+  print_modtype             : ModPath.t -> Pp.t;
+  print_named_decl          : env -> Evd.evar_map -> Context.Named.Declaration.t -> Pp.t;
+  print_library_entry       : env -> Evd.evar_map -> bool -> (object_name * Lib.node) -> Pp.t option;
+  print_context             : env -> Evd.evar_map -> bool -> int option -> Lib.library_segment -> Pp.t;
   print_typed_value_in_env  : Environ.env -> Evd.evar_map -> EConstr.constr * EConstr.types -> Pp.t;
   print_eval                : Reductionops.reduction_function -> env -> Evd.evar_map -> Constrexpr.constr_expr -> EConstr.unsafe_judgment -> Pp.t;
 }
@@ -69,7 +68,7 @@ let int_or_no n = if Int.equal n 0 then str "no" else int n
 
 let print_basename sp = pr_global (ConstRef sp)
 
-let print_ref reduce ref =
+let print_ref reduce ref udecl =
   let typ, ctx = Global.type_of_global_in_context (Global.env ()) ref in
   let typ = Vars.subst_instance_constr (Univ.AUContext.instance ctx) typ in
   let typ = EConstr.of_constr typ in
@@ -79,22 +78,32 @@ let print_ref reduce ref =
       in EConstr.it_mkProd_or_LetIn ccl ctx
     else typ in
   let univs = Global.universes_of_global ref in
+  let variance = match ref with
+    | VarRef _ | ConstRef _ -> None
+    | IndRef (ind,_) | ConstructRef ((ind,_),_) ->
+      let mind = Environ.lookup_mind ind (Global.env ()) in
+      begin match mind.Declarations.mind_universes with
+        | Declarations.Monomorphic_ind _ | Declarations.Polymorphic_ind _ -> None
+        | Declarations.Cumulative_ind cumi -> Some (Univ.ACumulativityInfo.variance cumi)
+      end
+  in
   let inst = Univ.AUContext.instance univs in
   let univs = Univ.UContext.make (inst, Univ.AUContext.instantiate inst univs) in
   let env = Global.env () in
-  let bl = Universes.universe_binders_of_global ref in
+  let bl = Universes.universe_binders_with_opt_names ref
+      (Array.to_list (Univ.Instance.to_array inst)) udecl in
   let sigma = Evd.from_ctx (Evd.evar_universe_context_of_binders bl) in
   let inst =
     if Global.is_polymorphic ref then Printer.pr_universe_instance sigma univs
     else mt ()
   in
   hov 0 (pr_global ref ++ inst ++ str " :" ++ spc () ++ pr_letype_env env sigma typ ++ 
-  	   Printer.pr_universe_ctx sigma univs)
+           Printer.pr_universe_ctx sigma ?variance univs)
 
 (********************************)
 (** Printing implicit arguments *)
 
-let pr_impl_name imp = pr_id (name_of_implicit imp)
+let pr_impl_name imp = Id.print (name_of_implicit imp)
 
 let print_impargs_by_name max = function
   | []  -> []
@@ -139,7 +148,7 @@ let print_renames_list prefix l =
 
 let need_expansion impl ref =
   let typ, _ = Global.type_of_global_in_context (Global.env ()) ref in
-  let ctx = prod_assum typ in
+  let ctx = Term.prod_assum typ 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
@@ -151,7 +160,7 @@ let print_impargs ref =
   let has_impl = not (List.is_empty impl) in
   (* Need to reduce since implicits are computed with products flattened *)
   pr_infos_list
-    ([ print_ref (need_expansion (select_impargs_size 0 impl) ref) ref;
+    ([ print_ref (need_expansion (select_impargs_size 0 impl) ref) ref None;
        blankline ] @
     (if has_impl then print_impargs_list (mt()) impl
      else [str "No implicit arguments"]))
@@ -235,10 +244,10 @@ let print_type_in_type ref =
 let print_primitive_record recflag mipv = function
   | Some (Some (_, ps,_)) ->
     let eta = match recflag with
-    | Decl_kinds.CoFinite | Decl_kinds.Finite -> str" without eta conversion"
-    | Decl_kinds.BiFinite -> str " with eta conversion"
+    | CoFinite | Finite -> str" without eta conversion"
+    | BiFinite -> str " with eta conversion"
     in
-    [pr_id mipv.(0).mind_typename ++ str" has primitive projections" ++ eta ++ str"."]
+    [Id.print mipv.(0).mind_typename ++ str" has primitive projections" ++ eta ++ str"."]
   | _ -> []
 
 let print_primitive ref =
@@ -257,7 +266,7 @@ let print_name_infos ref =
     if need_expansion (select_impargs_size 0 impls) ref then
       (* Need to reduce since implicits are computed with products flattened *)
       [str "Expanded type for implicit arguments";
-       print_ref true ref; blankline]
+       print_ref true ref None; blankline]
     else
       [] in
   print_polymorphism ref @
@@ -271,7 +280,7 @@ let print_name_infos ref =
 
 let print_id_args_data test pr id l =
   if List.exists test l then
-    pr (str "For " ++ pr_id id) l
+    pr (str "For " ++ Id.print id) l
   else
     []
 
@@ -304,14 +313,33 @@ let print_inductive_argument_scopes =
 (*********************)
 (* "Locate" commands *)
 
+type 'a locatable_info = {
+  locate : qualid -> 'a option;
+  locate_all : qualid -> 'a list;
+  shortest_qualid : 'a -> qualid;
+  name : 'a -> Pp.t;
+  print : 'a -> Pp.t;
+  about : 'a -> Pp.t;
+}
+
+type locatable = Locatable : 'a locatable_info -> locatable
+
 type logical_name =
   | Term of global_reference
   | Dir of global_dir_reference
-  | Syntactic of kernel_name
-  | ModuleType of module_path
-  | Tactic of Nametab.ltac_constant
+  | Syntactic of KerName.t
+  | ModuleType of ModPath.t
+  | Other : 'a * 'a locatable_info -> logical_name
   | Undefined of qualid
 
+(** Generic table for objects that are accessible through a name. *)
+let locatable_map : locatable String.Map.t ref = ref String.Map.empty
+
+let register_locatable name f =
+  locatable_map := String.Map.add name (Locatable f) !locatable_map
+
+exception ObjFound of logical_name
+
 let locate_any_name ref =
   let (loc,qid) = qualid_of_reference ref in
   try Term (Nametab.locate qid)
@@ -321,7 +349,13 @@ let locate_any_name ref =
   try Dir (Nametab.locate_dir qid)
   with Not_found ->
   try ModuleType (Nametab.locate_modtype qid)
-  with Not_found -> Undefined qid
+  with Not_found ->
+    let iter _ (Locatable info) = match info.locate qid with
+    | None -> ()
+    | Some ans -> raise (ObjFound (Other (ans, info)))
+    in
+    try String.Map.iter iter !locatable_map; Undefined qid
+    with ObjFound obj -> obj
 
 let pr_located_qualid = function
   | Term ref ->
@@ -335,17 +369,16 @@ let pr_located_qualid = function
       str "Notation" ++ spc () ++ pr_path (Nametab.path_of_syndef kn)
   | Dir dir ->
       let s,dir = match dir with
-	| DirOpenModule (dir,_) -> "Open Module", dir
-	| DirOpenModtype (dir,_) -> "Open Module Type", dir
-	| DirOpenSection (dir,_) -> "Open Section", dir
-	| DirModule (dir,_) -> "Module", dir
+        | DirOpenModule { obj_dir ; _ } -> "Open Module", obj_dir
+        | DirOpenModtype { obj_dir ; _ } -> "Open Module Type", obj_dir
+        | DirOpenSection { obj_dir ; _ } -> "Open Section", obj_dir
+        | DirModule { obj_dir ; _ } -> "Module", obj_dir
 	| DirClosedSection dir -> "Closed Section", dir
       in
-      str s ++ spc () ++ pr_dirpath dir
+      str s ++ spc () ++ DirPath.print dir
   | ModuleType mp ->
       str "Module Type" ++ spc () ++ pr_path (Nametab.path_of_modtype mp)
-  | Tactic kn ->
-      str "Ltac" ++ spc () ++ pr_path (Nametab.path_of_tactic kn)
+  | Other (obj, info) -> info.name obj
   | Undefined qid ->
       pr_qualid qid ++ spc () ++ str "not a defined object."
 
@@ -383,14 +416,10 @@ let locate_term qid =
   in
   List.map expand (Nametab.locate_extended_all qid)
 
-let locate_tactic qid =
-  let all = Nametab.locate_extended_all_tactic qid in
-  List.map (fun kn -> (Tactic kn, Nametab.shortest_qualid_of_tactic kn)) all
-
 let locate_module qid =
   let all = Nametab.locate_extended_all_dir qid in
   let map dir = match dir with
-  | DirModule (_, (mp, _)) -> Some (Dir dir, Nametab.shortest_qualid_of_module mp)
+  | DirModule { obj_mp ; _ } -> Some (Dir dir, Nametab.shortest_qualid_of_module obj_mp)
   | DirOpenModule _ -> Some (Dir dir, qid)
   | _ -> None
   in
@@ -408,18 +437,35 @@ let locate_modtype qid =
   in
   modtypes @ List.map_filter map all
 
+let locate_other s qid =
+  let Locatable info = String.Map.find s !locatable_map in
+  let ans = info.locate_all qid in
+  let map obj = (Other (obj, info), info.shortest_qualid obj) in
+  List.map map ans
+
+type locatable_kind =
+| LocTerm
+| LocModule
+| LocOther of string
+| LocAny
+
 let print_located_qualid name flags ref =
   let (loc,qid) = qualid_of_reference ref in
-  let located = [] in
-  let located = if List.mem `LTAC flags then locate_tactic qid @ located else located in
-  let located = if List.mem `MODTYPE flags then locate_modtype qid @ located else located in
-  let located = if List.mem `MODULE flags then locate_module qid @ located else located in
-  let located = if List.mem `TERM flags then locate_term qid @ located else located in
+  let located = match flags with
+  | LocTerm -> locate_term qid
+  | LocModule -> locate_modtype qid @ locate_module qid
+  | LocOther s -> locate_other s qid
+  | LocAny ->
+    locate_term qid @
+    locate_modtype qid @
+    locate_module qid @
+    String.Map.fold (fun s _ accu -> locate_other s qid @ accu) !locatable_map []
+  in
   match located with
     | [] ->
 	let (dir,id) = repr_qualid qid in
 	if DirPath.is_empty dir then
-	  str "No " ++ str name ++ str " of basename" ++ spc () ++ pr_id id
+	  str "No " ++ str name ++ str " of basename" ++ spc () ++ Id.print id
 	else
 	  str "No " ++ str name ++ str " of suffix" ++ spc () ++ pr_qualid qid
     | l ->
@@ -432,10 +478,10 @@ let print_located_qualid name flags ref =
 	   else mt ()) ++
           display_alias o)) l
 
-let print_located_term ref = print_located_qualid "term" [`TERM] ref
-let print_located_tactic ref = print_located_qualid "tactic" [`LTAC] ref
-let print_located_module ref = print_located_qualid "module" [`MODULE; `MODTYPE] ref
-let print_located_qualid ref = print_located_qualid "object" [`TERM; `LTAC; `MODULE; `MODTYPE] ref
+let print_located_term ref = print_located_qualid "term" LocTerm ref
+let print_located_other s ref = print_located_qualid s (LocOther s) ref
+let print_located_module ref = print_located_qualid "module" LocModule ref
+let print_located_qualid ref = print_located_qualid "object" LocAny ref
 
 (******************************************)
 (**** Printing declarations and judgments *)
@@ -450,25 +496,25 @@ let gallina_print_typed_value_in_env env sigma (trm,typ) =
    the pretty-print of a proposition (P:(nat->nat)->Prop)(P [u]u)
    synthesizes the type nat of the abstraction on u *)
 
-let print_named_def name body typ =
-  let pbody = pr_lconstr body in
-  let ptyp = pr_ltype typ in
-  let pbody = if isCast body then surround pbody else pbody in
+let print_named_def env sigma name body typ =
+  let pbody = pr_lconstr_env env sigma body in
+  let ptyp = pr_ltype_env env sigma typ in
+  let pbody = if Constr.isCast body then surround pbody else pbody in
   (str "*** [" ++ str name ++ str " " ++
      hov 0 (str ":=" ++ brk (1,2) ++ pbody ++ spc () ++
 	      str ":" ++ brk (1,2) ++ ptyp) ++
 	   str "]")
 
-let print_named_assum name typ =
-  str "*** [" ++ str name ++ str " : " ++ pr_ltype typ ++ str "]"
+let print_named_assum env sigma name typ =
+  str "*** [" ++ str name ++ str " : " ++ pr_ltype_env env sigma typ ++ str "]"
 
-let gallina_print_named_decl =
+let gallina_print_named_decl env sigma =
   let open Context.Named.Declaration in
   function
   | LocalAssum (id, typ) ->
-     print_named_assum (Id.to_string id) typ
+     print_named_assum env sigma (Id.to_string id) typ
   | LocalDef (id, body, typ) ->
-     print_named_def (Id.to_string id) body typ
+     print_named_def env sigma (Id.to_string id) body typ
 
 let assumptions_for_print lna =
   List.fold_right (fun na env -> add_name na env) lna empty_names_context
@@ -476,22 +522,22 @@ let assumptions_for_print lna =
 (*********************)
 (* *)
 
-let gallina_print_inductive sp =
+let gallina_print_inductive sp udecl =
   let env = Global.env() in
   let mib = Environ.lookup_mind sp env in
   let mipv = mib.mind_packets in
-  pr_mutual_inductive_body env sp mib ++
+  pr_mutual_inductive_body env sp mib udecl ++
   with_line_skip
     (print_primitive_record mib.mind_finite mipv mib.mind_record @
      print_inductive_renames sp mipv @
      print_inductive_implicit_args sp mipv @
      print_inductive_argument_scopes sp mipv)
 
-let print_named_decl id =
-  gallina_print_named_decl (Global.lookup_named id) ++ fnl ()
+let print_named_decl env sigma id =
+  gallina_print_named_decl env sigma (Global.lookup_named id) ++ fnl ()
 
-let gallina_print_section_variable id =
-  print_named_decl id ++
+let gallina_print_section_variable env sigma id =
+  print_named_decl env sigma id ++
   with_line_skip (print_name_infos (VarRef id))
 
 let print_body env evd = function
@@ -509,7 +555,7 @@ let print_instance sigma cb =
     pr_universe_instance sigma univs
   else mt()
 				
-let print_constant with_values sep sp =
+let print_constant with_values sep sp udecl =
   let cb = Global.lookup_constant sp in
   let val_0 = Global.body_of_constant_body cb in
   let typ =
@@ -519,31 +565,34 @@ let print_constant with_values sep sp =
       let inst = Univ.AUContext.instance univs in
       Vars.subst_instance_constr inst cb.const_type
   in
-  let univs =
+  let univs, ulist =
+    let open Entries in
+    let open Univ in
     let otab = Global.opaque_tables () in
     match cb.const_body with
     | Undef _ | Def _ ->
       begin
         match cb.const_universes with
-        | Monomorphic_const ctx -> ctx
+        | Monomorphic_const ctx -> Monomorphic_const_entry ctx, []
         | Polymorphic_const ctx ->
-          let inst = Univ.AUContext.instance ctx in
-          Univ.UContext.make (inst, Univ.AUContext.instantiate inst ctx)
+          let inst = AUContext.instance ctx in
+          Polymorphic_const_entry (UContext.make (inst, AUContext.instantiate inst ctx)),
+          Array.to_list (Instance.to_array inst)
       end
     | OpaqueDef o ->
       let body_uctxs = Opaqueproof.force_constraints otab o in
       match cb.const_universes with
       | Monomorphic_const ctx ->
-        let uctxs = Univ.ContextSet.of_context ctx in
-        Univ.ContextSet.to_context (Univ.ContextSet.union body_uctxs uctxs)
+        Monomorphic_const_entry (ContextSet.union body_uctxs ctx), []
       | Polymorphic_const ctx ->
-        assert(Univ.ContextSet.is_empty body_uctxs);
-        let inst = Univ.AUContext.instance ctx in
-        Univ.UContext.make (inst, Univ.AUContext.instantiate inst ctx)
+        assert(ContextSet.is_empty body_uctxs);
+        let inst = AUContext.instance ctx in
+        Polymorphic_const_entry (UContext.make (inst, AUContext.instantiate inst ctx)),
+        Array.to_list (Instance.to_array inst)
   in
   let ctx =
     Evd.evar_universe_context_of_binders
-      (Universes.universe_binders_of_global (ConstRef sp))
+      (Universes.universe_binders_with_opt_names (ConstRef sp) ulist udecl)
   in
   let env = Global.env () and sigma = Evd.from_ctx ctx in
   let pr_ltype = pr_ltype_env env sigma in
@@ -553,73 +602,73 @@ let print_constant with_values sep sp =
 	str"*** [ " ++
 	print_basename sp ++ print_instance sigma cb ++ str " : " ++ cut () ++ pr_ltype typ ++
 	str" ]" ++
-	Printer.pr_universe_ctx sigma univs
+        Printer.pr_constant_universes sigma univs
     | Some (c, ctx) ->
         let c = Vars.subst_instance_constr (Univ.AUContext.instance ctx) c in
 	print_basename sp ++ print_instance sigma cb ++ str sep ++ cut () ++
 	(if with_values then print_typed_body env sigma (Some c,typ) else pr_ltype typ)++
-        Printer.pr_universe_ctx sigma univs)
+        Printer.pr_constant_universes sigma univs)
 
-let gallina_print_constant_with_infos sp =
-  print_constant true " = " sp ++
+let gallina_print_constant_with_infos sp udecl =
+  print_constant true " = " sp udecl ++
   with_line_skip (print_name_infos (ConstRef sp))
 
-let gallina_print_syntactic_def kn =
+let gallina_print_syntactic_def env kn =
   let qid = Nametab.shortest_qualid_of_syndef Id.Set.empty kn
   and (vars,a) = Syntax_def.search_syntactic_definition kn in
   let c = Notation_ops.glob_constr_of_notation_constr a in
   hov 2
     (hov 4
        (str "Notation " ++ pr_qualid qid ++
-        prlist (fun id -> spc () ++ pr_id id) (List.map fst vars) ++
+        prlist (fun id -> spc () ++ Id.print id) (List.map fst vars) ++
         spc () ++ str ":=") ++
      spc () ++
      Constrextern.without_specific_symbols
-       [Notation.SynDefRule kn] pr_glob_constr c)
+       [Notation.SynDefRule kn] (pr_glob_constr_env env) c)
 
-let gallina_print_leaf_entry with_values ((sp,kn as oname),lobj) =
+let gallina_print_leaf_entry env sigma with_values ((sp,kn as oname),lobj) =
   let sep = if with_values then " = " else " : "
   and tag = object_tag lobj in
     match (oname,tag) with
       | (_,"VARIABLE") ->
 	  (* Outside sections, VARIABLES still exist but only with universes
              constraints *)
-	  (try Some(print_named_decl (basename sp)) with Not_found -> None)
+          (try Some(print_named_decl env sigma (basename sp)) with Not_found -> None)
       | (_,"CONSTANT") ->
-	  Some (print_constant with_values sep (constant_of_kn kn))
+          Some (print_constant with_values sep (Constant.make1 kn) None)
       | (_,"INDUCTIVE") ->
-	  Some (gallina_print_inductive (mind_of_kn kn))
+          Some (gallina_print_inductive (MutInd.make1 kn) None)
       | (_,"MODULE") ->
-	  let (mp,_,l) = repr_kn kn in
+	  let (mp,_,l) = KerName.repr kn in
 	    Some (print_module with_values (MPdot (mp,l)))
       | (_,"MODULE TYPE") ->
-	  let (mp,_,l) = repr_kn kn in
+	  let (mp,_,l) = KerName.repr kn in
 	  Some (print_modtype (MPdot (mp,l)))
       | (_,("AUTOHINT"|"GRAMMAR"|"SYNTAXCONSTANT"|"PPSYNTAX"|"TOKEN"|"CLASS"|
 	    "COERCION"|"REQUIRE"|"END-SECTION"|"STRUCTURE")) -> None
       (* To deal with forgotten cases... *)
       | (_,s) -> None
 
-let gallina_print_library_entry with_values ent =
-  let pr_name (sp,_) = pr_id (basename sp) in
+let gallina_print_library_entry env sigma with_values ent =
+  let pr_name (sp,_) = Id.print (basename sp) in
   match ent with
     | (oname,Lib.Leaf lobj) ->
-	gallina_print_leaf_entry with_values (oname,lobj)
+        gallina_print_leaf_entry env sigma with_values (oname,lobj)
     | (oname,Lib.OpenedSection (dir,_)) ->
         Some (str " >>>>>>> Section " ++ pr_name oname)
     | (oname,Lib.ClosedSection _) ->
         Some (str " >>>>>>> Closed Section " ++ pr_name oname)
-    | (_,Lib.CompilingLibrary (dir,_)) ->
-	Some (str " >>>>>>> Library " ++ pr_dirpath dir)
+    | (_,Lib.CompilingLibrary { obj_dir; _ }) ->
+        Some (str " >>>>>>> Library " ++ DirPath.print obj_dir)
     | (oname,Lib.OpenedModule _) ->
 	Some (str " >>>>>>> Module " ++ pr_name oname)
     | (oname,Lib.ClosedModule _) ->
         Some (str " >>>>>>> Closed Module " ++ pr_name oname)
 
-let gallina_print_context with_values =
+let gallina_print_context env sigma with_values =
   let rec prec n = function
     | h::rest when Option.is_empty n || Option.get n > 0 ->
-	(match gallina_print_library_entry with_values h with
+        (match gallina_print_library_entry env sigma with_values h with
 	  | None -> prec n rest
 	  | Some pp -> prec (Option.map ((+) (-1)) n) rest ++ pp ++ fnl ())
     | _ -> mt ()
@@ -681,10 +730,10 @@ let print_safe_judgment env sigma j =
 (*********************)
 (* *)
 
-let print_full_context () = print_context true None (Lib.contents ())
-let print_full_context_typ () = print_context false None (Lib.contents ())
+let print_full_context env sigma = print_context env sigma true None (Lib.contents ())
+let print_full_context_typ env sigma = print_context env sigma false None (Lib.contents ())
 
-let print_full_pure_context () =
+let print_full_pure_context env sigma =
   let rec prec = function
   | ((_,kn),Lib.Leaf lobj)::rest ->
       let pp = match object_tag lobj with
@@ -696,29 +745,29 @@ let print_full_pure_context () =
 	    match cb.const_body with
 	      | Undef _ ->
 		str "Parameter " ++
-		print_basename con ++ str " : " ++ cut () ++ pr_ltype typ
+                print_basename con ++ str " : " ++ cut () ++ pr_ltype_env env sigma typ
 	      | OpaqueDef lc ->
 		str "Theorem " ++ print_basename con ++ cut () ++
-		str " : " ++ pr_ltype typ ++ str "." ++ fnl () ++
-		str "Proof " ++ pr_lconstr (Opaqueproof.force_proof (Global.opaque_tables ()) lc)
+                str " : " ++ pr_ltype_env env sigma typ ++ str "." ++ fnl () ++
+                str "Proof " ++ pr_lconstr_env env sigma (Opaqueproof.force_proof (Global.opaque_tables ()) lc)
 	      | Def c ->
 		str "Definition " ++ print_basename con ++ cut () ++
-		str "  : " ++ pr_ltype typ ++ cut () ++ str " := " ++
-		pr_lconstr (Mod_subst.force_constr c))
+                str "  : " ++ pr_ltype_env env sigma typ ++ cut () ++ str " := " ++
+                pr_lconstr_env env sigma (Mod_subst.force_constr c))
           ++ str "." ++ fnl () ++ fnl ()
       | "INDUCTIVE" ->
 	  let mind = Global.mind_of_delta_kn kn in
 	  let mib = Global.lookup_mind mind in
-	  pr_mutual_inductive_body (Global.env()) mind mib ++
+          pr_mutual_inductive_body (Global.env()) mind mib None ++
 	    str "." ++ fnl () ++ fnl ()
       | "MODULE" ->
 	  (* TODO: make it reparsable *)
-	  let (mp,_,l) = repr_kn kn in
+	  let (mp,_,l) = KerName.repr kn in
 	  print_module true (MPdot (mp,l)) ++ str "." ++ fnl () ++ fnl ()
       | "MODULE TYPE" ->
 	  (* TODO: make it reparsable *)
 	  (* TODO: make it reparsable *)
-	  let (mp,_,l) = repr_kn kn in
+	  let (mp,_,l) = KerName.repr kn in
 	  print_modtype (MPdot (mp,l)) ++ str "." ++ fnl () ++ fnl ()
       | _ -> mt () in
       prec rest ++ pp
@@ -739,8 +788,8 @@ let read_sec_context r =
     with Not_found ->
       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
+    | (_,Lib.OpenedSection ({obj_dir;_},_) as hd)::rest ->
+        if DirPath.equal dir obj_dir then (hd::in_cxt) else get_cxt (hd::in_cxt) rest
     | (_,Lib.ClosedSection _)::rest ->
         user_err Pp.(str "Cannot print the contents of a closed section.")
 	(* LEM: Actually, we could if we wanted to. *)
@@ -750,50 +799,61 @@ let read_sec_context r =
   let cxt = Lib.contents () in
   List.rev (get_cxt [] cxt)
 
-let print_sec_context sec =
-  print_context true None (read_sec_context sec)
-
-let print_sec_context_typ sec =
-  print_context false None (read_sec_context sec)
-
-let print_any_name = function
-  | Term (ConstRef sp) -> print_constant_with_infos sp
-  | Term (IndRef (sp,_)) -> print_inductive sp
-  | Term (ConstructRef ((sp,_),_)) -> print_inductive sp
-  | Term (VarRef sp) -> print_section_variable sp
-  | Syntactic kn -> print_syntactic_def kn
-  | Dir (DirModule(dirpath,(mp,_))) -> print_module (printable_body dirpath) mp
+let print_sec_context env sigma sec =
+  print_context env sigma true None (read_sec_context sec)
+
+let print_sec_context_typ env sigma sec =
+  print_context env sigma false None (read_sec_context sec)
+
+let maybe_error_reject_univ_decl na udecl =
+  match na, udecl with
+  | _, None | Term (ConstRef _ | IndRef _ | ConstructRef _), Some _ -> ()
+  | (Term (VarRef _) | Syntactic _ | Dir _ | ModuleType _ | Other _ | Undefined _), Some udecl ->
+    (* TODO Print na somehow *)
+    user_err ~hdr:"reject_univ_decl" (str "This object does not support universe names.")
+
+let print_any_name env sigma na udecl =
+  maybe_error_reject_univ_decl na udecl;
+  match na with
+  | Term (ConstRef sp) -> print_constant_with_infos sp udecl
+  | Term (IndRef (sp,_)) -> print_inductive sp udecl
+  | Term (ConstructRef ((sp,_),_)) -> print_inductive sp udecl
+  | Term (VarRef sp) -> print_section_variable env sigma sp
+  | Syntactic kn -> print_syntactic_def env kn
+  | Dir (DirModule { obj_dir; obj_mp; _ } ) -> print_module (printable_body obj_dir) obj_mp
   | Dir _ -> mt ()
   | ModuleType mp -> print_modtype mp
-  | Tactic kn -> mt () (** TODO *)
+  | Other (obj, info) -> info.print obj
   | Undefined qid ->
   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;
-    str |> Global.lookup_named |> NamedDecl.set_id str |> print_named_decl
+    str |> Global.lookup_named |> print_named_decl env sigma
+
   with Not_found ->
     user_err
       ~hdr:"print_name" (pr_qualid qid ++ spc () ++ str "not a defined object.")
 
-let print_name = function
+let print_name env sigma na udecl =
+  match na with
   | ByNotation (loc,(ntn,sc)) ->
-      print_any_name
+      print_any_name env sigma
         (Term (Notation.interp_notation_as_global_reference ?loc (fun _ -> true)
                ntn sc))
+        udecl
   | AN ref ->
-      print_any_name (locate_any_name ref)
+      print_any_name env sigma (locate_any_name ref) udecl
 
-let print_opaque_name qid =
-  let env = Global.env () in
+let print_opaque_name env sigma qid =
   match Nametab.global qid with
     | ConstRef cst ->
 	let cb = Global.lookup_constant cst in
         if Declareops.constant_has_body cb then
-	  print_constant_with_infos cst
+          print_constant_with_infos cst None
         else
 	  user_err Pp.(str "Not a defined constant.")
     | IndRef (sp,_) ->
-        print_inductive sp
+        print_inductive sp None
     | ConstructRef cstr as gr ->
 	let ty, ctx = Global.type_of_global_in_context env gr in
 	let inst = Univ.AUContext.instance ctx in
@@ -802,15 +862,16 @@ let print_opaque_name qid =
         let open EConstr in
 	print_typed_value (mkConstruct cstr, ty)
     | VarRef id ->
-        env |> lookup_named id |> NamedDecl.set_id id |> print_named_decl
+        env |> lookup_named id |> print_named_decl env sigma
 
-let print_about_any ?loc k =
+let print_about_any ?loc env sigma k udecl =
+  maybe_error_reject_univ_decl k udecl;
   match k with
   | Term ref ->
     let rb = Reductionops.ReductionBehaviour.print ref in
     Dumpglob.add_glob ?loc ref;
       pr_infos_list
-       (print_ref false ref :: blankline ::
+       (print_ref false ref udecl :: blankline ::
 	print_name_infos ref @
 	(if Pp.ismt rb then [] else [rb]) @
 	print_opacity ref @
@@ -820,22 +881,24 @@ let print_about_any ?loc k =
     | [],Notation_term.NRef ref -> Dumpglob.add_glob ?loc ref
     | _ -> () in
       v 0 (
-      print_syntactic_def kn ++ fnl () ++
+      print_syntactic_def env kn ++ fnl () ++
       hov 0 (str "Expands to: " ++ pr_located_qualid k))
-  | Dir _ | ModuleType _ | Tactic _ | Undefined _ ->
+  | Dir _ | ModuleType _ | Undefined _ ->
       hov 0 (pr_located_qualid k)
+  | Other (obj, info) -> hov 0 (info.about obj)
 
-let print_about = function
+let print_about env sigma na udecl =
+  match na with
   | ByNotation (loc,(ntn,sc)) ->
-      print_about_any ?loc
+      print_about_any ?loc env sigma
         (Term (Notation.interp_notation_as_global_reference ?loc (fun _ -> true)
-               ntn sc))
+               ntn sc)) udecl
   | AN ref ->
-      print_about_any ?loc:(loc_of_reference ref) (locate_any_name ref)
+      print_about_any ?loc:(loc_of_reference ref) env sigma (locate_any_name ref) udecl
 
 (* for debug *)
-let inspect depth =
-  print_context false (Some depth) (Lib.contents ())
+let inspect env sigma depth =
+  print_context env sigma false (Some depth) (Lib.contents ())
 
 
 (*************************************************************************)
@@ -843,28 +906,28 @@ let inspect depth =
 
 open Classops
 
-let print_coercion_value v = pr_lconstr (get_coercion_value v)
+let print_coercion_value env sigma v = pr_lconstr_env env sigma (get_coercion_value v)
 
 let print_class i =
   let cl,_ = class_info_from_index i in
   pr_class cl
 
-let print_path ((i,j),p) =
+let print_path env sigma ((i,j),p) =
   hov 2 (
-    str"[" ++ hov 0 (prlist_with_sep pr_semicolon print_coercion_value p) ++
+    str"[" ++ hov 0 (prlist_with_sep pr_semicolon (print_coercion_value env sigma) p) ++
     str"] : ") ++
   print_class i ++ str" >-> " ++ print_class j
 
 let _ = Classops.install_path_printer print_path
 
-let print_graph () =
-  prlist_with_sep fnl print_path (inheritance_graph())
+let print_graph env sigma =
+  prlist_with_sep fnl (print_path env sigma) (inheritance_graph())
 
 let print_classes () =
   pr_sequence pr_class (classes())
 
-let print_coercions () =
-  pr_sequence print_coercion_value (coercions())
+let print_coercions env sigma =
+  pr_sequence (print_coercion_value env sigma) (coercions())
 
 let index_of_class cl =
   try
@@ -873,7 +936,7 @@ let index_of_class cl =
     user_err ~hdr:"index_of_class"
       (pr_class cl ++ spc() ++ str "not a defined class.")
 
-let print_path_between cls clt =
+let print_path_between env sigma cls clt =
   let i = index_of_class cls in
   let j = index_of_class clt in
   let p =
@@ -884,13 +947,13 @@ let print_path_between cls clt =
         (str"No path between " ++ pr_class cls ++ str" and " ++ pr_class clt
 	 ++ str ".")
   in
-  print_path ((i,j),p)
+  print_path env sigma ((i,j),p)
 
-let print_canonical_projections () =
+let print_canonical_projections env sigma =
   prlist_with_sep fnl
     (fun ((r1,r2),o) -> pr_cs_pattern r2 ++
     str " <- " ++
-    pr_global r1 ++ str " ( " ++ pr_lconstr o.o_DEF ++ str " )")
+    pr_global r1 ++ str " ( " ++ pr_lconstr_env env sigma o.o_DEF ++ str " )")
     (canonical_projections ())
 
 (*************************************************************************)
@@ -901,7 +964,7 @@ let print_canonical_projections () =
 open Typeclasses
 
 let pr_typeclass env t =
-  print_ref false t.cl_impl
+  print_ref false t.cl_impl None
 
 let print_typeclasses () =
   let env = Global.env () in
@@ -910,7 +973,7 @@ let print_typeclasses () =
 let pr_instance env i =
   (*   gallina_print_constant_with_infos i.is_impl *)
   (* lighter *)
-  print_ref false (instance_impl i) ++
+  print_ref false (instance_impl i) None ++
   begin match hint_priority i with
   | None -> mt ()
   | Some i -> spc () ++ str "|" ++ spc () ++ int i
diff --git a/printing/prettyp.mli b/printing/prettyp.mli
index f4277b6c5..c1d8f1d37 100644
--- a/printing/prettyp.mli
+++ b/printing/prettyp.mli
@@ -12,63 +12,88 @@ open Reductionops
 open Libnames
 open Globnames
 open Misctypes
+open Evd
 
 (** A Pretty-Printer for the Calculus of Inductive Constructions. *)
 
 val assumptions_for_print : Name.t list -> Termops.names_context
 
 val print_closed_sections : bool ref
-val print_context : bool -> int option -> Lib.library_segment -> Pp.t
-val print_library_entry : bool -> (object_name * Lib.node) -> Pp.t option
-val print_full_context : unit -> Pp.t
-val print_full_context_typ : unit -> Pp.t
-val print_full_pure_context : unit -> Pp.t
-val print_sec_context : reference -> Pp.t
-val print_sec_context_typ : reference -> Pp.t
+val print_context : env -> Evd.evar_map -> bool -> int option -> Lib.library_segment -> Pp.t
+val print_library_entry : env -> Evd.evar_map -> bool -> (object_name * Lib.node) -> Pp.t option
+val print_full_context : env -> Evd.evar_map -> Pp.t
+val print_full_context_typ : env -> Evd.evar_map -> Pp.t
+val print_full_pure_context : env -> Evd.evar_map -> Pp.t
+val print_sec_context : env -> Evd.evar_map -> reference -> Pp.t
+val print_sec_context_typ : env -> Evd.evar_map -> reference -> Pp.t
 val print_judgment : env -> Evd.evar_map -> EConstr.unsafe_judgment -> Pp.t
 val print_safe_judgment : env -> Evd.evar_map -> Safe_typing.judgment -> Pp.t
 val print_eval :
   reduction_function -> env -> Evd.evar_map ->
     Constrexpr.constr_expr -> EConstr.unsafe_judgment -> Pp.t
 
-val print_name : reference or_by_notation -> Pp.t
-val print_opaque_name : reference -> Pp.t
-val print_about : reference or_by_notation -> Pp.t
+val print_name : env -> Evd.evar_map -> reference or_by_notation ->
+  Universes.univ_name_list option -> Pp.t
+val print_opaque_name : env -> Evd.evar_map -> reference -> Pp.t
+val print_about : env -> Evd.evar_map -> reference or_by_notation ->
+  Universes.univ_name_list option -> Pp.t
 val print_impargs : reference or_by_notation -> Pp.t
 
 (** Pretty-printing functions for classes and coercions *)
-val print_graph : unit -> Pp.t
+val print_graph : env -> evar_map -> Pp.t
 val print_classes : unit -> Pp.t
-val print_coercions : unit -> Pp.t
-val print_path_between : Classops.cl_typ -> Classops.cl_typ -> Pp.t
-val print_canonical_projections : unit -> Pp.t
+val print_coercions : env -> Evd.evar_map -> Pp.t
+val print_path_between : env -> evar_map -> Classops.cl_typ -> Classops.cl_typ -> Pp.t
+val print_canonical_projections : env -> Evd.evar_map -> Pp.t
 
 (** Pretty-printing functions for type classes and instances *)
 val print_typeclasses : unit -> Pp.t
 val print_instances : global_reference -> Pp.t
 val print_all_instances : unit -> Pp.t
 
-val inspect : int -> Pp.t
+val inspect : env -> Evd.evar_map -> int -> Pp.t
 
-(** Locate *)
+(** {5 Locate} *)
+
+type 'a locatable_info = {
+  locate : qualid -> 'a option;
+  (** Locate the most precise object with the provided name if any. *)
+  locate_all : qualid -> 'a list;
+  (** Locate all objects whose name is a suffix of the provided name *)
+  shortest_qualid : 'a -> qualid;
+  (** Return the shortest name in the current context *)
+  name : 'a -> Pp.t;
+  (** Data as printed by the Locate command *)
+  print : 'a -> Pp.t;
+  (** Data as printed by the Print command *)
+  about : 'a -> Pp.t;
+  (** Data as printed by the About command *)
+}
+(** Generic data structure representing locatable objects. *)
+
+val register_locatable : string -> 'a locatable_info -> unit
+(** Define a new type of locatable objects that can be reached via the
+    corresponding generic vernacular commands. The string should be a unique
+    name describing the kind of objects considered and that is added as a
+    grammar command prefix for vernacular commands Locate. *)
 
 val print_located_qualid : reference -> Pp.t
 val print_located_term : reference -> Pp.t
-val print_located_tactic : reference -> Pp.t
 val print_located_module : reference -> Pp.t
+val print_located_other : string -> reference -> Pp.t
 
 type object_pr = {
-  print_inductive           : mutual_inductive -> Pp.t;
-  print_constant_with_infos : constant -> Pp.t;
-  print_section_variable    : variable -> Pp.t;
-  print_syntactic_def       : kernel_name -> Pp.t;
-  print_module              : bool -> Names.module_path -> Pp.t;
-  print_modtype             : module_path -> Pp.t;
-  print_named_decl          : Context.Named.Declaration.t -> Pp.t;
-  print_library_entry       : bool -> (object_name * Lib.node) -> Pp.t option;
-  print_context             : bool -> int option -> Lib.library_segment -> Pp.t;
+  print_inductive           : MutInd.t -> Universes.univ_name_list option -> Pp.t;
+  print_constant_with_infos : Constant.t -> Universes.univ_name_list option -> Pp.t;
+  print_section_variable    : env -> Evd.evar_map -> variable -> Pp.t;
+  print_syntactic_def       : env -> KerName.t -> Pp.t;
+  print_module              : bool -> ModPath.t -> Pp.t;
+  print_modtype             : ModPath.t -> Pp.t;
+  print_named_decl          : env -> Evd.evar_map -> Context.Named.Declaration.t -> Pp.t;
+  print_library_entry       : env -> Evd.evar_map -> bool -> (object_name * Lib.node) -> Pp.t option;
+  print_context             : env -> Evd.evar_map -> bool -> int option -> Lib.library_segment -> Pp.t;
   print_typed_value_in_env  : Environ.env -> Evd.evar_map -> EConstr.constr * EConstr.types -> Pp.t;
-  print_eval                : reduction_function -> env -> Evd.evar_map -> Constrexpr.constr_expr -> EConstr.unsafe_judgment -> Pp.t
+  print_eval                : Reductionops.reduction_function -> env -> Evd.evar_map -> Constrexpr.constr_expr -> EConstr.unsafe_judgment -> Pp.t;
 }
 
 val set_object_pr : object_pr -> unit
diff --git a/printing/printer.ml b/printing/printer.ml
index 28b10c781..d720bc2f8 100644
--- a/printing/printer.ml
+++ b/printing/printer.ml
@@ -10,7 +10,7 @@ open Pp
 open CErrors
 open Util
 open Names
-open Term
+open Constr
 open Environ
 open Globnames
 open Nametab
@@ -25,9 +25,6 @@ module RelDecl = Context.Rel.Declaration
 module NamedDecl = Context.Named.Declaration
 module CompactedDecl = Context.Compacted.Declaration
 
-let get_current_context () =
-  Pfedit.get_current_context ()
-
 let enable_unfocused_goal_printing = ref false
 let enable_goal_tags_printing = ref false
 let enable_goal_names_printing = ref false
@@ -79,11 +76,14 @@ let _ =
    and only names of goal/section variables and rel names that do
    _not_ occur in the scope of the binder to be printed are avoided. *)
 
+let pr_econstr_n_core goal_concl_style env sigma n t =
+  pr_constr_expr_n n (extern_constr goal_concl_style env sigma t)
 let pr_econstr_core goal_concl_style env sigma t =
   pr_constr_expr (extern_constr goal_concl_style env sigma t)
 let pr_leconstr_core goal_concl_style env sigma t =
   pr_lconstr_expr (extern_constr goal_concl_style env sigma t)
 
+let pr_constr_n_env env sigma n c = pr_econstr_n_core false env sigma n (EConstr.of_constr c)
 let pr_lconstr_env env sigma c = pr_leconstr_core false env sigma (EConstr.of_constr c)
 let pr_constr_env env sigma c = pr_econstr_core false env sigma (EConstr.of_constr c)
 let _ = Hook.set Refine.pr_constr pr_constr_env
@@ -94,15 +94,16 @@ let pr_constr_goal_style_env env sigma c = pr_econstr_core true env sigma (ECons
 let pr_open_lconstr_env env sigma (_,c) = pr_lconstr_env env sigma c
 let pr_open_constr_env env sigma (_,c) = pr_constr_env env sigma c
 
+let pr_econstr_n_env env sigma c = pr_econstr_n_core false env sigma c
 let pr_leconstr_env env sigma c = pr_leconstr_core false env sigma c
 let pr_econstr_env env sigma c = pr_econstr_core false env sigma c
 
 (* NB do not remove the eta-redexes! Global.env() has side-effects... *)
 let pr_lconstr t =
-  let (sigma, env) = get_current_context () in
+  let (sigma, env) = Pfedit.get_current_context () in
   pr_lconstr_env env sigma t
 let pr_constr t =
-  let (sigma, env) = get_current_context () in
+  let (sigma, env) = Pfedit.get_current_context () in
   pr_constr_env env sigma t
 
 let pr_open_lconstr (_,c) = pr_lconstr c
@@ -122,10 +123,10 @@ let pr_constr_under_binders_env = pr_constr_under_binders_env_gen pr_econstr_env
 let pr_lconstr_under_binders_env = pr_constr_under_binders_env_gen pr_leconstr_env
 
 let pr_constr_under_binders c =
-  let (sigma, env) = get_current_context () in
+  let (sigma, env) = Pfedit.get_current_context () in
   pr_constr_under_binders_env env sigma c
 let pr_lconstr_under_binders c =
-  let (sigma, env) = get_current_context () in
+  let (sigma, env) = Pfedit.get_current_context () in
   pr_lconstr_under_binders_env env sigma c
 
 let pr_etype_core goal_concl_style env sigma t =
@@ -137,10 +138,10 @@ let pr_ltype_env env sigma c = pr_letype_core false env sigma (EConstr.of_constr
 let pr_type_env env sigma c = pr_etype_core false env sigma (EConstr.of_constr c)
 
 let pr_ltype t =
-    let (sigma, env) = get_current_context () in
+    let (sigma, env) = Pfedit.get_current_context () in
     pr_ltype_env env sigma t
 let pr_type t =
-    let (sigma, env) = get_current_context () in
+    let (sigma, env) = Pfedit.get_current_context () in
     pr_type_env env sigma t
 
 let pr_etype_env env sigma c = pr_etype_core false env sigma c
@@ -151,7 +152,7 @@ let pr_ljudge_env env sigma j =
   (pr_leconstr_env env sigma j.uj_val, pr_leconstr_env env sigma j.uj_type)
 
 let pr_ljudge j =
-  let (sigma, env) = get_current_context () in
+  let (sigma, env) = Pfedit.get_current_context () in
   pr_ljudge_env env sigma j
 
 let pr_lglob_constr_env env c =
@@ -160,16 +161,18 @@ let pr_glob_constr_env env c =
   pr_constr_expr (extern_glob_constr (Termops.vars_of_env env) c)
 
 let pr_lglob_constr c =
-  let (sigma, env) = get_current_context () in
+  let (sigma, env) = Pfedit.get_current_context () in
   pr_lglob_constr_env env c
 let pr_glob_constr c =
-  let (sigma, env) = get_current_context () in
+  let (sigma, env) = Pfedit.get_current_context () in
   pr_glob_constr_env env c
 
+let pr_closed_glob_n_env env sigma n c =
+  pr_constr_expr_n n (extern_closed_glob false env sigma c)
 let pr_closed_glob_env env sigma c =
   pr_constr_expr (extern_closed_glob false env sigma c)
 let pr_closed_glob c =
-  let (sigma, env) = get_current_context () in
+  let (sigma, env) = Pfedit.get_current_context () in
   pr_closed_glob_env env sigma c
 
 let pr_lconstr_pattern_env env sigma c =
@@ -181,10 +184,10 @@ let pr_cases_pattern t =
   pr_cases_pattern_expr (extern_cases_pattern Names.Id.Set.empty t)
 
 let pr_lconstr_pattern t =
-  let (sigma, env) = get_current_context () in
+  let (sigma, env) = Pfedit.get_current_context () in
   pr_lconstr_pattern_env env sigma t
 let pr_constr_pattern t =
-  let (sigma, env) = get_current_context () in
+  let (sigma, env) = Pfedit.get_current_context () in
   pr_constr_pattern_env env sigma t
 
 let pr_sort sigma s = pr_glob_sort (extern_sort sigma s)
@@ -246,20 +249,31 @@ let safe_gen f env sigma c =
 let safe_pr_lconstr_env = safe_gen pr_lconstr_env
 let safe_pr_constr_env = safe_gen pr_constr_env
 let safe_pr_lconstr t =
-  let (sigma, env) = get_current_context () in
+  let (sigma, env) = Pfedit.get_current_context () in
   safe_pr_lconstr_env env sigma t
 
 let safe_pr_constr t =
-  let (sigma, env) = get_current_context () in
+  let (sigma, env) = Pfedit.get_current_context () in
   safe_pr_constr_env env sigma t
 
-let pr_universe_ctx sigma c =
+let pr_universe_ctx_set sigma c =
+  if !Detyping.print_universes && not (Univ.ContextSet.is_empty c) then
+    fnl()++pr_in_comment (fun c -> v 0
+      (Univ.pr_universe_context_set (Termops.pr_evd_level sigma) c)) c
+  else
+    mt()
+
+let pr_universe_ctx sigma ?variance c =
   if !Detyping.print_universes && not (Univ.UContext.is_empty c) then
     fnl()++pr_in_comment (fun c -> v 0 
-      (Univ.pr_universe_context (Termops.pr_evd_level sigma) c)) c
+      (Univ.pr_universe_context (Termops.pr_evd_level sigma) ?variance c)) c
   else
     mt()
 
+let pr_constant_universes sigma = function
+  | Entries.Monomorphic_const_entry ctx -> pr_universe_ctx_set sigma ctx
+  | Entries.Polymorphic_const_entry ctx -> pr_universe_ctx sigma ctx
+
 let pr_cumulativity_info sigma cumi =
   if !Detyping.print_universes 
   && not (Univ.UContext.is_empty (Univ.CumulativityInfo.univ_context cumi)) then
@@ -471,7 +485,7 @@ let pr_predicate pr_elt (b, elts) =
       if List.is_empty elts then str"none" else pr_elts
 
 let pr_cpred p = pr_predicate (pr_constant (Global.env())) (Cpred.elements p)
-let pr_idpred p = pr_predicate Nameops.pr_id (Id.Pred.elements p)
+let pr_idpred p = pr_predicate Id.print (Id.Pred.elements p)
 
 let pr_transparent_state (ids, csts) =
   hv 0 (str"VARIABLES: " ++ pr_idpred ids ++ fnl () ++
@@ -580,7 +594,7 @@ let default_pr_subgoal n sigma =
   in
   prrec n
 
-let pr_internal_existential_key ev = str (string_of_existential ev)
+let pr_internal_existential_key ev = Evar.print ev
 
 let print_evar_constraints gl sigma =
   let pr_env =
@@ -759,7 +773,7 @@ let default_pr_subgoals ?(pr_first=true)
 
 
 type printer_pr = {
- pr_subgoals            : ?pr_first:bool -> Pp.t option -> evar_map -> evar list -> Goal.goal list -> int list -> goal list -> goal list -> Pp.t;
+ pr_subgoals            : ?pr_first:bool -> Pp.t option -> evar_map -> Evar.t list -> Goal.goal list -> int list -> goal list -> goal list -> Pp.t;
  pr_subgoal             : int -> evar_map -> goal list -> Pp.t;
  pr_goal                : goal sigma -> Pp.t;
 }
@@ -781,7 +795,7 @@ let pr_goal     x = !printer_pr.pr_goal     x
 (* End abstraction layer                                              *)
 (**********************************************************************)
 
-let pr_open_subgoals ?(proof=Proof_global.give_me_the_proof ()) () =
+let pr_open_subgoals ~proof =
   (* spiwack: it shouldn't be the job of the printer to look up stuff
      in the [evar_map], I did stuff that way because it was more
      straightforward, but seriously, [Proof.proof] should return
@@ -819,30 +833,17 @@ let pr_open_subgoals ?(proof=Proof_global.give_me_the_proof ()) () =
      pr_subgoals ~pr_first:true None bsigma seeds shelf [] unfocused_if_needed bgoals_focused
   end
 
-let pr_nth_open_subgoal n =
-  let pf = Proof_global.give_me_the_proof () in
-  let { it=gls ; sigma=sigma } = Proof.V82.subgoals pf in
+let pr_nth_open_subgoal ~proof n =
+  let gls,_,_,_,sigma = Proof.proof proof in
   pr_subgoal n sigma gls
 
-let pr_goal_by_id id =
-  let p = Proof_global.give_me_the_proof () in
+let pr_goal_by_id ~proof id =
   try
-    Proof.in_proof p (fun sigma ->
+    Proof.in_proof proof (fun sigma ->
       let g = Evd.evar_key id sigma in
       pr_selected_subgoal (pr_id id) sigma g)
   with Not_found -> user_err Pp.(str "No such goal.")
 
-let pr_goal_by_uid uid =
-  let p = Proof_global.give_me_the_proof () in
-  let g = Goal.get_by_uid uid in
-  let pr gs =
-    v 0 (str "goal / evar " ++ str uid ++ str " is:" ++ cut ()
-	 ++ pr_goal gs)
-  in
-  try
-    Proof.in_proof p (fun sigma -> pr {it=g;sigma=sigma;})
-  with Not_found -> user_err Pp.(str "Invalid goal identifier.")
-
 (* Elementary tactics *)
 
 let pr_prim_rule = function
@@ -860,15 +861,15 @@ let prterm = pr_lconstr
    It is used primarily by the Print Assumptions command. *)
 
 type axiom =
-  | Constant of constant (* An axiom or a constant. *)
+  | Constant of Constant.t (* 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 *)
+  | Guarded of Constant.t (* 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 axiom * (Label.t * Context.Rel.t * types) list
-  | Opaque of constant     (* An opaque constant. *)
-  | Transparent of constant
+  | Opaque of Constant.t     (* An opaque constant. *)
+  | Transparent of Constant.t
 
 (* Defines a set of [assumption] *)
 module OrderedContextObject =
@@ -878,11 +879,11 @@ struct
   let compare_axiom x y =
     match x,y with
     | Constant k1 , Constant k2 ->
-        con_ord k1 k2
+        Constant.CanOrd.compare k1 k2
     | Positive m1 , Positive m2 ->
         MutInd.CanOrd.compare m1 m2
     | Guarded k1 , Guarded k2 ->
-        con_ord k1 k2
+        Constant.CanOrd.compare k1 k2
     | _ , Constant _ -> 1
     | _ , Positive _ -> 1
     | _ -> -1
@@ -895,16 +896,16 @@ struct
     | Axiom (k1,_) , Axiom (k2, _) -> compare_axiom k1 k2
     | Axiom _ , _ -> -1
     | _ , Axiom _ -> 1
-    | Opaque k1 , Opaque k2 -> con_ord k1 k2
+    | Opaque k1 , Opaque k2 -> Constant.CanOrd.compare k1 k2
     | Opaque _ , _ -> -1
     | _ , Opaque _ -> 1
-    | Transparent k1 , Transparent k2 -> con_ord k1 k2
+    | Transparent k1 , Transparent k2 -> Constant.CanOrd.compare k1 k2
 end
 
 module ContextObjectSet = Set.Make (OrderedContextObject)
 module ContextObjectMap = Map.Make (OrderedContextObject)
 
-let pr_assumptionset env s =
+let pr_assumptionset env sigma s =
   if ContextObjectMap.is_empty s &&
        engagement env = PredicativeSet then
     str "Closed under the global context"
@@ -912,15 +913,14 @@ let pr_assumptionset env s =
     let safe_pr_constant env kn =
       try pr_constant env kn
       with Not_found ->
-	let mp,_,lab = repr_con kn in
-        str (string_of_mp mp) ++ str "." ++ pr_label lab
+	let mp,_,lab = Constant.repr3 kn in
+        str (ModPath.to_string mp) ++ str "." ++ Label.print lab
     in
     let safe_pr_ltype typ =
       try str " : " ++ pr_ltype typ
       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 CErrors.noncritical e -> mt ()
@@ -947,7 +947,7 @@ let pr_assumptionset env s =
         let ax = pr_axiom env axiom typ ++
           cut() ++
           prlist_with_sep cut (fun (lbl, ctx, ty) ->
-            str " used in " ++ pr_label lbl ++
+            str " used in " ++ Label.print lbl ++
             str " to prove:" ++ safe_pr_ltype_relctx (ctx,ty))
           l in
         (v, ax :: a, o, tr)
diff --git a/printing/printer.mli b/printing/printer.mli
index 2c9a4d70e..a3427920a 100644
--- a/printing/printer.mli
+++ b/printing/printer.mli
@@ -8,12 +8,13 @@
 
 open Names
 open Globnames
-open Term
+open Constr
 open Environ
 open Pattern
 open Evd
 open Proof_type
 open Glob_term
+open Ltac_pretype
 
 (** These are the entry points for printing terms, context, tac, ... *)
 
@@ -26,86 +27,112 @@ val enable_goal_names_printing     : bool ref
 
 val pr_lconstr_env         : env -> evar_map -> constr -> Pp.t
 val pr_lconstr             : constr -> Pp.t
+[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"]
 val pr_lconstr_goal_style_env : env -> evar_map -> constr -> Pp.t
 
 val pr_constr_env          : env -> evar_map -> constr -> Pp.t
 val pr_constr              : constr -> Pp.t
+[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"]
 val pr_constr_goal_style_env : env -> evar_map -> constr -> Pp.t
 
+val pr_constr_n_env        : env -> evar_map -> Notation_term.tolerability -> constr -> Pp.t
+
 (** Same, but resilient to [Nametab] errors. Prints fully-qualified
     names when [shortest_qualid_of_global] has failed. Prints "??"
     in case of remaining issues (such as reference not in env). *)
 
 val safe_pr_lconstr_env         : env -> evar_map -> constr -> Pp.t
 val safe_pr_lconstr             : constr -> Pp.t
+[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"]
 
 val safe_pr_constr_env          : env -> evar_map -> constr -> Pp.t
 val safe_pr_constr              : constr -> Pp.t
+[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"]
 
 val pr_econstr_env     : env -> evar_map -> EConstr.t -> Pp.t
 val pr_econstr         : EConstr.t -> Pp.t
+[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"]
 val pr_leconstr_env     : env -> evar_map -> EConstr.t -> Pp.t
 val pr_leconstr         : EConstr.t -> Pp.t
+[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"]
+
+val pr_econstr_n_env    : env -> evar_map -> Notation_term.tolerability -> EConstr.t -> Pp.t
 
 val pr_etype_env           : env -> evar_map -> EConstr.types -> Pp.t
 val pr_letype_env           : env -> evar_map -> EConstr.types -> Pp.t
 
 val pr_open_constr_env     : env -> evar_map -> open_constr -> Pp.t
 val pr_open_constr         : open_constr -> Pp.t
+[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"]
 
 val pr_open_lconstr_env    : env -> evar_map -> open_constr -> Pp.t
 val pr_open_lconstr        : open_constr -> Pp.t
+[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"]
 
 val pr_constr_under_binders_env  : env -> evar_map -> constr_under_binders -> Pp.t
 val pr_constr_under_binders      : constr_under_binders -> Pp.t
+[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"]
 
 val pr_lconstr_under_binders_env : env -> evar_map -> constr_under_binders -> Pp.t
 val pr_lconstr_under_binders     : constr_under_binders -> Pp.t
+[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"]
 
 val pr_goal_concl_style_env : env -> evar_map -> EConstr.types -> Pp.t
 val pr_ltype_env           : env -> evar_map -> types -> Pp.t
 val pr_ltype               : types -> Pp.t
+[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"]
 
 val pr_type_env            : env -> evar_map -> types -> Pp.t
 val pr_type                : types -> Pp.t
+[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"]
 
+val pr_closed_glob_n_env   : env -> evar_map -> Notation_term.tolerability -> closed_glob_constr -> Pp.t
 val pr_closed_glob_env     : env -> evar_map -> closed_glob_constr -> Pp.t
 val pr_closed_glob         : closed_glob_constr -> Pp.t
+[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"]
 
 val pr_ljudge_env          : env -> evar_map -> EConstr.unsafe_judgment -> Pp.t * Pp.t
 val pr_ljudge              : EConstr.unsafe_judgment -> Pp.t * Pp.t
+[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"]
 
-val pr_lglob_constr_env      : env -> glob_constr -> Pp.t
-val pr_lglob_constr          : glob_constr -> Pp.t
+val pr_lglob_constr_env      : env -> 'a glob_constr_g -> Pp.t
+val pr_lglob_constr          : 'a glob_constr_g -> Pp.t
+[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"]
 
-val pr_glob_constr_env       : env -> glob_constr -> Pp.t
-val pr_glob_constr           : glob_constr -> Pp.t
+val pr_glob_constr_env       : env -> 'a glob_constr_g -> Pp.t
+val pr_glob_constr           : 'a glob_constr_g -> Pp.t
+[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"]
 
 val pr_lconstr_pattern_env : env -> evar_map -> constr_pattern -> Pp.t
 val pr_lconstr_pattern     : constr_pattern -> Pp.t
+[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"]
 
 val pr_constr_pattern_env  : env -> evar_map -> constr_pattern -> Pp.t
 val pr_constr_pattern      : constr_pattern -> Pp.t
+[@@ocaml.deprecated "The global printing API is deprecated, please use the _env functions"]
 
 val pr_cases_pattern       : cases_pattern -> Pp.t
 
-val pr_sort                : evar_map -> sorts -> Pp.t
+val pr_sort                : evar_map -> Sorts.t -> Pp.t
 
 (** Universe constraints *)
 
 val pr_polymorphic         : bool -> Pp.t
 val pr_cumulative          : bool -> bool -> Pp.t
-val pr_universe_instance   : evar_map -> Univ.universe_context -> Pp.t
-val pr_universe_ctx        : evar_map -> Univ.universe_context -> Pp.t
-val pr_cumulativity_info   : evar_map -> Univ.cumulativity_info -> Pp.t
+val pr_universe_instance   : evar_map -> Univ.UContext.t -> Pp.t
+val pr_universe_ctx        : evar_map -> ?variance:Univ.Variance.t array ->
+  Univ.UContext.t -> Pp.t
+val pr_universe_ctx_set    : evar_map -> Univ.ContextSet.t -> Pp.t
+val pr_constant_universes  : evar_map -> Entries.constant_universes_entry -> Pp.t
+val pr_cumulativity_info   : evar_map -> Univ.CumulativityInfo.t -> Pp.t
 
 (** Printing global references using names as short as possible *)
 
 val pr_global_env          : Id.Set.t -> global_reference -> Pp.t
 val pr_global              : global_reference -> Pp.t
 
-val pr_constant            : env -> constant -> Pp.t
-val pr_existential_key     : evar_map -> existential_key -> Pp.t
+val pr_constant            : env -> Constant.t -> Pp.t
+val pr_existential_key     : evar_map -> Evar.t -> Pp.t
 val pr_existential         : env -> evar_map -> existential -> Pp.t
 val pr_constructor         : env -> constructor -> Pp.t
 val pr_inductive           : env -> inductive -> Pp.t
@@ -154,15 +181,15 @@ val pr_goal                : goal sigma -> Pp.t
    focused goals unless the conrresponding option
    [enable_unfocused_goal_printing] is set. [seeds] is for printing
    dependent evars (mainly for emacs proof tree mode). *)
-val pr_subgoals            : ?pr_first:bool -> Pp.t option -> evar_map -> evar list -> Goal.goal list -> int list
+val pr_subgoals            : ?pr_first:bool -> Pp.t option -> evar_map -> Evar.t list -> Goal.goal list -> int list
                              -> goal list -> goal list -> Pp.t
 
 val pr_subgoal             : int -> evar_map -> goal list -> Pp.t
 val pr_concl               : int -> evar_map -> goal -> Pp.t
 
-val pr_open_subgoals       : ?proof:Proof.proof -> unit -> Pp.t
-val pr_nth_open_subgoal    : int -> Pp.t
-val pr_evar                : evar_map -> (evar * evar_info) -> Pp.t
+val pr_open_subgoals       : proof:Proof.t -> Pp.t
+val pr_nth_open_subgoal    : proof:Proof.t -> int -> Pp.t
+val pr_evar                : evar_map -> (Evar.t * evar_info) -> Pp.t
 val pr_evars_int           : evar_map -> int -> evar_info Evar.Map.t -> Pp.t
 val pr_evars               : evar_map -> evar_info Evar.Map.t -> Pp.t
 val pr_ne_evar_set         : Pp.t -> Pp.t -> evar_map ->
@@ -177,31 +204,29 @@ val prterm                 : constr -> Pp.t (** = pr_lconstr *)
 
 (** Declarations for the "Print Assumption" command *)
 type axiom =
-  | Constant of constant (* An axiom or a constant. *)
+  | Constant of Constant.t (* 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 *)
+  | Guarded of Constant.t (* 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 axiom * (Label.t * Context.Rel.t * types) list
-  | Opaque of constant     (* An opaque constant. *)
-  | Transparent of constant
+  | Opaque of Constant.t     (* An opaque constant. *)
+  | Transparent of Constant.t
 
 module ContextObjectSet : Set.S with type elt = context_object
 module ContextObjectMap : CMap.ExtS
   with type key = context_object and module Set := ContextObjectSet
 
-val pr_assumptionset :
-  env -> Term.types ContextObjectMap.t -> Pp.t
+val pr_assumptionset : env -> evar_map -> types ContextObjectMap.t -> Pp.t
 
-val pr_goal_by_id : Id.t -> Pp.t
-val pr_goal_by_uid : string -> Pp.t
+val pr_goal_by_id : proof:Proof.t -> Id.t -> Pp.t
 
 type printer_pr = {
- pr_subgoals            : ?pr_first:bool -> Pp.t option -> evar_map -> evar list -> Goal.goal list -> int list -> goal list -> goal list -> Pp.t;
+ pr_subgoals            : ?pr_first:bool -> Pp.t option -> evar_map -> Evar.t list -> Goal.goal list -> int list -> goal list -> goal list -> Pp.t;
  pr_subgoal             : int -> evar_map -> goal list -> Pp.t;
  pr_goal                : goal sigma -> Pp.t;
-};;
+}
 
 val set_printer_pr : printer_pr -> unit
 
diff --git a/printing/printmod.ml b/printing/printmod.ml
index 219eafda4..2cdb9be3f 100644
--- a/printing/printmod.ml
+++ b/printing/printmod.ml
@@ -7,12 +7,11 @@
 (************************************************************************)
 
 open Util
-open Term
+open Constr
 open Pp
 open Names
 open Environ
 open Declarations
-open Nameops
 open Globnames
 open Libnames
 open Goptions
@@ -64,9 +63,10 @@ let get_new_id locals id =
       if not (Nametab.exists_module dir) then
 	id
       else
-	get_id (id::l) (Namegen.next_ident_away id l)
+	get_id (Id.Set.add id l) (Namegen.next_ident_away id l)
   in
-    get_id (List.map snd locals) id
+  let avoid = List.fold_left (fun accu (_, id) -> Id.Set.add id accu) Id.Set.empty locals in
+    get_id avoid id
 
 (** Inductive declarations *)
 
@@ -79,7 +79,7 @@ let print_params env sigma params =
 let print_constructors envpar sigma names types =
   let pc =
     prlist_with_sep (fun () -> brk(1,0) ++ str "| ")
-      (fun (id,c) -> pr_id id ++ str " : " ++ Printer.pr_lconstr_env envpar sigma c)
+      (fun (id,c) -> Id.print id ++ str " : " ++ Printer.pr_lconstr_env envpar sigma c)
       (Array.to_list (Array.map2 (fun n t -> (n,t)) names types))
   in
   hv 0 (str "  " ++ pc)
@@ -93,10 +93,11 @@ let print_one_inductive env sigma mib ((_,i) as ind) =
     else Univ.Instance.empty in
   let mip = mib.mind_packets.(i) in
   let params = Inductive.inductive_paramdecls (mib,u) in
+  let nparamdecls = Context.Rel.length params in
   let args = Context.Rel.to_extended_list mkRel 0 params in
-  let arity = hnf_prod_applist env (build_ind_type env ((mib,mip),u)) args in
+  let arity = hnf_prod_applist_assum env nparamdecls (build_ind_type env ((mib,mip),u)) args in
   let cstrtypes = Inductive.type_of_constructors (ind,u) (mib,mip) in
-  let cstrtypes = Array.map (fun c -> hnf_prod_applist env c args) cstrtypes in
+  let cstrtypes = Array.map (fun c -> hnf_prod_applist_assum env nparamdecls c args) cstrtypes in
   let envpar = push_rel_context params env in
   let inst =
     if Declareops.inductive_is_polymorphic mib then
@@ -106,32 +107,38 @@ let print_one_inductive env sigma mib ((_,i) as ind) =
     else mt ()
   in
   hov 0 (
-    pr_id mip.mind_typename ++ inst ++ brk(1,4) ++ print_params env sigma params ++
+    Id.print mip.mind_typename ++ inst ++ brk(1,4) ++ print_params env sigma params ++
     str ": " ++ Printer.pr_lconstr_env envpar sigma arity ++ str " :=") ++
   brk(0,2) ++ print_constructors envpar sigma mip.mind_consnames cstrtypes
 
 let instantiate_cumulativity_info cumi =
   let open Univ in
   let univs = ACumulativityInfo.univ_context cumi in
-  let subtyp = ACumulativityInfo.subtyp_context cumi in
   let expose ctx =
     let inst = AUContext.instance ctx in
     let cst = AUContext.instantiate inst ctx in
     UContext.make (inst, cst)
   in
-  CumulativityInfo.make (expose univs, expose subtyp)
+  CumulativityInfo.make (expose univs, ACumulativityInfo.variance cumi)
 
-let print_mutual_inductive env mind mib =
+let print_mutual_inductive env mind mib udecl =
   let inds = List.init (Array.length mib.mind_packets) (fun x -> (mind, x))
   in
   let keyword =
-    let open Decl_kinds in
+    let open Declarations in
     match mib.mind_finite with
     | Finite -> "Inductive"
     | BiFinite -> "Variant"
     | CoFinite -> "CoInductive"
   in
-  let bl = Universes.universe_binders_of_global (IndRef (mind, 0)) in
+  let univs =
+    let open Univ in
+    if Declareops.inductive_is_polymorphic mib then
+      Array.to_list (Instance.to_array
+                       (AUContext.instance (Declareops.inductive_polymorphic_context mib)))
+    else []
+  in
+  let bl = Universes.universe_binders_with_opt_names (IndRef (mind, 0)) univs udecl in
   let sigma = Evd.from_ctx (Evd.evar_universe_context_of_binders bl) in
   hov 0 (Printer.pr_polymorphic (Declareops.inductive_is_polymorphic mib) ++
          Printer.pr_cumulative
@@ -148,7 +155,7 @@ let print_mutual_inductive env mind mib =
 
 let get_fields =
   let rec prodec_rec l subst c =
-    match kind_of_term c with
+    match kind c with
     | Prod (na,t,c) ->
         let id = match na with Name id -> id | Anonymous -> Id.of_string "_" in
         prodec_rec ((id,true,Vars.substl subst t)::l) (mkVar id::subst) c
@@ -159,7 +166,7 @@ let get_fields =
   in
   prodec_rec [] []
 
-let print_record env mind mib =
+let print_record env mind mib udecl =
   let u = 
     if Declareops.inductive_is_polymorphic mib then 
       Univ.AUContext.instance (Declareops.inductive_polymorphic_context mib)
@@ -167,16 +174,18 @@ let print_record env mind mib =
   in
   let mip = mib.mind_packets.(0) in
   let params = Inductive.inductive_paramdecls (mib,u) in
+  let nparamdecls = Context.Rel.length params in
   let args = Context.Rel.to_extended_list mkRel 0 params in
-  let arity = hnf_prod_applist env (build_ind_type env ((mib,mip),u)) args in
+  let arity = hnf_prod_applist_assum env nparamdecls (build_ind_type env ((mib,mip),u)) args in
   let cstrtypes = Inductive.type_of_constructors ((mind,0),u) (mib,mip) in
-  let cstrtype = hnf_prod_applist env cstrtypes.(0) args in
+  let cstrtype = hnf_prod_applist_assum env nparamdecls cstrtypes.(0) args in
   let fields = get_fields cstrtype in
   let envpar = push_rel_context params env in
-  let bl = Universes.universe_binders_of_global (IndRef (mind,0)) in
+  let bl = Universes.universe_binders_with_opt_names (IndRef (mind,0))
+      (Array.to_list (Univ.Instance.to_array u)) udecl in
   let sigma = Evd.from_ctx (Evd.evar_universe_context_of_binders bl) in
   let keyword =
-    let open Decl_kinds in
+    let open Declarations in
     match mib.mind_finite with
     | BiFinite -> "Record"
     | Finite -> "Inductive"
@@ -188,15 +197,15 @@ let print_record env mind mib =
       Printer.pr_cumulative
         (Declareops.inductive_is_polymorphic mib)
         (Declareops.inductive_is_cumulative mib) ++
-      def keyword ++ spc () ++ pr_id mip.mind_typename ++ brk(1,4) ++
+      def keyword ++ spc () ++ Id.print mip.mind_typename ++ brk(1,4) ++
       print_params env sigma params ++
       str ": " ++ Printer.pr_lconstr_env envpar sigma arity ++ brk(1,2) ++
-      str ":= " ++ pr_id mip.mind_consnames.(0)) ++
+      str ":= " ++ Id.print mip.mind_consnames.(0)) ++
     brk(1,2) ++
     hv 2 (str "{ " ++
       prlist_with_sep (fun () -> str ";" ++ brk(2,0))
         (fun (id,b,c) ->
-          pr_id id ++ str (if b then " : " else " := ") ++
+          Id.print id ++ str (if b then " : " else " := ") ++
           Printer.pr_lconstr_env envpar sigma c) fields) ++ str" }" ++
     match mib.mind_universes with
     | Monomorphic_ind _ | Polymorphic_ind _ -> str ""
@@ -205,18 +214,18 @@ let print_record env mind mib =
         sigma (instantiate_cumulativity_info cumi)
   )
 
-let pr_mutual_inductive_body env mind mib =
+let pr_mutual_inductive_body env mind mib udecl =
   if mib.mind_record <> None && not !Flags.raw_print then
-    print_record env mind mib
+    print_record env mind mib udecl
   else
-    print_mutual_inductive env mind mib
+    print_mutual_inductive env mind mib udecl
 
 (** Modpaths *)
 
 let rec print_local_modpath locals = function
-  | MPbound mbid -> pr_id (Util.List.assoc_f MBId.equal mbid locals)
+  | MPbound mbid -> Id.print (Util.List.assoc_f MBId.equal mbid locals)
   | MPdot(mp,l) ->
-      print_local_modpath locals mp ++ str "." ++ pr_lab l
+      print_local_modpath locals mp ++ str "." ++ Label.print l
   | MPfile _ -> raise Not_found
 
 let print_modpath locals mp =
@@ -237,10 +246,10 @@ let print_kn locals kn =
 	with
 	    Not_found -> print_modpath locals kn
 
-let nametab_register_dir mp =
+let nametab_register_dir obj_mp =
   let id = mk_fake_top () in
-  let dir = DirPath.make [id] in
-  Nametab.push_dir (Nametab.Until 1) dir (DirModule (dir,(mp,DirPath.empty)))
+  let obj_dir = DirPath.make [id] in
+  Nametab.push_dir (Nametab.Until 1) obj_dir (DirModule { obj_dir; obj_mp; obj_sec = DirPath.empty })
 
 (** Nota: the [global_reference] we register in the nametab below
     might differ from internal ones, since we cannot recreate here
@@ -300,7 +309,7 @@ let nametab_register_modparam mbid mtb =
       id
 
 let print_body is_impl env mp (l,body) =
-  let name = pr_label l in
+  let name = Label.print l in
   hov 2 (match body with
     | SFBmodule _ -> keyword "Module" ++ spc () ++ name
     | SFBmodtype _ -> keyword "Module Type" ++ spc () ++ name
@@ -335,10 +344,10 @@ let print_body is_impl env mp (l,body) =
     | SFBmind mib ->
       try
 	let env = Option.get env in
-	pr_mutual_inductive_body env (MutInd.make2 mp l) mib
+        pr_mutual_inductive_body env (MutInd.make2 mp l) mib None
       with e when CErrors.noncritical e ->
         let keyword =
-          let open Decl_kinds in
+          let open Declarations in
           match mib.mind_finite with
           | Finite -> def "Inductive"
           | BiFinite -> def "Variant"
@@ -374,9 +383,12 @@ let rec print_typ_expr env mp locals mty =
   | MEwith(me,WithDef(idl,(c, _)))->
       let env' = None in (* TODO: build a proper environment if env <> None *)
       let s = String.concat "." (List.map Id.to_string idl) in
+      (* XXX: What should env and sigma be here? *)
+      let env = Global.env () in
+      let sigma = Evd.empty in
       hov 2 (print_typ_expr env' mp locals me ++ spc() ++ str "with" ++ spc()
              ++ def "Definition"++ spc() ++ str s ++ spc() ++ str ":="++ spc()
-             ++ Printer.pr_lconstr c)
+             ++ Printer.pr_lconstr_env env sigma c)
   | MEwith(me,WithMod(idl,mp'))->
       let s = String.concat "." (List.map Id.to_string idl) in
       hov 2 (print_typ_expr env mp locals me ++ spc() ++ str "with" ++ spc() ++
@@ -402,7 +414,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 id ++ str ":" ++ pr_mtb1 ++ str ")" ++
+	 str "(" ++ Id.print id ++ str ":" ++ pr_mtb1 ++ str ")" ++
 	 spc() ++ print_functor fty fatom is_type env' mp locals' me2)
 
 let rec print_expression x =
diff --git a/printing/printmod.mli b/printing/printmod.mli
index 8c3f0149e..4f15dd393 100644
--- a/printing/printmod.mli
+++ b/printing/printmod.mli
@@ -11,6 +11,8 @@ open Names
 (** false iff the module is an element of an open module type *)
 val printable_body : DirPath.t -> bool
 
-val pr_mutual_inductive_body : Environ.env -> mutual_inductive -> Declarations.mutual_inductive_body -> Pp.t
-val print_module : bool -> module_path -> Pp.t
-val print_modtype : module_path -> Pp.t
+val pr_mutual_inductive_body : Environ.env ->
+  MutInd.t -> Declarations.mutual_inductive_body ->
+  Universes.univ_name_list option -> Pp.t
+val print_module : bool -> ModPath.t -> Pp.t
+val print_modtype : ModPath.t -> Pp.t
diff --git a/proofs/clenv.ml b/proofs/clenv.ml
index ea60be31f..9e06d913b 100644
--- a/proofs/clenv.ml
+++ b/proofs/clenv.ml
@@ -154,7 +154,7 @@ let error_incompatible_inst clenv mv  =
       Name id ->
         user_err ~hdr:"clenv_assign"
           (str "An incompatible instantiation has already been found for " ++
-           pr_id id)
+           Id.print id)
     | _ ->
         anomaly ~label:"clenv_assign" (Pp.str "non dependent metavar already assigned.")
 
@@ -417,7 +417,7 @@ let check_bindings bl =
   match List.duplicates qhyp_eq (List.map (fun x -> fst (snd x)) bl) with
     | NamedHyp s :: _ ->
 	user_err 
-	  (str "The variable " ++ pr_id s ++
+	  (str "The variable " ++ Id.print s ++
 	   str " occurs more than once in binding list.");
     | AnonHyp n :: _ ->
 	user_err 
@@ -435,12 +435,12 @@ let explain_no_such_bound_variable evd id =
   in
   let mvl = List.fold_left fold [] (Evd.meta_list evd) in
   user_err ~hdr:"Evd.meta_with_name"
-    (str"No such bound variable " ++ pr_id id ++
+    (str"No such bound variable " ++ Id.print id ++
      (if mvl == [] then str " (no bound variables at all in the expression)."
       else
         (str" (possible name" ++
          str (if List.length mvl == 1 then " is: " else "s are: ") ++
-         pr_enum pr_id mvl ++ str").")))
+         pr_enum Id.print mvl ++ str").")))
 
 let meta_with_name evd id =
   let na = Name id in
@@ -460,7 +460,7 @@ let meta_with_name evd id =
         n
     | _  ->
         user_err ~hdr:"Evd.meta_with_name"
-          (str "Binder name \"" ++ pr_id id ++
+          (str "Binder name \"" ++ Id.print id ++
            strbrk "\" occurs more than once in clause.")
 
 let meta_of_binder clause loc mvs = function
@@ -474,7 +474,7 @@ let error_already_defined b =
   match b with
     | NamedHyp id ->
         user_err 
-          (str "Binder name \"" ++ pr_id id ++
+          (str "Binder name \"" ++ Id.print id ++
            str"\" already defined with incompatible value.")
     | AnonHyp n ->
         anomaly
@@ -498,7 +498,7 @@ let clenv_unify_binding_type clenv c t u =
 
 let clenv_assign_binding clenv k c =
   let k_typ = clenv_hnf_constr clenv (clenv_meta_type clenv k) in
-  let c_typ = nf_betaiota clenv.evd (clenv_get_type_of clenv c) in
+  let c_typ = nf_betaiota clenv.env clenv.evd (clenv_get_type_of clenv c) in
   let status,clenv',c = clenv_unify_binding_type clenv c c_typ k_typ in
   let c = EConstr.Unsafe.to_constr c in
   { clenv' with evd = meta_assign k (c,(Conv,status)) clenv'.evd }
@@ -557,7 +557,7 @@ let make_clenv_binding_gen hyps_only n env sigma (c,t) = function
       let clause = mk_clenv_from_env env sigma n (c,t) in
       clenv_constrain_dep_args hyps_only largs clause
   | ExplicitBindings lbind ->
-      let t = rename_bound_vars_as_displayed sigma [] [] t in
+      let t = rename_bound_vars_as_displayed sigma Id.Set.empty [] t in
       let clause = mk_clenv_from_env env sigma n
 	(c, t)
       in clenv_match_args lbind clause
@@ -605,7 +605,7 @@ let make_evar_clause env sigma ?len t =
   | Some n -> assert (0 <= n); n
   in
   (** FIXME: do the renaming online *)
-  let t = rename_bound_vars_as_displayed sigma [] [] t in
+  let t = rename_bound_vars_as_displayed sigma Id.Set.empty [] t in
   let rec clrec (sigma, holes) n t =
     if n = 0 then (sigma, holes, t)
     else match EConstr.kind sigma t with
@@ -639,10 +639,10 @@ let explain_no_such_bound_variable holes id =
   let mvl = List.fold_right fold holes [] in
   let expl = match mvl with
   | [] -> str " (no bound variables at all in the expression)."
-  | [id] -> str "(possible name is: " ++ pr_id id ++ str ")."
-  | _ -> str "(possible names are: " ++ pr_enum pr_id mvl ++ str ")."
+  | [id] -> str "(possible name is: " ++ Id.print id ++ str ")."
+  | _ -> str "(possible names are: " ++ pr_enum Id.print mvl ++ str ")."
   in
-  user_err  (str "No such bound variable " ++ pr_id id ++ expl)
+  user_err  (str "No such bound variable " ++ Id.print id ++ expl)
 
 let evar_with_name holes id =
   let map h = match h.hole_name with
@@ -655,7 +655,7 @@ let evar_with_name holes id =
   | [h] -> h.hole_evar
   | _ ->
     user_err 
-      (str "Binder name \"" ++ pr_id id ++
+      (str "Binder name \"" ++ Id.print id ++
         str "\" occurs more than once in clause.")
 
 let evar_of_binder holes = function
diff --git a/proofs/clenv.mli b/proofs/clenv.mli
index 9c69995f4..c894b9dc9 100644
--- a/proofs/clenv.mli
+++ b/proofs/clenv.mli
@@ -11,7 +11,7 @@
     evar-based clauses. *)
 
 open Names
-open Term
+open Constr
 open Environ
 open Evd
 open EConstr
@@ -41,10 +41,10 @@ val clenv_nf_meta   : clausenv -> EConstr.constr -> EConstr.constr
 (** type of a meta in clenv context *)
 val clenv_meta_type : clausenv -> metavariable -> types
 
-val mk_clenv_from : 'a Proofview.Goal.t -> EConstr.constr * EConstr.types -> clausenv
+val mk_clenv_from : Proofview.Goal.t -> EConstr.constr * EConstr.types -> clausenv
 val mk_clenv_from_n :
-  'a Proofview.Goal.t -> int option -> EConstr.constr * EConstr.types -> clausenv
-val mk_clenv_type_of : 'a Proofview.Goal.t -> EConstr.constr -> clausenv
+  Proofview.Goal.t -> int option -> EConstr.constr * EConstr.types -> clausenv
+val mk_clenv_type_of : Proofview.Goal.t -> EConstr.constr -> clausenv
 val mk_clenv_from_env : env -> evar_map -> int option -> EConstr.constr * EConstr.types -> clausenv
 
 (** Refresh the universes in a clenv *)
@@ -66,7 +66,7 @@ val old_clenv_unique_resolver :
   ?flags:unify_flags -> clausenv -> Goal.goal sigma -> clausenv
 
 val clenv_unique_resolver :
-  ?flags:unify_flags -> clausenv -> 'a Proofview.Goal.t -> clausenv
+  ?flags:unify_flags -> clausenv -> Proofview.Goal.t -> clausenv
 
 val clenv_dependent : clausenv -> metavariable list
 
diff --git a/proofs/clenvtac.ml b/proofs/clenvtac.ml
index 4a92c3856..373d60e69 100644
--- a/proofs/clenvtac.ml
+++ b/proofs/clenvtac.ml
@@ -54,9 +54,10 @@ let clenv_value_cast_meta clenv =
 
 let clenv_pose_dependent_evars with_evars clenv =
   let dep_mvs = clenv_dependent clenv in
+  let env, sigma = clenv.env, clenv.evd in
   if not (List.is_empty dep_mvs) && not with_evars then
     raise
-      (RefinerError (UnresolvedBindings (List.map (meta_name clenv.evd) dep_mvs)));
+      (RefinerError (env, sigma, 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 *)
@@ -140,7 +141,7 @@ let fail_quick_unif_flags = {
 let unify ?(flags=fail_quick_unif_flags) m =
   Proofview.Goal.enter begin fun gl ->
     let env = Tacmach.New.pf_env gl in
-    let n = Tacmach.New.pf_concl (Proofview.Goal.assume gl) in
+    let n = Tacmach.New.pf_concl gl in
     let evd = clear_metas (Tacmach.New.project gl) in
     try
       let evd' = w_unify env evd CONV ~flags m n in
diff --git a/proofs/evar_refiner.ml b/proofs/evar_refiner.ml
index 48fa2202e..d38ff7512 100644
--- a/proofs/evar_refiner.ml
+++ b/proofs/evar_refiner.ml
@@ -14,6 +14,7 @@ open Evarutil
 open Evarsolve
 open Pp
 open Glob_term
+open Ltac_pretype
 
 (******************************************)
 (* Instantiation of existential variables *)
diff --git a/proofs/evar_refiner.mli b/proofs/evar_refiner.mli
index 5d6971596..d90cff572 100644
--- a/proofs/evar_refiner.mli
+++ b/proofs/evar_refiner.mli
@@ -8,10 +8,11 @@
 
 open Evd
 open Glob_term
+open Ltac_pretype
 
 (** Refinement of existential variables. *)
 
 type glob_constr_ltac_closure = ltac_var_map * glob_constr
 
-val w_refine : evar * evar_info ->
+val w_refine : Evar.t * evar_info ->
   glob_constr_ltac_closure -> evar_map -> evar_map
diff --git a/proofs/goal.ml b/proofs/goal.ml
index 7d830146f..d5bc7e0ce 100644
--- a/proofs/goal.ml
+++ b/proofs/goal.ml
@@ -16,12 +16,11 @@ module NamedDecl = Context.Named.Declaration
    evar is defined in the current evar_map, should not be accessed. *)
 
 (* type of the goals *)
-type goal = Evd.evar
+type goal = Evar.t
 
 let pr_goal e = str "GOAL:" ++ Pp.int (Evar.repr e)
 
 let uid e = string_of_int (Evar.repr e)
-let get_by_uid u = Evar.unsafe_of_int (int_of_string u)
 
 (* Layer to implement v8.2 tactic engine ontop of the new architecture.
    Types are different from what they used to be due to a change of the
@@ -100,7 +99,7 @@ module V82 = struct
   let same_goal evars1 gl1 evars2 gl2 =
     let evi1 = Evd.find evars1 gl1 in
     let evi2 = Evd.find evars2 gl2 in
-    Term.eq_constr evi1.Evd.evar_concl evi2.Evd.evar_concl &&
+    Constr.equal evi1.Evd.evar_concl evi2.Evd.evar_concl &&
     Environ.eq_named_context_val evi1.Evd.evar_hyps evi2.Evd.evar_hyps
 
   let weak_progress glss gls =
diff --git a/proofs/goal.mli b/proofs/goal.mli
index 6d3ec8bd4..37dd9d3c0 100644
--- a/proofs/goal.mli
+++ b/proofs/goal.mli
@@ -15,9 +15,6 @@ type goal = Evar.t
 (* Gives a unique identifier to each goal. The identifier is
    guaranteed to contain no space. *)
 val uid : goal -> string
-(* Returns the goal (even if it has been partially solved)
-   corresponding to a unique identifier obtained by {!uid}. *)
-val get_by_uid : string -> goal
 
 (* Debugging help *)
 val pr_goal : goal -> Pp.t
@@ -61,7 +58,7 @@ module V82 : sig
 
   (* Principal part of the progress tactical *)
   val progress : goal list Evd.sigma -> goal Evd.sigma -> bool
-    
+
  (* Principal part of tclNOTSAMEGOAL *)
   val same_goal : Evd.evar_map -> goal -> Evd.evar_map -> goal -> bool
 
diff --git a/proofs/logic.ml b/proofs/logic.ml
index 20d075ae1..5ff5fa38a 100644
--- a/proofs/logic.ml
+++ b/proofs/logic.ml
@@ -11,7 +11,7 @@ open CErrors
 open Util
 open Names
 open Nameops
-open Term
+open Constr
 open Vars
 open Termops
 open Environ
@@ -40,7 +40,7 @@ type refiner_error =
   | DoesNotOccurIn of constr * Id.t
   | NoSuchHyp of Id.t
 
-exception RefinerError of refiner_error
+exception RefinerError of Environ.env * Evd.evar_map * refiner_error
 
 open Pretype_errors
 
@@ -69,7 +69,7 @@ let catchable_exception = function
   | PretypeError(_,_, e) -> is_unification_error e || is_typing_error e 
   | _ -> false
 
-let error_no_such_hypothesis id = raise (RefinerError (NoSuchHyp id))
+let error_no_such_hypothesis env sigma id = raise (RefinerError (env, sigma, NoSuchHyp id))
 
 (* Tells if the refiner should check that the submitted rules do not
    produce invalid subgoals *)
@@ -78,10 +78,10 @@ let with_check = Flags.with_option check
 
 (* [apply_to_hyp sign id f] splits [sign] into [tail::[id,_,_]::head] and
    returns [tail::(f head (id,_,_) (rev tail))] *)
-let apply_to_hyp check sign id f =
+let apply_to_hyp env sigma check sign id f =
   try apply_to_hyp sign id f
   with Hyp_not_found ->
-    if check then error_no_such_hypothesis id
+    if check then error_no_such_hypothesis env sigma id
     else sign
 
 let check_typability env sigma c =
@@ -139,15 +139,15 @@ let reorder_context env sigma sign ord =
           let ((d,h),mh) = find_q top moved_hyps in
           if occur_vars_in_decl env sigma h d then
             user_err ~hdr:"reorder_context"
-              (str "Cannot move declaration " ++ pr_id top ++ spc() ++
+              (str "Cannot move declaration " ++ Id.print top ++ spc() ++
               str "before " ++
-              pr_sequence pr_id
+              pr_sequence Id.print
                 (Id.Set.elements (Id.Set.inter h
                   (global_vars_set_of_decl env sigma d))));
           step ord' expected ctxt_head mh (d::ctxt_tail)
       | _ ->
           (match ctxt_head with
-            | [] -> error_no_such_hypothesis (List.hd ord)
+            | [] -> error_no_such_hypothesis env sigma (List.hd ord)
             | d :: ctxt ->
                 let x = NamedDecl.get_id d in
                 if Id.Set.mem x expected then
@@ -172,7 +172,7 @@ let check_decl_position env sigma sign d =
   let deps = dependency_closure env sigma (named_context_of_val sign) needed in
   if Id.List.mem x deps then
     user_err ~hdr:"Logic.check_decl_position"
-      (str "Cannot create self-referring hypothesis " ++ pr_id x);
+      (str "Cannot create self-referring hypothesis " ++ Id.print x);
   x::deps
 
 (* Auxiliary functions for primitive MOVE tactic
@@ -190,9 +190,9 @@ let move_location_eq m1 m2 = match m1, m2 with
 | MoveFirst, MoveFirst -> true
 | _ -> false
 
-let split_sign hfrom hto l =
+let split_sign env sigma hfrom hto l =
   let rec splitrec left toleft = function
-    | [] -> error_no_such_hypothesis hfrom
+    | [] -> error_no_such_hypothesis env sigma hfrom
     | d :: right ->
         let hyp = NamedDecl.get_id d in
       	if Id.equal hyp hfrom then
@@ -222,7 +222,7 @@ let move_hyp sigma toleft (left,declfrom,right) hto =
   let rec moverec first middle = function
     | [] ->
 	if match hto with MoveFirst | MoveLast -> false | _ -> true then
-	  error_no_such_hypothesis (hyp_of_move_location hto);
+          error_no_such_hypothesis env sigma (hyp_of_move_location hto);
 	List.rev first @ List.rev middle
     | d :: _ as right when move_location_eq hto (MoveBefore (NamedDecl.get_id d)) ->
 	List.rev first @ List.rev middle @ right
@@ -233,10 +233,10 @@ let move_hyp sigma toleft (left,declfrom,right) hto =
 	    if not (move_location_eq hto (MoveAfter hyp)) then
 	      (first, d::middle)
             else
-	      user_err ~hdr:"move_hyp" (str "Cannot move " ++ pr_id (NamedDecl.get_id declfrom) ++
-	        Miscprint.pr_move_location pr_id hto ++
+	      user_err ~hdr:"move_hyp" (str "Cannot move " ++ Id.print (NamedDecl.get_id declfrom) ++
+	        Miscprint.pr_move_location Id.print hto ++
 	        str (if toleft then ": it occurs in the type of " else ": it depends on ")
-	        ++ pr_id hyp ++ str ".")
+	        ++ Id.print hyp ++ str ".")
           else
 	    (d::first, middle)
 	in
@@ -258,10 +258,10 @@ let move_hyp sigma 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 sigma hfrom hto sign =
+let move_hyp_in_named_context env sigma hfrom hto sign =
   let open EConstr in
   let (left,right,declfrom,toleft) =
-    split_sign hfrom hto (named_context_of_val sign) in
+    split_sign env sigma hfrom hto (named_context_of_val sign) in
   move_hyp sigma toleft (left,declfrom,right) hto
 
 let insert_decl_in_named_context sigma decl hto sign =
@@ -284,24 +284,24 @@ let error_unsupported_deep_meta c =
     strbrk "supported; try \"refine\" instead.")
 
 let collect_meta_variables c =
-  let rec collrec deep acc c = match kind_of_term c with
+  let rec collrec deep acc c = match kind c with
     | Meta mv -> if deep then error_unsupported_deep_meta () else mv::acc
     | Cast(c,_,_) -> collrec deep acc c
-    | (App _| Case _) -> Term.fold_constr (collrec deep) acc c
+    | (App _| Case _) -> Constr.fold (collrec deep) acc c
     | Proj (_, c) -> collrec deep acc c
-    | _ -> Term.fold_constr (collrec true) acc c
+    | _ -> Constr.fold (collrec true) acc c
   in
   List.rev (collrec false [] c)
 
-let check_meta_variables c =
+let check_meta_variables env sigma c =
   if not (List.distinct_f Int.compare (collect_meta_variables c)) then
-    raise (RefinerError (NonLinearProof c))
+    raise (RefinerError (env, sigma, NonLinearProof c))
 
 let check_conv_leq_goal env sigma arg ty conclty =
   if !check then
     let evm, b = Reductionops.infer_conv env sigma (EConstr.of_constr ty) (EConstr.of_constr conclty) in
       if b then evm 
-      else raise (RefinerError (BadType (arg,ty,conclty)))
+      else raise (RefinerError (env, sigma, BadType (arg,ty,conclty)))
   else sigma
 
 exception Stop of EConstr.t list
@@ -332,11 +332,11 @@ let rec mk_refgoals sigma goal goalacc conclty trm =
       let sigma = check_conv_leq_goal env sigma trm t'ty conclty in
         (goalacc,t'ty,sigma,trm)
     else
-      match kind_of_term trm with
+      match kind trm with
       | Meta _ ->
-	let conclty = nf_betaiota sigma (EConstr.of_constr conclty) in
+        let conclty = nf_betaiota env sigma (EConstr.of_constr conclty) in
 	  if !check && occur_meta sigma conclty then
-	    raise (RefinerError (MetaInType conclty));
+            raise (RefinerError (env, sigma, MetaInType conclty));
 	  let (gl,ev,sigma) = mk_goal hyps conclty in
 	  let ev = EConstr.Unsafe.to_constr ev in
 	  let conclty = EConstr.Unsafe.to_constr conclty in
@@ -372,7 +372,7 @@ let rec mk_refgoals sigma goal goalacc conclty trm =
 	in
 	let ((acc'',conclty',sigma), args) = mk_arggoals sigma goal acc' hdty l in
         let sigma = check_conv_leq_goal env sigma trm conclty' conclty in
-        let ans = if applicand == f && args == l then trm else Term.mkApp (applicand, args) in
+        let ans = if applicand == f && args == l then trm else mkApp (applicand, args) in
         (acc'',conclty',sigma, ans)
 
       | Proj (p,c) ->
@@ -394,7 +394,7 @@ let rec mk_refgoals sigma goal goalacc conclty trm =
         let lf' = Array.rev_of_list rbranches in
         let ans =
           if p' == p && c' == c && Array.equal (==) lf' lf then trm
-          else Term.mkCase (ci,p',c',lf')
+          else mkCase (ci,p',c',lf')
         in
 	(acc'',conclty',sigma, ans)
 
@@ -413,10 +413,10 @@ and mk_hdgoals sigma goal goalacc trm =
   let hyps = Goal.V82.hyps sigma goal in
   let mk_goal hyps concl = 
     Goal.V82.mk_goal sigma hyps concl (Goal.V82.extra sigma goal) in
-  match kind_of_term trm with
+  match kind trm with
     | Cast (c,_, ty) when isMeta c ->
 	check_typability env sigma ty;
-	let (gl,ev,sigma) = mk_goal hyps (nf_betaiota sigma (EConstr.of_constr ty)) in
+        let (gl,ev,sigma) = mk_goal hyps (nf_betaiota env sigma (EConstr.of_constr ty)) in
 	let ev = EConstr.Unsafe.to_constr ev in
 	gl::goalacc,ty,sigma,ev
 
@@ -433,7 +433,7 @@ and mk_hdgoals sigma goal goalacc trm =
 	  else mk_hdgoals sigma goal goalacc f
 	in
 	let ((acc'',conclty',sigma), args) = mk_arggoals sigma goal acc' hdty l in
-        let ans = if applicand == f && args == l then trm else Term.mkApp (applicand, args) in
+        let ans = if applicand == f && args == l then trm else mkApp (applicand, args) in
 	(acc'',conclty',sigma, ans)
 
     | Case (ci,p,c,lf) ->
@@ -447,7 +447,7 @@ and mk_hdgoals sigma goal goalacc trm =
 	let lf' = Array.rev_of_list rbranches in
 	let ans =
           if p' == p && c' == c && Array.equal (==) lf' lf then trm
-          else Term.mkCase (ci,p',c',lf')
+          else mkCase (ci,p',c',lf')
 	in
 	(acc'',conclty',sigma, ans)
 
@@ -468,16 +468,18 @@ and mk_arggoals sigma goal goalacc funty allargs =
   let foldmap (goalacc, funty, sigma) harg =
     let t = whd_all (Goal.V82.env sigma goal) sigma (EConstr.of_constr funty) in
     let t = EConstr.Unsafe.to_constr t in
-    let rec collapse t = match kind_of_term t with
+    let rec collapse t = match kind t with
     | LetIn (_, c1, _, b) -> collapse (subst1 c1 b)
     | _ -> t
     in
     let t = collapse t in
-    match kind_of_term t with
+    match kind t with
     | Prod (_, c1, b) ->
       let (acc, hargty, sigma, arg) = mk_refgoals sigma goal goalacc c1 harg in
       (acc, subst1 harg b, sigma), arg
-    | _ -> raise (RefinerError (CannotApply (t, harg)))
+    | _ ->
+      let env = Goal.V82.env sigma goal in
+      raise (RefinerError (env,sigma,CannotApply (t, harg)))
   in
   Array.smartfoldmap foldmap (goalacc, funty, sigma) allargs
 
@@ -497,36 +499,35 @@ and mk_casegoals sigma goal goalacc p c =
 let convert_hyp check sign sigma d =
   let id = NamedDecl.get_id d in
   let b = NamedDecl.get_value d in
-  let env = Global.env() in
+  let env = Global.env () in
   let reorder = ref [] in
   let sign' =
-    apply_to_hyp check sign id
+    apply_to_hyp env sigma check sign id
       (fun _ d' _ ->
         let c = Option.map EConstr.of_constr (NamedDecl.get_value d') in
         let env = Global.env_of_context sign in
         if check && not (is_conv env sigma (NamedDecl.get_type d) (EConstr.of_constr (NamedDecl.get_type d'))) then
 	  user_err ~hdr:"Logic.convert_hyp"
-            (str "Incorrect change of the type of " ++ pr_id id ++ str ".");
+            (str "Incorrect change of the type of " ++ Id.print id ++ str ".");
         if check && not (Option.equal (is_conv env sigma) b c) then
 	  user_err ~hdr:"Logic.convert_hyp"
-            (str "Incorrect change of the body of "++ pr_id id ++ str ".");
+            (str "Incorrect change of the body of "++ Id.print id ++ str ".");
        if check then reorder := check_decl_position env sigma sign d;
        map_named_decl EConstr.Unsafe.to_constr d) in
   reorder_val_context env sigma sign' !reorder
 
-
-
 (************************************************************************)
 (************************************************************************)
 (* Primitive tactics are handled here *)
 
 let prim_refiner r sigma goal =
+  let env = Goal.V82.env sigma goal in
   let cl = Goal.V82.concl sigma goal in
   match r with
     (* Logical rules *)
     | Refine c ->
         let cl = EConstr.Unsafe.to_constr cl in
-	check_meta_variables c;
+        check_meta_variables env sigma c;
 	let (sgl,cl',sigma,oterm) = mk_refgoals sigma goal [] cl c in
 	let sgl = List.rev sgl in
 	let sigma = Goal.V82.partial_solution sigma goal (EConstr.of_constr oterm) in
diff --git a/proofs/logic.mli b/proofs/logic.mli
index 9d0756b33..afd1ecf70 100644
--- a/proofs/logic.mli
+++ b/proofs/logic.mli
@@ -9,7 +9,7 @@
 (** Legacy proof engine. Do not use in newly written code. *)
 
 open Names
-open Term
+open Constr
 open Evd
 open Proof_type
 
@@ -50,16 +50,16 @@ type refiner_error =
   | DoesNotOccurIn of constr * Id.t
   | NoSuchHyp of Id.t
 
-exception RefinerError of refiner_error
+exception RefinerError of Environ.env * evar_map * refiner_error
 
-val error_no_such_hypothesis : Id.t -> 'a
+val error_no_such_hypothesis : Environ.env -> evar_map -> Id.t -> 'a
 
 val catchable_exception : exn -> bool
 
 val convert_hyp : bool -> Environ.named_context_val -> evar_map ->
   EConstr.named_declaration -> Environ.named_context_val
 
-val move_hyp_in_named_context : Evd.evar_map -> Id.t -> Id.t Misctypes.move_location ->
+val move_hyp_in_named_context : Environ.env -> Evd.evar_map -> Id.t -> Id.t Misctypes.move_location ->
   Environ.named_context_val -> Environ.named_context_val
 
 val insert_decl_in_named_context : Evd.evar_map ->
diff --git a/proofs/miscprint.ml b/proofs/miscprint.ml
index 5d37c8a02..92b58b409 100644
--- a/proofs/miscprint.ml
+++ b/proofs/miscprint.ml
@@ -6,8 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Misctypes
 open Pp
+open Names
+open Misctypes
 
 (** Printing of [intro_pattern] *)
 
@@ -18,8 +19,8 @@ let rec pr_intro_pattern prc (_,pat) = match pat with
   | IntroAction p -> pr_intro_pattern_action prc p
 
 and pr_intro_pattern_naming = function
-  | IntroIdentifier id -> Nameops.pr_id id
-  | IntroFresh id -> str "?" ++ Nameops.pr_id id
+  | IntroIdentifier id -> Id.print id
+  | IntroFresh id -> str "?" ++ Id.print id
   | IntroAnonymous -> str "?"
 
 and pr_intro_pattern_action prc = function
diff --git a/proofs/pfedit.ml b/proofs/pfedit.ml
index 193788558..6b503a011 100644
--- a/proofs/pfedit.ml
+++ b/proofs/pfedit.ml
@@ -51,9 +51,8 @@ end
 
 let get_nth_V82_goal i =
   let p = Proof_global.give_me_the_proof () in
-  let { it=goals ; sigma = sigma; } = Proof.V82.subgoals p in
-  try
-          { it=(List.nth goals (i-1)) ; sigma=sigma; }
+  let goals,_,_,_,sigma = Proof.proof p in
+  try { it = List.nth goals (i-1) ; sigma }
   with Failure _ -> raise NoSuchGoal
 
 let get_goal_context_gen i =
@@ -141,7 +140,8 @@ let build_constant_by_tactic id ctx sign ?(goal_kind = Global, false, Proof Theo
     let status = by tac in
     let _,(const,univs,_) = cook_proof () in
     Proof_global.discard_current ();
-    const, status, fst univs
+    let univs = UState.demote_seff_univs const univs in
+    const, status, univs
   with reraise ->
     let reraise = CErrors.push reraise in
     Proof_global.discard_current ();
@@ -156,7 +156,7 @@ let build_by_tactic ?(side_eff=true) env sigma ?(poly=false) typ tac =
   let ce =
     if side_eff then Safe_typing.inline_private_constants_in_definition_entry env ce
     else { ce with
-      const_entry_body = Future.chain ~pure:true ce.const_entry_body
+      const_entry_body = Future.chain ce.const_entry_body
         (fun (pt, _) -> pt, ()) } in
   let (cb, ctx), () = Future.force ce.const_entry_body in
   let univs' = Evd.merge_context_set Evd.univ_rigid (Evd.from_ctx univs) ctx in
@@ -230,33 +230,3 @@ let apply_implicit_tactic tac = (); fun env sigma evk ->
 let solve_by_implicit_tactic () = match !implicit_tactic with
 | None -> None
 | Some tac -> Some (apply_implicit_tactic tac)
-
-(** Deprecated functions  *)
-let refining = Proof_global.there_are_pending_proofs
-let check_no_pending_proofs = Proof_global.check_no_pending_proof
-
-let get_current_proof_name = Proof_global.get_current_proof_name
-let get_all_proof_names = Proof_global.get_all_proof_names
-
-type lemma_possible_guards = Proof_global.lemma_possible_guards
-type universe_binders = Proof_global.universe_binders
-
-let delete_proof = Proof_global.discard
-let delete_current_proof = Proof_global.discard_current
-let delete_all_proofs = Proof_global.discard_all
-
-let get_pftreestate () =
-  Proof_global.give_me_the_proof ()
-
-let set_end_tac tac =
-  Proof_global.set_endline_tactic tac
-
-let set_used_variables l =
-  Proof_global.set_used_variables l
-
-let get_used_variables () =
-  Proof_global.get_used_variables ()
-
-let get_universe_binders () =
-  Proof_global.get_universe_binders ()
-
diff --git a/proofs/pfedit.mli b/proofs/pfedit.mli
index 745ee8f36..5a317a956 100644
--- a/proofs/pfedit.mli
+++ b/proofs/pfedit.mli
@@ -8,9 +8,8 @@
 
 (** Global proof state. A quite redundant wrapper on {!Proof_global}. *)
 
-open Loc
 open Names
-open Term
+open Constr
 open Environ
 open Decl_kinds
 
@@ -23,7 +22,7 @@ open Decl_kinds
     proof of mutually dependent theorems) *)
 
 val start_proof :
-  Id.t -> ?pl:Proof_global.universe_binders -> goal_kind -> Evd.evar_map -> named_context_val -> EConstr.constr ->
+  Id.t -> ?pl:Univdecls.universe_decl -> goal_kind -> Evd.evar_map -> named_context_val -> EConstr.constr ->
   ?init_tac:unit Proofview.tactic ->
   Proof_global.proof_terminator -> unit
 
@@ -36,11 +35,11 @@ val start_proof :
 val cook_this_proof :
     Proof_global.proof_object ->
   (Id.t *
-    (Safe_typing.private_constants Entries.definition_entry * Proof_global.proof_universes * goal_kind))
+    (Safe_typing.private_constants Entries.definition_entry * UState.t * goal_kind))
 
 val cook_proof : unit ->
   (Id.t *
-    (Safe_typing.private_constants Entries.definition_entry * Proof_global.proof_universes * goal_kind))
+    (Safe_typing.private_constants Entries.definition_entry * UState.t * goal_kind))
 
 (** {6 ... } *)
 (** [get_goal_context n] returns the context of the [n]th subgoal of
@@ -67,6 +66,7 @@ val current_proof_statement :
   unit -> Id.t * goal_kind * EConstr.types
 
 (** {6 ... } *)
+
 (** [solve (SelectNth n) tac] applies tactic [tac] to the [n]th
     subgoal of the current focused proof or raises a [UserError] if no
     proof is focused or if there is no [n]th subgoal. [solve SelectAll
@@ -74,7 +74,7 @@ val current_proof_statement :
 
 val solve : ?with_end_tac:unit Proofview.tactic ->
       Vernacexpr.goal_selector -> int option -> unit Proofview.tactic ->
-      Proof.proof -> Proof.proof*bool
+      Proof.t -> Proof.t * bool
 
 (** [by tac] applies tactic [tac] to the 1st subgoal of the current
     focused proof or raises a UserError if there is no focused proof or
@@ -95,14 +95,14 @@ val instantiate_nth_evar_com : int -> Constrexpr.constr_expr -> unit
     tactic. *)
 
 val build_constant_by_tactic :
-  Id.t -> Evd.evar_universe_context -> named_context_val -> ?goal_kind:goal_kind ->
+  Id.t -> UState.t -> named_context_val -> ?goal_kind:goal_kind ->
   EConstr.types -> unit Proofview.tactic -> 
   Safe_typing.private_constants Entries.definition_entry * bool *
-    Evd.evar_universe_context
+    UState.t
 
-val build_by_tactic : ?side_eff:bool -> env -> Evd.evar_universe_context -> ?poly:polymorphic ->
+val build_by_tactic : ?side_eff:bool -> env -> UState.t -> ?poly:polymorphic ->
   EConstr.types -> unit Proofview.tactic -> 
-  constr * bool * Evd.evar_universe_context
+  constr * bool * UState.t
 
 val refine_by_tactic : env -> Evd.evar_map -> EConstr.types -> unit Proofview.tactic ->
   constr * Evd.evar_map
@@ -121,88 +121,3 @@ val clear_implicit_tactic : unit -> unit
 
 (* Raise Exit if cannot solve *)
 val solve_by_implicit_tactic : unit -> Pretyping.inference_hook option
-
-(** {5 Deprecated functions in favor of [Proof_global]} *)
-
-(** {6 ... } *)
-(** Several proofs can be opened simultaneously but at most one is
-   focused at some time. The following functions work by side-effect
-   on current set of open proofs. In this module, ``proofs'' means an
-   open proof (something started by vernacular command [Goal], [Lemma]
-   or [Theorem]), and ``goal'' means a subgoal of the current focused
-   proof *)
-
-(** [refining ()] tells if there is some proof in progress, even if a not
-   focused one *)
-
-val refining : unit -> bool
-[@@ocaml.deprecated "use Proof_global.there_are_pending_proofs"]
-
-(** [check_no_pending_proofs ()] fails if there is still some proof in
-   progress *)
-
-val check_no_pending_proofs : unit -> unit
-[@@ocaml.deprecated "use Proof_global.check_no_pending_proofs"]
-
-(** {6 ... } *)
-(** [delete_proof name] deletes proof of name [name] or fails if no proof
-    has this name *)
-
-val delete_proof : Id.t located -> unit
-[@@ocaml.deprecated "use Proof_global.discard"]
-
-(** [delete_current_proof ()] deletes current focused proof or fails if
-    no proof is focused *)
-
-val delete_current_proof : unit -> unit
-[@@ocaml.deprecated "use Proof_global.discard_current"]
-
-(** [delete_all_proofs ()] deletes all open proofs if any *)
-val delete_all_proofs : unit -> unit
-[@@ocaml.deprecated "use Proof_global.discard_all"]
-
-(** [get_pftreestate ()] returns the current focused pending proof.
-   @raise NoCurrentProof if there is no pending proof. *)
-
-val get_pftreestate : unit -> Proof.proof
-[@@ocaml.deprecated "use Proof_global.give_me_the_proof"]
-
-(** {6 ... } *)
-(** [set_end_tac tac] applies tactic [tac] to all subgoal generate
-    by [solve] *)
-
-val set_end_tac : Genarg.glob_generic_argument -> unit
-[@@ocaml.deprecated "use Proof_global.set_endline_tactic"]
-
-(** {6 ... } *)
-(** [set_used_variables l] declares that section variables [l] will be
-    used in the proof *)
-val set_used_variables :
-  Id.t list -> Context.Named.t * Names.Id.t Loc.located list
-[@@ocaml.deprecated "use Proof_global.set_used_variables"]
-
-val get_used_variables : unit -> Context.Named.t option
-[@@ocaml.deprecated "use Proof_global.get_used_variables"]
-
-(** {6 Universe binders } *)
-val get_universe_binders : unit -> Proof_global.universe_binders option
-[@@ocaml.deprecated "use Proof_global.get_universe_binders"]
-
-(** {6 ... } *)
-(** [get_current_proof_name ()] return the name of the current focused
-    proof or failed if no proof is focused *)
-val get_current_proof_name : unit -> Id.t
-[@@ocaml.deprecated "use Proof_global.get_current_proof_name"]
-
-(** [get_all_proof_names ()] returns the list of all pending proof names.
-    The first name is the current proof, the other names may come in
-    any order. *)
-val get_all_proof_names : unit -> Id.t list
-[@@ocaml.deprecated "use Proof_global.get_all_proof_names"]
-
-type lemma_possible_guards = Proof_global.lemma_possible_guards
-[@@ocaml.deprecated "use Proof_global.lemma_possible_guards"]
-
-type universe_binders = Proof_global.universe_binders
-[@@ocaml.deprecated "use Proof_global.universe_binders"]
-
diff --git a/proofs/proof.ml b/proofs/proof.ml
index ba4980b66..04e707cd6 100644
--- a/proofs/proof.ml
+++ b/proofs/proof.ml
@@ -98,7 +98,7 @@ let done_cond ?(loose_end=false) k = CondDone (loose_end,k)
 
 (* Subpart of the type of proofs. It contains the parts of the proof which
    are under control of the undo mechanism *)
-type proof = {
+type t = {
   (* Current focused proofview *)
   proofview: Proofview.proofview;
   (* Entry for the proofview *)
@@ -112,9 +112,11 @@ type proof = {
   (* List of goals that have been given up *)
   given_up : Goal.goal list;
   (* The initial universe context (for the statement) *)
-  initial_euctx : Evd.evar_universe_context
+  initial_euctx : UState.t
 }
 
+type proof = t
+
 (*** General proof functions ***)
 
 let proof p =
@@ -163,6 +165,7 @@ let map_structured_proof pfts process_goal: 'a pre_goals =
 let rec unroll_focus pv = function
   | (_,_,ctx)::stk -> unroll_focus (Proofview.unfocus ctx pv) stk
   | [] -> pv
+
 (* spiwack: a proof is considered completed even if its still focused, if the focus
    doesn't hide any goal.
    Unfocusing is handled in {!return}. *)
@@ -391,10 +394,12 @@ let pr_proof p =
 (*** Compatibility layer with <=v8.2 ***)
 module V82 = struct
   let subgoals p =
-    Proofview.V82.goals p.proofview
+    let it, sigma = Proofview.proofview p.proofview in
+    Evd.{ it; sigma }
 
   let background_subgoals p =
-    Proofview.V82.goals (unroll_focus p.proofview p.focus_stack)
+    let it, sigma = Proofview.proofview (unroll_focus p.proofview p.focus_stack) in
+    Evd.{ it; sigma }
 
   let top_goal p =
     let { Evd.it=gls ; sigma=sigma; } =
diff --git a/proofs/proof.mli b/proofs/proof.mli
index 698aa48b0..0b5e771ef 100644
--- a/proofs/proof.mli
+++ b/proofs/proof.mli
@@ -30,7 +30,9 @@
 *)
 
 (* Type of a proof. *)
-type proof
+type t
+type proof = t
+[@@ocaml.deprecated "please use [Proof.t]"]
 
 (* Returns a stylised view of a proof for use by, for instance,
    ide-s. *)
@@ -42,7 +44,7 @@ type proof
    shelf (the list of goals on the shelf), a representation of the
    given up goals (the list of the given up goals) and the underlying
    evar_map *)
-val proof : proof ->
+val proof : t ->
   Goal.goal list
   * (Goal.goal list * Goal.goal list) list
   * Goal.goal list
@@ -61,27 +63,26 @@ type 'a pre_goals = {
   (** List of the goals that have been given up *)
 }
 
-val map_structured_proof : proof -> (Evd.evar_map -> Goal.goal -> 'a) -> ('a pre_goals)
+val map_structured_proof : t -> (Evd.evar_map -> Goal.goal -> 'a) -> ('a pre_goals)
 
 
 (*** General proof functions ***)
-
-val start : Evd.evar_map -> (Environ.env * EConstr.types) list -> proof
-val dependent_start : Proofview.telescope -> proof
-val initial_goals : proof -> (EConstr.constr * EConstr.types) list
-val initial_euctx : proof -> Evd.evar_universe_context
+val start : Evd.evar_map -> (Environ.env * EConstr.types) list -> t
+val dependent_start : Proofview.telescope -> t
+val initial_goals : t -> (EConstr.constr * EConstr.types) list
+val initial_euctx : t -> UState.t
 
 (* Returns [true] if the considered proof is completed, that is if no goal remain
     to be considered (this does not require that all evars have been solved). *)
-val is_done : proof -> bool
+val is_done : t -> bool
 
 (* Like is_done, but this time it really means done (i.e. nothing left to do) *)
-val is_complete : proof -> bool
+val is_complete : t -> bool
 
 (* Returns the list of partial proofs to initial goals. *)
-val partial_proof : proof -> EConstr.constr list
+val partial_proof : t -> EConstr.constr list
 
-val compact : proof -> proof
+val compact : t -> t
 
 (* Returns the proofs (with their type) of the initial goals.
     Raises [UnfinishedProof] is some goals remain to be considered.
@@ -92,7 +93,7 @@ exception UnfinishedProof
 exception HasShelvedGoals
 exception HasGivenUpGoals
 exception HasUnresolvedEvar
-val return : proof -> Evd.evar_map
+val return : t -> Evd.evar_map
 
 (*** Focusing actions ***)
 
@@ -132,7 +133,7 @@ val done_cond : ?loose_end:bool -> 'a focus_kind -> 'a focus_condition
 (* focus command (focuses on the [i]th subgoal) *)
 (* spiwack: there could also, easily be a focus-on-a-range tactic, is there 
    a need for it? *)
-val focus : 'a focus_condition -> 'a -> int -> proof -> proof
+val focus : 'a focus_condition -> 'a -> int -> t -> t
 
 exception FullyUnfocused
 exception CannotUnfocusThisWay
@@ -148,58 +149,59 @@ exception NoSuchGoals of int * int
    Raises [FullyUnfocused] if the proof is not focused.
    Raises [CannotUnfocusThisWay] if the proof the unfocusing condition
      is not met. *)
-val unfocus : 'a focus_kind -> proof -> unit -> proof
+val unfocus : 'a focus_kind -> t -> unit -> t
 
 (* [unfocused p] returns [true] when [p] is fully unfocused. *)
-val unfocused : proof -> bool
+val unfocused : t -> bool
 
 (* [get_at_focus k] gets the information stored at the closest focus point
     of kind [k].
     Raises [NoSuchFocus] if there is no focus point of kind [k]. *)
 exception NoSuchFocus
-val get_at_focus : 'a focus_kind -> proof -> 'a
+val get_at_focus : 'a focus_kind -> t -> 'a
 
 (* [is_last_focus k] check if the most recent focus is of kind [k] *)
-val is_last_focus : 'a focus_kind -> proof -> bool
+val is_last_focus : 'a focus_kind -> t -> bool
 
 (* returns [true] if there is no goal under focus. *)
-val no_focused_goal : proof -> bool
+val no_focused_goal : t -> bool
 
 (*** Tactics ***)
 
 (* the returned boolean signal whether an unsafe tactic has been
    used. In which case it is [false]. *)
 val run_tactic : Environ.env ->
-  unit Proofview.tactic -> proof -> proof*(bool*Proofview_monad.Info.tree)
+  unit Proofview.tactic -> t -> t * (bool*Proofview_monad.Info.tree)
 
-val maximal_unfocus : 'a focus_kind -> proof -> proof
+val maximal_unfocus : 'a focus_kind -> t -> t
 
 (*** Commands ***)
 
-val in_proof : proof -> (Evd.evar_map -> 'a) -> 'a
+val in_proof : t -> (Evd.evar_map -> 'a) -> 'a
 
 (* Remove all the goals from the shelf and adds them at the end of the
    focused goals. *)
-val unshelve : proof -> proof
+val unshelve : t -> t
 
-val pr_proof : proof -> Pp.t
+val pr_proof : t -> Pp.t
 
 (*** Compatibility layer with <=v8.2 ***)
 module V82 : sig
-  val subgoals : proof -> Goal.goal list Evd.sigma
+  val subgoals : t -> Goal.goal list Evd.sigma
+  [@@ocaml.deprecated "Use the first and fifth argument of [Proof.proof]"]
 
   (* All the subgoals of the proof, including those which are not focused. *)
-  val background_subgoals : proof -> Goal.goal list Evd.sigma
+  val background_subgoals : t -> Goal.goal list Evd.sigma
 
-  val top_goal : proof -> Goal.goal Evd.sigma
+  val top_goal : t -> Goal.goal Evd.sigma
 
   (* returns the existential variable used to start the proof *)
-  val top_evars : proof -> Evd.evar list
+  val top_evars : t -> Evar.t list
 
   (* Turns the unresolved evars into goals.
      Raises [UnfinishedProof] if there are still unsolved goals. *)
-  val grab_evars : proof -> proof
+  val grab_evars : t -> t
 
   (* Implements the Existential command *)
-  val instantiate_evar : int -> Constrexpr.constr_expr -> proof -> proof
+  val instantiate_evar : int -> Constrexpr.constr_expr -> t -> t
 end
diff --git a/proofs/proof_bullet.ml b/proofs/proof_bullet.ml
index f80cb7cc6..214916331 100644
--- a/proofs/proof_bullet.ml
+++ b/proofs/proof_bullet.ml
@@ -25,8 +25,8 @@ let pr_bullet b =
 
 type behavior = {
   name : string;
-  put : proof -> t -> proof;
-  suggest: proof -> Pp.t
+  put : Proof.t -> t -> Proof.t;
+  suggest: Proof.t -> Pp.t
 }
 
 let behaviors = Hashtbl.create 4
@@ -110,11 +110,7 @@ module Strict = struct
   let push (b:t) pr =
     focus bullet_cond (b::get_bullets pr) 1 pr
 
-  (* Used only in the next function.
-     TODO: use a recursive function instead? *)
-  exception SuggestFound of t
-
-  let suggest_bullet (prf : proof): suggestion =
+  let suggest_bullet (prf : Proof.t): suggestion =
     if is_done prf then ProofFinished
     else if not (no_focused_goal prf)
     then (* No suggestion if a bullet is not mandatory, look for an unfinished bullet *)
@@ -122,26 +118,26 @@ module Strict = struct
       | b::_ -> Unfinished b
       | _ -> NoBulletInUse
     else (* There is no goal under focus but some are unfocussed,
-            let us look at the bullet needed. If no  *)
-      let pcobaye = ref prf in
-      try
-        while true do
-          let pcobaye', b = pop !pcobaye in
-         (* pop went well, this means that there are no more goals
-          *under this* bullet b, see if a new b can be pushed. *)
-          (try let _ = push b pcobaye' in (* push didn't fail so a new b can be pushed. *)
-      	 raise (SuggestFound b)
-           with SuggestFound _ as e -> raise e
-           | _ -> ()); (* b could not be pushed, so we must look for a outer bullet *)
-          pcobaye := pcobaye'
-        done;
-        assert false
-      with SuggestFound b -> Suggest b
-      | _ -> NeedClosingBrace (* No push was possible, but there are still
-      			   subgoals somewhere: there must be a "}" to use. *)
-
-
-  let rec pop_until (prf : proof) bul : proof =
+            let us look at the bullet needed. *)
+      let rec loop prf =
+        match pop prf with
+        | prf, b ->
+          (* pop went well, this means that there are no more goals
+           *under this* bullet b, see if a new b can be pushed. *)
+          begin
+            try ignore (push b prf); Suggest b
+            with _ ->
+              (* b could not be pushed, so we must look for a outer bullet *)
+              loop prf
+          end
+        | exception _ ->
+          (* No pop was possible, but there are still
+             subgoals somewhere: there must be a "}" to use. *)
+          NeedClosingBrace
+      in
+      loop prf
+
+  let rec pop_until (prf : Proof.t) bul : Proof.t =
     let prf', b = pop prf in
     if bullet_eq bul b then prf'
     else pop_until prf' bul
diff --git a/proofs/proof_bullet.mli b/proofs/proof_bullet.mli
index 9e924fec9..09fcabf50 100644
--- a/proofs/proof_bullet.mli
+++ b/proofs/proof_bullet.mli
@@ -12,8 +12,6 @@
 (*                                                        *)
 (**********************************************************)
 
-open Proof
-
 type t = Vernacexpr.bullet
 
 (** A [behavior] is the data of a put function which
@@ -22,8 +20,8 @@ type t = Vernacexpr.bullet
     with a name to identify the behavior. *)
 type behavior = {
   name : string;
-  put : proof -> t -> proof;
-  suggest: proof -> Pp.t
+  put : Proof.t -> t -> Proof.t;
+  suggest: Proof.t -> Pp.t
 }
 
 (** A registered behavior can then be accessed in Coq
@@ -39,8 +37,8 @@ val register_behavior : behavior -> unit
 
 (** Handles focusing/defocusing with bullets:
      *)
-val put : proof -> t -> proof
-val suggest : proof -> Pp.t
+val put : Proof.t -> t -> Proof.t
+val suggest : Proof.t -> Pp.t
 
 (**********************************************************)
 (*                                                        *)
diff --git a/proofs/proof_global.ml b/proofs/proof_global.ml
index 2ade797f6..0a50bcf8c 100644
--- a/proofs/proof_global.ml
+++ b/proofs/proof_global.ml
@@ -68,20 +68,18 @@ let _ =
 
 (* Extra info on proofs. *)
 type lemma_possible_guards = int list list
-type proof_universes = Evd.evar_universe_context * Universes.universe_binders option
-type universe_binders = Id.t Loc.located list
 
 type proof_object = {
   id : Names.Id.t;
   entries : Safe_typing.private_constants Entries.definition_entry list;
   persistence : Decl_kinds.goal_kind;
-  universes: proof_universes;
+  universes: UState.t;
 }
 
 type proof_ending =
-  | Admitted of Names.Id.t * Decl_kinds.goal_kind * Entries.parameter_entry * proof_universes
+  | Admitted of Names.Id.t * Decl_kinds.goal_kind * Entries.parameter_entry * UState.t
   | Proved of Vernacexpr.opacity_flag *
-              Vernacexpr.lident option *
+              Misctypes.lident option *
               proof_object
 type proof_terminator = proof_ending -> unit
 type closed_proof = proof_object * proof_terminator
@@ -91,12 +89,15 @@ type pstate = {
   terminator : proof_terminator CEphemeron.key;
   endline_tactic : Genarg.glob_generic_argument option;
   section_vars : Context.Named.t option;
-  proof : Proof.proof;
+  proof : Proof.t;
   strength : Decl_kinds.goal_kind;
   mode : proof_mode CEphemeron.key;
-  universe_binders: universe_binders option;
+  universe_decl: Univdecls.universe_decl;
 }
 
+type t = pstate list
+type state = t
+
 let make_terminator f = f
 let apply_terminator f = f
 
@@ -145,6 +146,7 @@ let cur_pstate () =
   | [] -> raise NoCurrentProof
 
 let give_me_the_proof () = (cur_pstate ()).proof
+let give_me_the_proof_opt () = try Some (give_me_the_proof ()) with | NoCurrentProof -> None
 let get_current_proof_name () = (cur_pstate ()).pid
 
 let with_current_proof f =
@@ -186,7 +188,7 @@ let msg_proofs () =
   match get_all_proof_names () with
     | [] -> (spc () ++ str"(No proof-editing in progress).")
     | l ->  (str"." ++ fnl () ++ str"Proofs currently edited:" ++ spc () ++
-               (pr_sequence Nameops.pr_id l) ++ str".")
+               (pr_sequence Id.print l) ++ str".")
 
 let there_is_a_proof () = not (List.is_empty !pstates)
 let there_are_pending_proofs () = there_is_a_proof ()
@@ -230,15 +232,22 @@ let activate_proof_mode mode =
 let disactivate_current_proof_mode () =
   CEphemeron.iter_opt !current_proof_mode (fun x -> x.reset ())
 
-(** [start_proof sigma id str goals terminator] starts a proof of name
+let default_universe_decl =
+  let open Misctypes in
+  { univdecl_instance = [];
+    univdecl_extensible_instance = true;
+    univdecl_constraints = Univ.Constraint.empty;
+    univdecl_extensible_constraints = true }
+
+(** [start_proof sigma id pl str goals terminator] starts a proof of name
     [id] with goals [goals] (a list of pairs of environment and
     conclusion); [str] describes what kind of theorem/definition this
     is (spiwack: for potential printing, I believe is used only by
     closing commands and the xml plugin); [terminator] is used at the
     end of the proof to close the proof. The proof is started in the
     evar map [sigma] (which can typically contain universe
-    constraints). *)
-let start_proof sigma id ?pl str goals terminator =
+    constraints), and with universe bindings pl. *)
+let start_proof sigma id ?(pl=default_universe_decl) str goals terminator =
   let initial_state = {
     pid = id;
     terminator = CEphemeron.create terminator;
@@ -247,10 +256,10 @@ let start_proof sigma id ?pl str goals terminator =
     section_vars = None;
     strength = str;
     mode = find_proof_mode "No";
-    universe_binders = pl } in
+    universe_decl = pl } in
   push initial_state pstates
 
-let start_dependent_proof id ?pl str goals terminator =
+let start_dependent_proof id ?(pl=default_universe_decl) str goals terminator =
   let initial_state = {
     pid = id;
     terminator = CEphemeron.create terminator;
@@ -259,11 +268,11 @@ let start_dependent_proof id ?pl str goals terminator =
     section_vars = None;
     strength = str;
     mode = find_proof_mode "No";
-    universe_binders = pl } in
+    universe_decl = pl } in
   push initial_state pstates
 
 let get_used_variables () = (cur_pstate ()).section_vars
-let get_universe_binders () = (cur_pstate ()).universe_binders
+let get_universe_decl () = (cur_pstate ()).universe_decl
 
 let proof_using_auto_clear = ref false
 let _ = Goptions.declare_bool_option
@@ -310,20 +319,18 @@ let get_open_goals () =
     (List.map (fun (l1,l2) -> List.length l1 + List.length l2) gll) +
     List.length shelf
 
-let constrain_variables init uctx =
-  let levels = Univ.Instance.levels (Univ.UContext.instance init) in
-  let cstrs = UState.constrain_variables levels uctx in
-  Univ.ContextSet.add_constraints cstrs (UState.context_set uctx)
-
-type closed_proof_output = (Term.constr * Safe_typing.private_constants) list * Evd.evar_universe_context
+type closed_proof_output = (Constr.t * Safe_typing.private_constants) list * UState.t
 
 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 } =
+  let { pid; section_vars; strength; proof; terminator; universe_decl } =
     cur_pstate () in
   let poly = pi2 strength (* Polymorphic *) in
   let initial_goals = Proof.initial_goals proof in
   let initial_euctx = Proof.initial_euctx proof in
+  let constrain_variables ctx =
+    UState.constrain_variables (fst (UState.context_set initial_euctx)) ctx
+  in
   let fpl, univs = Future.split2 fpl in
   let universes = if poly || now then Future.force univs else initial_euctx in
   (* Because of dependent subgoals at the beginning of proofs, we could
@@ -337,67 +344,66 @@ let close_proof ~keep_body_ucst_separate ?feedback_id ~now
     if poly || now then
       let make_body t (c, eff) =
         let body = c in
-	let typ =
-	  if not (keep_body_ucst_separate || not (Safe_typing.empty_private_constants = eff)) then
-	    nf t
-	  else t
-	in
-        let used_univs_body = Univops.universes_of_constr body in
-        let used_univs_typ = Univops.universes_of_constr typ in
-        if keep_body_ucst_separate ||
-           not (Safe_typing.empty_private_constants = eff) then
-          let initunivs = Evd.evar_context_universe_context initial_euctx in
-          let ctx = constrain_variables initunivs universes in
+        let allow_deferred =
+          not poly && (keep_body_ucst_separate ||
+          not (Safe_typing.empty_private_constants = eff))
+        in
+        let typ = if allow_deferred then t else nf t in
+        let env = Global.env () in
+        let used_univs_body = Univops.universes_of_constr env body in
+        let used_univs_typ = Univops.universes_of_constr env typ in
+        if allow_deferred then
+          let initunivs = UState.const_univ_entry ~poly initial_euctx in
+          let ctx = constrain_variables universes in
           (* For vi2vo compilation proofs are computed now but we need to
-           * complement the univ constraints of the typ with the ones of
-           * the body.  So we keep the two sets distinct. *)
-	  let used_univs = Univ.LSet.union used_univs_body used_univs_typ in
-          let ctx_body = Univops.restrict_universe_context ctx used_univs in
-          (initunivs, typ), ((body, ctx_body), eff)
+             complement the univ constraints of the typ with the ones of
+             the body.  So we keep the two sets distinct. *)
+          let used_univs = Univ.LSet.union used_univs_body used_univs_typ in
+          let ctx_body = UState.restrict ctx used_univs in
+          let univs = UState.check_mono_univ_decl ctx_body universe_decl in
+          (initunivs, typ), ((body, univs), eff)
         else
-          let initunivs = Univ.UContext.empty in
-          let ctx = constrain_variables initunivs universes in
           (* Since the proof is computed now, we can simply have 1 set of
-           * constraints in which we merge the ones for the body and the ones
-           * for the typ *)
+             constraints in which we merge the ones for the body and the ones
+             for the typ. We recheck the declaration after restricting with
+             the actually used universes.
+             TODO: check if restrict is really necessary now. *)
           let used_univs = Univ.LSet.union used_univs_body used_univs_typ in
-          let ctx = Univops.restrict_universe_context ctx used_univs in
-          let univs = Univ.ContextSet.to_context ctx in
+          let ctx = UState.restrict universes used_univs in
+          let univs = UState.check_univ_decl ~poly ctx universe_decl in
           (univs, typ), ((body, Univ.ContextSet.empty), eff)
       in 
-       fun t p -> Future.split2 (Future.chain ~pure:true p (make_body t))
+       fun t p -> Future.split2 (Future.chain p (make_body t))
     else
       fun t p ->
-        let initunivs = Evd.evar_context_universe_context initial_euctx in
-        Future.from_val (initunivs, nf t),
-        Future.chain ~pure:true p (fun (pt,eff) ->
-          (pt,constrain_variables initunivs (Future.force univs)),eff)
+        (* Already checked the univ_decl for the type universes when starting the proof. *)
+        let univctx = Entries.Monomorphic_const_entry (UState.context_set universes) in
+        Future.from_val (univctx, nf t),
+        Future.chain p (fun (pt,eff) ->
+          (* Deferred proof, we already checked the universe declaration with
+             the initial universes, ensure that the final universes respect
+             the declaration as well. If the declaration is non-extensible,
+             this will prevent the body from adding universes and constraints. *)
+          let bodyunivs = constrain_variables (Future.force univs) in
+          let univs = UState.check_mono_univ_decl bodyunivs universe_decl in
+          (pt,univs),eff)
   in
-  let entries =
-    Future.map2 (fun p (_, t) ->
-      let t = EConstr.Unsafe.to_constr t in
-      let univstyp, body = make_body t p in
-      let univs, typ = Future.force univstyp in
-      let univs =
-        if poly then Entries.Polymorphic_const_entry univs
-        else Entries.Monomorphic_const_entry univs
-      in
-	{ Entries.
-	  const_entry_body = body;
-	  const_entry_secctx = section_vars;
-	  const_entry_feedback = feedback_id;
-	  const_entry_type  = Some typ;
-	  const_entry_inline_code = false;
-	  const_entry_opaque = true;
-	  const_entry_universes = univs;
-        })
-		fpl initial_goals in
-  let binders =
-    Option.map (fun names -> fst (Evd.universe_context ~names (Evd.from_ctx universes)))
-	       universe_binders
+  let entry_fn p (_, t) =
+    let t = EConstr.Unsafe.to_constr t in
+    let univstyp, body = make_body t p in
+    let univs, typ = Future.force univstyp in
+    {Entries.
+      const_entry_body = body;
+      const_entry_secctx = section_vars;
+      const_entry_feedback = feedback_id;
+      const_entry_type  = Some typ;
+      const_entry_inline_code = false;
+      const_entry_opaque = true;
+      const_entry_universes = univs; }
   in
+  let entries = Future.map2 entry_fn fpl initial_goals in
   { id = pid; entries = entries; persistence = strength;
-    universes = (universes, binders) },
+    universes },
   fun pr_ending -> CEphemeron.get terminator pr_ending
 
 let return_proof ?(allow_partial=false) () =
@@ -458,8 +464,6 @@ module V82 = struct
     pid, (goals, strength)
 end
 
-type state = pstate list
-        
 let freeze ~marshallable =
   match marshallable with
   | `Yes ->
@@ -482,7 +486,10 @@ let update_global_env () =
 (* XXX: Bullet hook, should be really moved elsewhere *)
 let _ =
   let hook n =
-    let prf = give_me_the_proof () in
-    (Proof_bullet.suggest prf) in
+    try
+      let prf = give_me_the_proof () in
+      (Proof_bullet.suggest prf)
+    with NoCurrentProof -> mt ()
+  in
   Proofview.set_nosuchgoals_hook hook
 
diff --git a/proofs/proof_global.mli b/proofs/proof_global.mli
index 52f5f7404..06647bf3e 100644
--- a/proofs/proof_global.mli
+++ b/proofs/proof_global.mli
@@ -10,6 +10,10 @@
      toplevel. In particular it defines the global proof
      environment. *)
 
+type t
+type state = t
+[@@ocaml.deprecated "please use [Proof_global.t]"]
+
 val there_are_pending_proofs : unit -> bool
 val check_no_pending_proof : unit -> unit
 
@@ -20,8 +24,9 @@ val discard : Names.Id.t Loc.located -> unit
 val discard_current : unit -> unit
 val discard_all : unit -> unit
 
+val give_me_the_proof_opt : unit -> Proof.t option
 exception NoCurrentProof
-val give_me_the_proof : unit -> Proof.proof
+val give_me_the_proof : unit -> Proof.t
 (** @raise NoCurrentProof when outside proof mode. *)
 
 val compact_the_proof : unit -> unit
@@ -33,20 +38,19 @@ val compact_the_proof : unit -> unit
     (i.e. an proof ending command) and registers the appropriate
     values. *)
 type lemma_possible_guards = int list list
-type proof_universes = Evd.evar_universe_context * Universes.universe_binders option
-type universe_binders = Names.Id.t Loc.located list
+
 type proof_object = {
   id : Names.Id.t;
   entries : Safe_typing.private_constants Entries.definition_entry list;
   persistence : Decl_kinds.goal_kind;
-  universes: proof_universes;
+  universes: UState.t;
 }
 
 type proof_ending =
   | Admitted of Names.Id.t * Decl_kinds.goal_kind * Entries.parameter_entry *
-		  proof_universes
+                UState.t
   | Proved of Vernacexpr.opacity_flag *
-              Vernacexpr.lident option *
+              Misctypes.lident option *
               proof_object
 type proof_terminator
 type closed_proof = proof_object * proof_terminator
@@ -54,21 +58,23 @@ type closed_proof = proof_object * proof_terminator
 val make_terminator : (proof_ending -> unit) -> proof_terminator
 val apply_terminator : proof_terminator -> proof_ending -> unit
 
-(** [start_proof id str goals terminator] starts a proof of name [id]
+(** [start_proof id str pl goals terminator] starts a proof of name [id]
     with goals [goals] (a list of pairs of environment and
     conclusion); [str] describes what kind of theorem/definition this
     is (spiwack: for potential printing, I believe is used only by
     closing commands and the xml plugin); [terminator] is used at the
-    end of the proof to close the proof. *)
+    end of the proof to close the proof. The proof is started in the
+    evar map [sigma] (which can typically contain universe
+    constraints), and with universe bindings pl. *)
 val start_proof :
-  Evd.evar_map -> Names.Id.t -> ?pl:universe_binders ->
+  Evd.evar_map -> Names.Id.t -> ?pl:Univdecls.universe_decl ->
   Decl_kinds.goal_kind -> (Environ.env * EConstr.types) list  ->
     proof_terminator -> unit
 
 (** Like [start_proof] except that there may be dependencies between
     initial goals. *)
 val start_dependent_proof :
-  Names.Id.t -> ?pl:universe_binders -> Decl_kinds.goal_kind ->
+  Names.Id.t -> ?pl:Univdecls.universe_decl -> Decl_kinds.goal_kind ->
   Proofview.telescope -> proof_terminator -> unit
 
 (** Update the proofs global environment after a side-effecting command
@@ -84,7 +90,7 @@ val close_proof : keep_body_ucst_separate:bool -> Future.fix_exn -> closed_proof
  * Both access the current proof state. The former is supposed to be
  * chained with a computation that completed the proof *)
 
-type closed_proof_output = (Term.constr * Safe_typing.private_constants) list * Evd.evar_universe_context
+type closed_proof_output = (Constr.t * Safe_typing.private_constants) list * UState.t
 
 (* If allow_partial is set (default no) then an incomplete proof
  * is allowed (no error), and a warn is given if the proof is complete. *)
@@ -105,9 +111,9 @@ val get_open_goals : unit -> int
     no current proof.
     The return boolean is set to [false] if an unsafe tactic has been used. *)
 val with_current_proof :
-  (unit Proofview.tactic -> Proof.proof -> Proof.proof*'a) -> 'a
+  (unit Proofview.tactic -> Proof.t -> Proof.t * 'a) -> 'a
 val simple_with_current_proof :
-  (unit Proofview.tactic -> Proof.proof -> Proof.proof) -> unit
+  (unit Proofview.tactic -> Proof.t -> Proof.t) -> unit
 
 (** Sets the tactic to be used when a tactic line is closed with [...] *)
 val set_endline_tactic : Genarg.glob_generic_argument -> unit
@@ -119,18 +125,18 @@ val set_used_variables :
   Names.Id.t list -> Context.Named.t * Names.Id.t Loc.located list
 val get_used_variables : unit -> Context.Named.t option
 
-val get_universe_binders : unit -> universe_binders option
+(** Get the universe declaration associated to the current proof. *)
+val get_universe_decl : unit -> Univdecls.universe_decl
 
 module V82 : sig
   val get_current_initial_conclusions : unit -> Names.Id.t *(EConstr.types list *
   Decl_kinds.goal_kind)
 end
 
-type state
-val freeze : marshallable:[`Yes | `No | `Shallow] -> state
-val unfreeze : state -> unit
-val proof_of_state : state -> Proof.proof
-val copy_terminators : src:state -> tgt:state -> state
+val freeze : marshallable:[`Yes | `No | `Shallow] -> t
+val unfreeze : t -> unit
+val proof_of_state : t -> Proof.t
+val copy_terminators : src:t -> tgt:t -> t
 
 
 (**********************************************************)
diff --git a/proofs/proof_type.ml b/proofs/proof_type.ml
index 2ad5f607f..20293cb9b 100644
--- a/proofs/proof_type.ml
+++ b/proofs/proof_type.ml
@@ -9,7 +9,7 @@
 (** Legacy proof engine. Do not use in newly written code. *)
 
 open Evd
-open Term
+open Constr
 
 (** This module defines the structure of proof tree and the tactic type. So, it
    is used by [Proof_tree] and [Refiner] *)
diff --git a/proofs/proofs.mllib b/proofs/proofs.mllib
index eaf0c693e..058e839b4 100644
--- a/proofs/proofs.mllib
+++ b/proofs/proofs.mllib
@@ -1,7 +1,6 @@
 Miscprint
 Goal
 Evar_refiner
-Proof_using
 Proof_type
 Logic
 Refine
diff --git a/proofs/redexpr.ml b/proofs/redexpr.ml
index 6052ba367..9a5d4e154 100644
--- a/proofs/redexpr.ml
+++ b/proofs/redexpr.ml
@@ -25,8 +25,11 @@ open Misctypes
 
 (* call by value normalisation function using the virtual machine *)
 let cbv_vm env sigma c =
-  let ctyp = Retyping.get_type_of env sigma c in
-  Vnorm.cbv_vm env sigma c ctyp
+  if Coq_config.bytecode_compiler then
+    let ctyp = Retyping.get_type_of env sigma c in
+    Vnorm.cbv_vm env sigma c ctyp
+  else
+    compute env sigma c
 
 let warn_native_compute_disabled =
   CWarnings.create ~name:"native-compute-disabled" ~category:"native-compiler"
@@ -34,12 +37,12 @@ let warn_native_compute_disabled =
    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
-    (warn_native_compute_disabled ();
-     cbv_vm env sigma c)
-  else
+  if Coq_config.native_compiler then
     let ctyp = Retyping.get_type_of env sigma c in
     Nativenorm.native_norm env sigma c ctyp
+  else
+    (warn_native_compute_disabled ();
+     cbv_vm env sigma c)
 
 let whd_cbn flags env sigma t =
   let (state,_) =
diff --git a/proofs/redexpr.mli b/proofs/redexpr.mli
index ccc2440a2..43e598773 100644
--- a/proofs/redexpr.mli
+++ b/proofs/redexpr.mli
@@ -9,7 +9,7 @@
 (** Interpretation layer of redexprs such as hnf, cbv, etc. *)
 
 open Names
-open Term
+open Constr
 open EConstr
 open Pattern
 open Genredexpr
diff --git a/proofs/refine.ml b/proofs/refine.ml
index 4161d7104..90276951b 100644
--- a/proofs/refine.ml
+++ b/proofs/refine.ml
@@ -70,7 +70,6 @@ let add_side_effects env effects =
   List.fold_left (fun env eff -> add_side_effect env eff) env effects
 
 let generic_refine ~typecheck f gl =
-  let gl = Proofview.Goal.assume gl in
   let sigma = Proofview.Goal.sigma gl in
   let env = Proofview.Goal.env gl in
   let concl = Proofview.Goal.concl gl in
@@ -102,7 +101,12 @@ let generic_refine ~typecheck f gl =
   in
   (** Proceed to the refinement *)
   let c = EConstr.Unsafe.to_constr c in
-  let sigma = match evkmain with
+  let sigma = match Proofview.Unsafe.advance sigma self with
+  | None ->
+    (** Nothing to do, the goal has been solved by side-effect *)
+    sigma
+  | Some self ->
+    match evkmain with
     | None -> Evd.define self c sigma
     | Some evk ->
         let id = Evd.evar_ident self sigma in
@@ -154,7 +158,6 @@ let with_type env evd c t =
   evd , j'.Environ.uj_val
 
 let refine_casted ~typecheck f = Proofview.Goal.enter begin fun gl ->
-  let gl = Proofview.Goal.assume gl in
   let concl = Proofview.Goal.concl gl in
   let env = Proofview.Goal.env gl in
   let f h =
diff --git a/proofs/refine.mli b/proofs/refine.mli
index 3b0a9e5b6..1932a306c 100644
--- a/proofs/refine.mli
+++ b/proofs/refine.mli
@@ -17,7 +17,7 @@ open Proofview
 
 (** Printer used to print the constr which refine refines. *)
 val pr_constr :
-  (Environ.env -> Evd.evar_map -> Term.constr -> Pp.t) Hook.t
+  (Environ.env -> Evd.evar_map -> Constr.constr -> Pp.t) Hook.t
 
 (** {7 Refinement primitives} *)
 
@@ -33,7 +33,7 @@ val refine_one : typecheck:bool -> (Evd.evar_map -> Evd.evar_map * ('a * EConstr
 (** A variant of [refine] which assumes exactly one goal under focus *)
 
 val generic_refine : typecheck:bool -> ('a * EConstr.t) tactic ->
-  [ `NF ] Proofview.Goal.t -> 'a tactic
+  Proofview.Goal.t -> 'a tactic
 (** The general version of refine. *)
 
 (** {7 Helper functions} *)
diff --git a/proofs/refiner.ml b/proofs/refiner.ml
index 3e3313eb5..cd2b10906 100644
--- a/proofs/refiner.ml
+++ b/proofs/refiner.ml
@@ -30,8 +30,8 @@ let refiner pr goal_sigma =
 (* Profiling refiner *)
 let refiner = 
   if Flags.profile then
-    let refiner_key = Profile.declare_profile "refiner" in
-      Profile.profile2 refiner_key refiner
+    let refiner_key = CProfile.declare_profile "refiner" in
+      CProfile.profile2 refiner_key refiner
   else refiner
 
 (*********************)
diff --git a/proofs/refiner.mli b/proofs/refiner.mli
index 3ff010fe3..52dc8bfd8 100644
--- a/proofs/refiner.mli
+++ b/proofs/refiner.mli
@@ -35,12 +35,12 @@ val tclIDTAC_MESSAGE  : Pp.t -> tactic
 
 (** [tclEVARS sigma] changes the current evar map *)
 val tclEVARS : evar_map -> tactic
-val tclEVARUNIVCONTEXT : Evd.evar_universe_context -> tactic
+val tclEVARUNIVCONTEXT : UState.t -> tactic
 
-val tclPUSHCONTEXT : Evd.rigid -> Univ.universe_context_set -> tactic -> tactic
-val tclPUSHEVARUNIVCONTEXT : Evd.evar_universe_context -> tactic
+val tclPUSHCONTEXT : Evd.rigid -> Univ.ContextSet.t -> tactic -> tactic
+val tclPUSHEVARUNIVCONTEXT : UState.t -> tactic
 
-val tclPUSHCONSTRAINTS : Univ.constraints -> tactic
+val tclPUSHCONSTRAINTS : Univ.Constraint.t -> tactic
 
 (** [tclTHEN tac1 tac2 gls] applies the tactic [tac1] to [gls] and applies
    [tac2] to every resulting subgoals *)
diff --git a/proofs/tacmach.ml b/proofs/tacmach.ml
index a4d662e0a..d3405b892 100644
--- a/proofs/tacmach.ml
+++ b/proofs/tacmach.ml
@@ -55,24 +55,21 @@ 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)
 
 let pf_get_hyp gls id =
+  let env, sigma = pf_env gls, project gls in
   try
     Context.Named.lookup id (pf_hyps gls)
   with Not_found ->
-    raise (RefinerError (NoSuchHyp id))
+    raise (RefinerError (env, sigma, NoSuchHyp id))
 
 let pf_get_hyp_typ gls id =
   id |> pf_get_hyp gls |> NamedDecl.get_type
 
 let pf_ids_of_hyps gls = ids_of_named_context (pf_hyps gls)
+let pf_ids_set_of_hyps gls =
+  Environ.ids_of_named_context_val (Environ.named_context_val (pf_env gls))
 
 let pf_get_new_id id gls =
-  next_ident_away id (pf_ids_of_hyps gls)
-
-let pf_get_new_ids ids gls =
-  let avoid = pf_ids_of_hyps gls in
-  List.fold_right
-    (fun id acc -> (next_ident_away id (acc@avoid))::acc)
-    ids []
+  next_ident_away id (pf_ids_set_of_hyps gls)
 
 let pf_global gls id = EConstr.of_constr (Universes.constr_of_global (Constrintern.construct_reference (pf_hyps gls) id))
 
@@ -90,7 +87,7 @@ let pf_e_reduce = pf_apply
 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)
+let pf_nf_betaiota               = pf_reduce nf_betaiota
 let pf_compute                   = pf_reduce compute
 let pf_unfoldn ubinds            = pf_reduce (unfoldn ubinds)
 let pf_unsafe_type_of            = pf_reduce unsafe_type_of
@@ -106,9 +103,6 @@ let pf_reduce_to_atomic_ind     = pf_reduce reduce_to_atomic_ind
 
 let pf_hnf_type_of gls          = pf_get_type_of gls %> pf_whd_all gls
 
-let pf_is_matching gl p c       = pf_apply Constr_matching.is_matching_conv gl p c
-let pf_matches gl p c           = pf_apply Constr_matching.matches_conv gl p c
-
 (********************************************)
 (* Definition of the most primitive tactics *)
 (********************************************)
@@ -156,7 +150,6 @@ module New = struct
 
   let pf_global id gl =
     (** We only check for the existence of an [id] in [hyps] *)
-    let gl = Proofview.Goal.assume gl in
     let hyps = Proofview.Goal.hyps gl in
     Constrintern.construct_reference hyps id
 
@@ -173,19 +166,24 @@ module New = struct
 
   let pf_ids_of_hyps gl =
     (** We only get the identifiers in [hyps] *)
-    let gl = Proofview.Goal.assume gl in
     let hyps = Proofview.Goal.hyps gl in
     ids_of_named_context hyps
 
+  let pf_ids_set_of_hyps gl =
+    (** We only get the identifiers in [hyps] *)
+    let env = Proofview.Goal.env gl in
+    Environ.ids_of_named_context_val (Environ.named_context_val env)
+
   let pf_get_new_id id gl =
-    let ids = pf_ids_of_hyps gl in
+    let ids = pf_ids_set_of_hyps gl in
     next_ident_away id ids
 
   let pf_get_hyp id gl =
     let hyps = Proofview.Goal.env gl in
+    let sigma = project gl in
     let sign =
       try EConstr.lookup_named id hyps
-      with Not_found -> raise (RefinerError (NoSuchHyp id))
+      with Not_found -> raise (RefinerError (hyps, sigma, NoSuchHyp id))
     in
     sign
 
@@ -203,9 +201,8 @@ module New = struct
     let hyps = Proofview.Goal.hyps gl in
     List.hd hyps
 
-  let pf_nf_concl (gl : [ `LZ ] Proofview.Goal.t) =
+  let pf_nf_concl (gl : Proofview.Goal.t) =
     (** We normalize the conclusion just after *)
-    let gl = Proofview.Goal.assume gl in
     let concl = Proofview.Goal.concl gl in
     let sigma = project gl in
     nf_evar sigma concl
@@ -221,8 +218,6 @@ module New = struct
   let pf_hnf_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_all gl t = pf_apply whd_all gl t
   let pf_compute gl t = pf_apply compute gl t
 
diff --git a/proofs/tacmach.mli b/proofs/tacmach.mli
index 93bf428fd..8f69358d4 100644
--- a/proofs/tacmach.mli
+++ b/proofs/tacmach.mli
@@ -7,18 +7,19 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
 open EConstr
-open Evd
 open Proof_type
 open Redexpr
-open Pattern
 open Locus
 
 (** Operations for handling terms under a local typing context. *)
 
-type 'a sigma   = 'a Evd.sigma;;
+type 'a sigma   = 'a Evd.sigma
+[@@ocaml.deprecated "alias of Evd.sigma"]
+
+open Evd
 type tactic     = Proof_type.tactic;;
 
 val sig_it  : 'a sigma   -> 'a
@@ -48,7 +49,6 @@ val pf_get_hyp            : goal sigma -> Id.t -> named_declaration
 val pf_get_hyp_typ        : goal sigma -> Id.t -> types
 
 val pf_get_new_id  : Id.t      -> goal sigma -> Id.t
-val pf_get_new_ids : Id.t list -> goal sigma -> Id.t list
 
 val pf_reduction_of_red_expr : goal sigma -> red_expr -> constr -> evar_map * constr
 
@@ -77,10 +77,6 @@ val pf_const_value : goal sigma -> pconstant -> constr
 val pf_conv_x      : goal sigma -> constr -> constr -> bool
 val pf_conv_x_leq  : goal sigma -> constr -> constr -> bool
 
-val pf_matches     : goal sigma -> constr_pattern -> constr -> patvar_map
-val pf_is_matching : goal sigma -> constr_pattern -> constr -> bool
-
-
 (** {6 The most primitive tactics. } *)
 
 val refiner                   : rule -> tactic
@@ -96,47 +92,46 @@ val pr_glls   : goal list sigma -> Pp.t
 
 (* Variants of [Tacmach] functions built with the new proof engine *)
 module New : sig
-  val pf_apply : (env -> evar_map -> 'a) -> 'b Proofview.Goal.t -> 'a
-  val pf_global : identifier -> 'a Proofview.Goal.t -> Globnames.global_reference
+  val pf_apply : (env -> evar_map -> 'a) -> Proofview.Goal.t -> 'a
+  val pf_global : Id.t -> Proofview.Goal.t -> Globnames.global_reference
   (** FIXME: encapsulate the level in an existential type. *)
-  val of_old : (Proof_type.goal Evd.sigma -> 'a) -> [ `NF ] Proofview.Goal.t -> 'a
+  val of_old : (Proof_type.goal Evd.sigma -> 'a) -> Proofview.Goal.t -> 'a
 
-  val project : 'a Proofview.Goal.t -> Evd.evar_map
-  val pf_env : 'a Proofview.Goal.t -> Environ.env
-  val pf_concl : 'a Proofview.Goal.t -> types
+  val project : Proofview.Goal.t -> Evd.evar_map
+  val pf_env : Proofview.Goal.t -> Environ.env
+  val pf_concl : 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 Proofview.Goal.t -> constr -> types
+  val pf_unsafe_type_of : Proofview.Goal.t -> constr -> 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 Proofview.Goal.t -> constr -> types
+  val pf_get_type_of : Proofview.Goal.t -> constr -> types
 
   (** This function entirely type-checks the term and computes its type
       and the implied universe constraints. *)
-  val pf_type_of : 'a Proofview.Goal.t -> constr -> evar_map * types
-  val pf_conv_x : 'a Proofview.Goal.t -> t -> t -> bool
-
-  val pf_get_new_id  : identifier -> 'a Proofview.Goal.t -> identifier
-  val pf_ids_of_hyps : 'a Proofview.Goal.t -> identifier list
-  val pf_hyps_types : 'a Proofview.Goal.t -> (identifier * types) list
+  val pf_type_of : Proofview.Goal.t -> constr -> evar_map * types
+  val pf_conv_x : Proofview.Goal.t -> t -> t -> bool
 
-  val pf_get_hyp : identifier -> 'a Proofview.Goal.t -> named_declaration
-  val pf_get_hyp_typ        : identifier -> 'a Proofview.Goal.t -> types
-  val pf_last_hyp           : 'a Proofview.Goal.t -> named_declaration
+  val pf_get_new_id  : Id.t -> Proofview.Goal.t -> Id.t
+  val pf_ids_of_hyps : Proofview.Goal.t -> Id.t list
+  val pf_ids_set_of_hyps : Proofview.Goal.t -> Id.Set.t
+  val pf_hyps_types : Proofview.Goal.t -> (Id.t * types) list
 
-  val pf_nf_concl : [ `LZ ] Proofview.Goal.t -> types
-  val pf_reduce_to_quantified_ind : 'a Proofview.Goal.t -> types -> (inductive * EInstance.t) * types
+  val pf_get_hyp : Id.t -> Proofview.Goal.t -> named_declaration
+  val pf_get_hyp_typ        : Id.t -> Proofview.Goal.t -> types
+  val pf_last_hyp           : Proofview.Goal.t -> named_declaration
 
-  val pf_hnf_constr : 'a Proofview.Goal.t -> constr -> types
-  val pf_hnf_type_of : 'a Proofview.Goal.t -> constr -> types
+  val pf_nf_concl : Proofview.Goal.t -> types
+  val pf_reduce_to_quantified_ind : Proofview.Goal.t -> types -> (inductive * EInstance.t) * types
 
-  val pf_whd_all : 'a Proofview.Goal.t -> constr -> constr
-  val pf_compute : 'a Proofview.Goal.t -> constr -> constr
+  val pf_hnf_constr : Proofview.Goal.t -> constr -> types
+  val pf_hnf_type_of : Proofview.Goal.t -> constr -> types
 
-  val pf_matches : 'a Proofview.Goal.t -> constr_pattern -> constr -> patvar_map
+  val pf_whd_all : Proofview.Goal.t -> constr -> constr
+  val pf_compute : Proofview.Goal.t -> constr -> constr
 
-  val pf_nf_evar : 'a Proofview.Goal.t -> constr -> constr
+  val pf_nf_evar : Proofview.Goal.t -> constr -> constr
 
 end
diff --git a/stm/asyncTaskQueue.ml b/stm/asyncTaskQueue.ml
index 9c58df5b2..26aef5355 100644
--- a/stm/asyncTaskQueue.ml
+++ b/stm/asyncTaskQueue.ml
@@ -10,17 +10,19 @@ open CErrors
 open Pp
 open Util
 
-let stm_pr_err pp = Format.eprintf "%s] @[%a@]%!\n" (System.process_id ()) Pp.pp_with pp
-
+let stm_pr_err pp = Format.eprintf "%s] @[%a@]\n%!" (Spawned.process_id ()) Pp.pp_with pp
 let stm_prerr_endline s = if !Flags.debug then begin stm_pr_err (str s) end else ()
 
-type 'a worker_status = [ `Fresh | `Old of 'a ]
+type cancel_switch = bool ref
+let async_proofs_flags_for_workers = ref []
 
 module type Task = sig
 
   type task
   type competence
 
+  type worker_status = Fresh | Old of competence
+
   (* Marshallable *)
   type request
   type response
@@ -29,15 +31,14 @@ module type Task = sig
   val extra_env : unit -> string array
 
   (* run by the master, on a thread *)
-  val request_of_task : competence worker_status -> task -> request option
-  val task_match : competence worker_status -> task -> bool
-  val use_response :
-    competence worker_status -> task -> response ->
-      [ `Stay of competence * task list | `End ]
+  val request_of_task : worker_status -> task -> request option
+  val task_match : worker_status -> task -> bool
+  val use_response : worker_status -> task -> response ->
+    [ `Stay of competence * task list | `End ]
   val on_marshal_error : string -> task -> unit
   val on_task_cancellation_or_expiration_or_slave_death : task option -> unit
   val forward_feedback : Feedback.feedback -> unit
- 
+
   (* run by the worker *)
   val perform : request -> response
 
@@ -47,9 +48,7 @@ module type Task = sig
 
 end
 
-type expiration = bool ref
-
-module Make(T : Task) = struct
+module Make(T : Task) () = struct
 
   exception Die
   type response =
@@ -59,45 +58,45 @@ module Make(T : Task) = struct
   type request = Request of T.request
 
   type more_data =
-    | MoreDataUnivLevel of Univ.universe_level list
+    | MoreDataUnivLevel of Universes.universe_id list
 
   let slave_respond (Request r) =
     let res = T.perform r in
     Response res
 
   exception MarshalError of string
-  
+
   let marshal_to_channel oc data =
     Marshal.to_channel oc data [];
     flush oc
-  
+
   let marshal_err s = raise (MarshalError s)
-  
+
   let marshal_request oc (req : request) =
     try marshal_to_channel oc req
     with Failure s | Invalid_argument s | Sys_error s ->
       marshal_err ("marshal_request: "^s)
-  
+
   let unmarshal_request ic =
     try (CThread.thread_friendly_input_value ic : request)
     with Failure s | Invalid_argument s | Sys_error s ->
       marshal_err ("unmarshal_request: "^s)
-  
+
   let marshal_response oc (res : response) =
     try marshal_to_channel oc res
     with Failure s | Invalid_argument s | Sys_error s ->
       marshal_err ("marshal_response: "^s)
-  
+
   let unmarshal_response ic =
     try (CThread.thread_friendly_input_value ic : response)
     with Failure s | Invalid_argument s | Sys_error s ->
       marshal_err ("unmarshal_response: "^s)
-  
+
   let marshal_more_data oc (res : more_data) =
     try marshal_to_channel oc res
     with Failure s | Invalid_argument s | Sys_error s ->
       marshal_err ("marshal_more_data: "^s)
-  
+
   let unmarshal_more_data ic =
     try (CThread.thread_friendly_input_value ic : more_data)
     with Failure s | Invalid_argument s | Sys_error s ->
@@ -107,23 +106,23 @@ module Make(T : Task) = struct
     let open Feedback in
     feedback ~id:Stateid.initial (WorkerStatus(id, s))
 
-  module Worker = Spawn.Sync(struct end)
+  module Worker = Spawn.Sync ()
 
   module Model = struct
 
   type process = Worker.process
-  type extra = (T.task * expiration) TQueue.t
+  type extra = (T.task * cancel_switch) TQueue.t
 
   let spawn id =
     let name = Printf.sprintf "%s:%d" !T.name id in
     let proc, ic, oc =
       let rec set_slave_opt = function
-        | [] -> !Flags.async_proofs_flags_for_workers @
+        | [] -> !async_proofs_flags_for_workers @
                 ["-toploop"; !T.name^"top";
                  "-worker-id"; name;
                  "-async-proofs-worker-priority";
-                   Flags.string_of_priority !Flags.async_proofs_worker_priority]
-        | ("-ideslave"|"-emacs"|"-batch")::tl -> set_slave_opt tl
+                   CoqworkmgrApi.(string_of_priority !WorkerLoop.async_proofs_worker_priority)]
+        | ("-ideslave"|"-emacs"|"-emacs-U"|"-batch")::tl -> set_slave_opt tl
         | ("-async-proofs" |"-toploop" |"-vio2vo"
           |"-load-vernac-source" |"-l" |"-load-vernac-source-verbose" |"-lv"
           |"-compile" |"-compile-verbose"
@@ -140,7 +139,7 @@ module Make(T : Task) = struct
     let { WorkerPool.extra = queue; exit; cancelled } = cpanel in
     let exit () =  report_status ~id "Dead"; exit () in
     let last_task = ref None in
-    let worker_age = ref `Fresh in
+    let worker_age = ref T.Fresh in
     let got_token = ref false in
     let giveback_exec_token () =
       if !got_token then (CoqworkmgrApi.giveback 1; got_token := false) in
@@ -170,8 +169,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 n (fun _ ->
-        Universes.new_univ_level (Global.current_dirpath ())) in
+      CList.init n (fun _ -> Universes.new_univ_id ()) in
 
     let rec kill_if () =
       if not (Worker.is_alive proc) then ()
@@ -213,7 +211,7 @@ module Make(T : Task) = struct
               | `Stay(competence, new_tasks) ->
                    last_task := None;
                    giveback_exec_token ();
-                   worker_age := `Old competence;
+                   worker_age := T.Old competence;
                    add_tasks new_tasks
         in
           continue ()
@@ -236,8 +234,8 @@ module Make(T : Task) = struct
 
   type queue = {
     active : Pool.pool;
-    queue : (T.task * expiration) TQueue.t;
-    cleaner : Thread.t;
+    queue : (T.task * cancel_switch) TQueue.t;
+    cleaner : Thread.t option;
   }
 
   let create size =
@@ -250,18 +248,18 @@ module Make(T : Task) = struct
     {
       active = Pool.create queue ~size;
       queue;
-      cleaner = Thread.create cleaner queue;
+      cleaner = if size > 0 then Some (Thread.create cleaner queue) else None;
     }
-  
+
   let destroy { active; queue } =
     Pool.destroy active;
     TQueue.destroy queue
 
   let broadcast { queue } = TQueue.broadcast queue
 
-  let enqueue_task { queue; active } (t, _ as item) =
+  let enqueue_task { queue; active } t ~cancel_switch =
     stm_prerr_endline ("Enqueue task "^T.name_of_task t);
-    TQueue.push queue item
+    TQueue.push queue (t, cancel_switch)
 
   let cancel_worker { active } n = Pool.cancel n active
 
@@ -297,7 +295,7 @@ module Make(T : Task) = struct
   let slave_handshake () =
     Pool.worker_handshake (Option.get !slave_ic) (Option.get !slave_oc)
 
-  let pp_pid pp = Pp.(str (System.process_id () ^ " ") ++ pp)
+  let pp_pid pp = Pp.(str (Spawned.process_id () ^ " ") ++ pp)
 
   let debug_with_pid = Feedback.(function
     | { contents = Message(Debug, loc, pp) } as fb ->
@@ -310,7 +308,7 @@ module Make(T : Task) = struct
       Marshal.to_channel oc (RespFeedback (debug_with_pid fb)) []; flush oc in
     ignore (Feedback.add_feeder (fun x -> slave_feeder (Option.get !slave_oc) x));
     (* We ask master to allocate universe identifiers *)
-    Universes.set_remote_new_univ_level (bufferize (fun () ->
+    Universes.set_remote_new_univ_id (bufferize (fun () ->
       marshal_response (Option.get !slave_oc) RespGetCounterNewUnivLevel;
       match unmarshal_more_data (Option.get !slave_ic) with
       | MoreDataUnivLevel l -> l));
@@ -339,14 +337,14 @@ module Make(T : Task) = struct
   let clear { queue; active } =
     assert(Pool.is_empty active); (* We allow that only if no slaves *)
     TQueue.clear queue
-  
+
   let snapshot { queue; active } =
     List.map fst
      (TQueue.wait_until_n_are_waiting_then_snapshot
        (Pool.n_workers active) queue)
 
   let with_n_workers n f =
-    let q = create n in 
+    let q = create n in
     try let rc = f q in destroy q; rc
     with e -> let e = CErrors.push e in destroy q; iraise e
 
@@ -354,5 +352,5 @@ module Make(T : Task) = struct
 
 end
 
-module MakeQueue(T : Task) = struct include Make(T) end
-module MakeWorker(T : Task) = struct include Make(T) end
+module MakeQueue(T : Task) () = struct include Make(T) () end
+module MakeWorker(T : Task) () = struct include Make(T) () end
diff --git a/stm/asyncTaskQueue.mli b/stm/asyncTaskQueue.mli
index a80918e93..706d36e1d 100644
--- a/stm/asyncTaskQueue.mli
+++ b/stm/asyncTaskQueue.mli
@@ -6,79 +6,214 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-type 'a worker_status = [ `Fresh | `Old of 'a ]
+(* Default flags for workers *)
+val async_proofs_flags_for_workers : string list ref
 
+(** This file provides an API for defining and managing a queue of
+    tasks to be done by external workers.
+
+    A queue of items of type [task] is maintained, then for each task,
+    a request is generated, then sent to a worker using marshalling.
+
+    The workers will then eventually return a result, using marshalling
+    again:
+     ____ ____ ____                    ________
+    | T1 | T2 | T3 | => [request ] => | Worker |
+    |____|____|____| <= [response] <= |________|
+    | Master Proc. |
+    \--------------/
+
+    Thus [request] and [response] must be safely marshallable.
+
+    Operations for managing the task queue are provide, see below
+    for more details.
+
+ *)
+
+(** The [Task] module type defines an abstract message-processing
+    queue. *)
 module type Task = sig
 
+  (** Main description of a task. Elements are stored in the "master"
+      process, and then converted into a request.
+  *)
   type task
+
+  (** [competence] stores the information about what kind of work a
+      worker has completed / has available. *)
   type competence
 
-  (* Marshallable *)
+  (** A worker_status is:
+
+    - [`Fresh] when a worker is born.
+
+    - [`Old of competence]: When a worker ends a job it can either die
+      (and be replaced by a fresh new worker) or hang there as an [`Old]
+      worker. In such case some data can be carried by the [`Old]
+      constructor, typically used to implement [request_of_task].
+
+      This allows to implement both one-shot workers and "persistent"
+      ones. E.g. par: is implement using workers that don't
+      "reboot". Proof workers do reboot mainly because the vm has some
+      C state that cannot be cleared, so you have a real memory leak if
+      you don't reboot the worker. *)
+  type worker_status = Fresh | Old of competence
+
+  (** Type of input and output data for workers.
+
+      The data must be marshallable as it send through the network
+      using [Marshal] . *)
   type request
   type response
 
-  val name : string ref (* UID of the task kind, for -toploop *)
+  (** UID of the task kind, for -toploop *)
+  val name : string ref
+  (** Extra arguments of the task kind, for -toploop *)
   val extra_env : unit -> string array
 
-  (* run by the master, on a thread *)
-  val request_of_task : competence worker_status -> task -> request option
-  val task_match : competence worker_status -> task -> bool
-  val use_response :
-    competence worker_status -> task -> response ->
-      [ `Stay of competence * task list | `End ]
+  (** {5 Master API, it is run by the master, on a thread} *)
+
+  (** [request_of_task status t] takes the [status] of the worker
+      and a task [t] and creates the corresponding [Some request] to be
+      sent to the worker or it is not valid anymore [None]. *)
+  val request_of_task : worker_status -> task -> request option
+
+  (** [task_match status tid] Allows to discard tasks based on the
+      worker status.  *)
+  val task_match : worker_status -> task -> bool
+
+  (** [use_response status t out]
+
+      For a response [out] to a task [t] with [status] we can choose
+      to end the worker of to keep it alive with some data and
+      immediately inject extra tasks in the queue.
+
+      For example, the proof worker runs a proof and finds an error,
+      the response signals that, e.g.
+
+      [ReponseError {state = 34; msg = "oops"}]
+
+      When the manager uses such a response he can tell the worker to
+      stay there and inject into the queue an extra task requesting
+      state 33 (to implement efficient proof repair).  *)
+  val use_response : worker_status -> task -> response ->
+    [ `Stay of competence * task list | `End ]
+
+  (** [on_marshal_error err_msg tid] notifies of marshaling failure. *)
   val on_marshal_error : string -> task -> unit
+
+  (** [on_task_cancellation_or_expiration_or_slave_death tid]
+
+      These functions are meant to parametrize the worker manager on
+      the actions to be taken when things go wrong or are cancelled
+      (you can kill a worker in CoqIDE, or using kill -9...)
+
+      E.g. master can decide to inhabit the (delegate) Future.t with a
+      closure (to be run in master), i.e. make the document still
+      checkable. This is what I do for marshaling errors.  *)
   val on_task_cancellation_or_expiration_or_slave_death : task option -> unit
+
+  (** [forward_feedback fb] sends fb to all the workers. *)
   val forward_feedback : Feedback.feedback -> unit
- 
-  (* run by the worker *)
+
+  (** {5 Worker API, it is run by worker, on a different fresh
+      process} *)
+
+  (** [perform in] synchronously processes a request [in] *)
   val perform : request -> response
 
-  (* debugging *)
+  (** debugging *)
   val name_of_task : task -> string
   val name_of_request : request -> string
 
 end
 
-type expiration = bool ref
+(** [cancel_switch] to be flipped to true by anyone to signal the task
+    is not relevant anymore. When the STM performs an undo/edit-at, it
+    crawls the document and flips these flags (the Qed node carries a
+    pointer to the flag IIRC).
+*)
+type cancel_switch = bool ref
 
-module MakeQueue(T : Task) : sig
+(** Client-side functor. [MakeQueue T] creates a task queue for task [T]  *)
+module MakeQueue(T : Task) () : sig
 
+  (** [queue] is the abstract queue type. *)
   type queue
 
-  (* Number of workers, 0 = lazy local *)
+  (** [create n] will initialize the queue with [n] workers. If [n] is
+      0, the queue won't spawn any process, working in a lazy local
+      manner. [not imposed by the this API] *)
   val create : int -> queue
+
+  (** [destroy q] Deallocates [q], cancelling all pending tasks. *)
   val destroy : queue -> unit
 
+  (** [n_workers q] returns the number of workers of [q] *)
   val n_workers : queue -> int
 
-  val enqueue_task : queue -> T.task * expiration -> unit
+  (** [enqueue_task q t ~cancel_switch] schedules [t] for execution in
+      [q]. [cancel_switch] can be flipped to true to cancel the task. *)
+  val enqueue_task : queue -> T.task -> cancel_switch:cancel_switch -> unit
 
-  (* blocking function that waits for the task queue to be empty *)
+  (** [join q] blocks until the task queue is empty *)
   val join : queue -> unit
+
+  (** [cancel_all q] Cancels all tasks *)
   val cancel_all : queue -> unit
 
+  (** [cancel_worker q wid] cancels a particular worker [wid] *)
   val cancel_worker : queue -> WorkerPool.worker_id -> unit
 
+  (** [set_order q cmp] reorders [q] using ordering [cmp] *)
   val set_order : queue -> (T.task -> T.task -> int) -> unit
 
+  (** [broadcast q]
+
+      This is nasty. Workers can be picky, e.g. pick tasks only when
+      they are "on screen". Of course the screen is scrolled, and that
+      changes the potential choice of workers to pick up a task or
+      not.
+
+      This function wakes up the workers (the managers) that give a
+      look (again) to the tasks in the queue.
+
+      The STM calls it when the perspective (as in PIDE) changes.
+
+      A problem here is that why task_match has access to the
+      competence data in order to decide if the task is palatable to
+      the worker or not... such data is local to the worker (manager).
+      The perspective is global, so it does not quite fit this
+      picture. This API to make all managers reconsider the tasks in
+      the queue is the best I could came up with.
+
+      This API is crucial to Coqoon (or any other UI that invokes
+      Stm.finish eagerly but wants the workers to "focus" on the visible
+      part of the document).
+  *)
   val broadcast : queue -> unit
 
-  (* Take a snapshot (non destructive but waits until all workers are
-   * enqueued) *)
+  (** [snapshot q] Takes a snapshot (non destructive but waits until
+      all workers are enqueued) *)
   val snapshot : queue -> T.task list
 
-  (* Clears the queue, only if the worker prool is empty *)
- val clear : queue -> unit
- 
-  (* create a queue, run the function, destroy the queue.
-   * the user should call join *)
+  (** [clear q] Clears [q], only if the worker prool is empty *)
+  val clear : queue -> unit
+
+  (** [with_n_workers n f] create a queue, run the function, destroy
+      the queue. The user should call join *)
   val with_n_workers : int -> (queue -> 'a) -> 'a
 
 end
 
-module MakeWorker(T : Task) : sig
+(** Server-side functor. [MakeWorker T] creates the server task
+    dispatcher. *)
+module MakeWorker(T : Task) () : sig
 
-  val main_loop : unit -> unit
+  (** [init_stdout ()] is called at [Coqtop.toploop_init] time. *)
   val init_stdout : unit -> unit
-  
+
+  (** [main_loop ()] is called at [Coqtop.toploop_run] time. *)
+  val main_loop : unit -> unit
+
 end
diff --git a/stm/coqworkmgrApi.ml b/stm/coqworkmgrApi.ml
index 6d6a198c5..14fd97a6d 100644
--- a/stm/coqworkmgrApi.ml
+++ b/stm/coqworkmgrApi.ml
@@ -8,8 +8,15 @@
 
 let debug = false
 
+type priority = Low | High
+let string_of_priority = function Low -> "low" | High -> "high"
+let priority_of_string = function
+  | "low" -> Low
+  | "high" -> High
+  | _ -> raise (Invalid_argument "priority_of_string")
+
 type request =
-  | Hello of Flags.priority
+  | Hello of priority
   | Get of int
   | TryGet of int
   | GiveBack of int
@@ -36,8 +43,8 @@ let positive_int_of_string n =
 let parse_request s =
   if debug then Printf.eprintf "parsing '%s'\n" s;
   match Str.split (Str.regexp " ") (strip_r s) with
-  | [ "HELLO"; "LOW" ] -> Hello Flags.Low
-  | [ "HELLO"; "HIGH" ] -> Hello Flags.High
+  | [ "HELLO"; "LOW" ] -> Hello Low
+  | [ "HELLO"; "HIGH" ] -> Hello High
   | [ "GET"; n ] -> Get (positive_int_of_string n)
   | [ "TRYGET"; n ] -> TryGet (positive_int_of_string n)
   | [ "GIVEBACK"; n ] -> GiveBack (positive_int_of_string n)
@@ -57,8 +64,8 @@ let parse_response s =
   | _ -> raise ParseError
        
 let print_request = function
-  | Hello Flags.Low -> "HELLO LOW\n"
-  | Hello Flags.High -> "HELLO HIGH\n"
+  | Hello Low -> "HELLO LOW\n"
+  | Hello High -> "HELLO HIGH\n"
   | Get n -> Printf.sprintf "GET %d\n" n
   | TryGet n -> Printf.sprintf "TRYGET %d\n" n
   | GiveBack n -> Printf.sprintf "GIVEBACK %d\n" n
@@ -106,8 +113,7 @@ let with_manager f g =
 
 let get n =
   with_manager
-  (fun () ->
-    min n (min !Flags.async_proofs_n_workers !Flags.async_proofs_n_tacworkers))
+  (fun () -> n)
   (fun cin cout ->
     output_string cout (print_request (Get n));
     flush cout;
@@ -118,10 +124,7 @@ let get n =
 
 let tryget n =
   with_manager
-  (fun () ->
-    Some
-     (min n
-       (min !Flags.async_proofs_n_workers !Flags.async_proofs_n_tacworkers)))
+  (fun () -> Some n)
   (fun cin cout ->
     output_string cout (print_request (TryGet n));
     flush cout;
diff --git a/stm/coqworkmgrApi.mli b/stm/coqworkmgrApi.mli
index 70d4173ae..953903810 100644
--- a/stm/coqworkmgrApi.mli
+++ b/stm/coqworkmgrApi.mli
@@ -8,9 +8,13 @@
 
 (* High level api for clients of the service (like coqtop) *)
 
+type priority = Low | High
+val string_of_priority : priority -> string
+val priority_of_string : string -> priority
+
 (* Connects to a work manager if any. If no worker manager, then
    -async-proofs-j and -async-proofs-tac-j are used *)
-val init : Flags.priority -> unit
+val init : priority -> unit
 
 (* blocking *)
 val get : int -> int
@@ -21,7 +25,7 @@ val giveback : int -> unit
 
 (* Low level *)
 type request =
-  | Hello of Flags.priority
+  | Hello of priority
   | Get of int
   | TryGet of int
   | GiveBack of int
diff --git a/stm/proofBlockDelimiter.ml b/stm/proofBlockDelimiter.ml
index a4b35ad60..bebc4d5d5 100644
--- a/stm/proofBlockDelimiter.ml
+++ b/stm/proofBlockDelimiter.ml
@@ -11,7 +11,7 @@ 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 ]
+val is_focused_goal_simple : doc:Stm.doc -> Stateid.t -> [ `Simple of Goal.goal list | `Not ]
 
 type 'a until = [ `Stop | `Found of static_block_declaration | `Cont of 'a ]
 
@@ -23,8 +23,8 @@ val crawl :
 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
+val of_vernac_control_val : Vernacexpr.vernac_control -> Stm.DynBlockData.t
+val to_vernac_control_val : Stm.DynBlockData.t -> Vernacexpr.vernac_control
 
 end = struct
 
@@ -32,7 +32,7 @@ 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 of_vernac_control_val, to_vernac_control_val = DynBlockData.Easy.make_dyn "vernac_control"
 
 let simple_goal sigma g gs =
   let open Evar in
@@ -43,10 +43,10 @@ let simple_goal sigma g gs =
   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
+let is_focused_goal_simple ~doc id =
+  match state_of_id ~doc id with
   | `Expired | `Error _ | `Valid None -> `Not
-  | `Valid (Some { proof }) ->
+  | `Valid (Some { Vernacstate.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
@@ -74,27 +74,29 @@ include Util
 (* ****************** - foo - bar - baz *********************************** *)
 
 let static_bullet ({ entry_point; prev_node } as view) =
-  match entry_point.ast with
+  assert (not (Vernacprop.has_Fail entry_point.ast));
+  match Vernacprop.under_control 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
+        if Vernacprop.has_Fail node.ast then `Stop
+        else match Vernacprop.under_control 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
+let dynamic_bullet doc { dynamic_switch = id; carry_on_data = b } =
+  match is_focused_goal_simple ~doc id with
   | `Simple focused ->
       `ValidBlock {
          base_state = id;
          goals_to_admit = focused;
-         recovery_command = Some (Vernacexpr.VernacBullet (to_bullet_val b))
+         recovery_command = Some (Vernacexpr.VernacExpr([], Vernacexpr.VernacBullet (to_bullet_val b)))
       }
   | `Not -> `Leaks
 
@@ -104,9 +106,10 @@ let () = register_proof_block_delimiter
 (* ******************** { block } ***************************************** *)
   
 let static_curly_brace ({ entry_point; prev_node } as view) =
-  assert(entry_point.ast = Vernacexpr.VernacEndSubproof);
+  assert(Vernacprop.under_control entry_point.ast = Vernacexpr.VernacEndSubproof);
   crawl view (fun (nesting,prev) node ->
-    match node.ast with
+    if Vernacprop.has_Fail node.ast then `Cont (nesting,node)
+    else match Vernacprop.under_control 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 }
@@ -116,13 +119,13 @@ let static_curly_brace ({ entry_point; prev_node } as view) =
       `Cont (nesting + 1,node)
     | _ -> `Cont (nesting,node)) (-1, entry_point)
 
-let dynamic_curly_brace { dynamic_switch = id } =
-  match is_focused_goal_simple id with
+let dynamic_curly_brace doc { dynamic_switch = id } =
+  match is_focused_goal_simple ~doc id with
   | `Simple focused ->
       `ValidBlock {
          base_state = id;
          goals_to_admit = focused;
-         recovery_command = Some Vernacexpr.VernacEndSubproof
+         recovery_command = Some (Vernacexpr.VernacExpr ([], Vernacexpr.VernacEndSubproof))
       }
   | `Not -> `Leaks
 
@@ -138,8 +141,8 @@ let static_par { entry_point; prev_node } =
       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
+let dynamic_par doc { dynamic_switch = id } =
+  match is_focused_goal_simple ~doc id with
   | `Simple focused ->
       `ValidBlock {
          base_state = id;
@@ -164,19 +167,19 @@ let static_indent ({ entry_point; prev_node } as view) =
         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 }
+                   carry_on_data = of_vernac_control_val entry_point.ast }
         ) last_tac
 
-let dynamic_indent { dynamic_switch = id; carry_on_data = e } =
+let dynamic_indent doc { dynamic_switch = id; carry_on_data = e } =
   Printf.eprintf "%s\n" (Stateid.to_string id);
-  match is_focused_goal_simple id with
+  match is_focused_goal_simple ~doc 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);
+         recovery_command = Some (to_vernac_control_val e);
       }
   | `Not -> `Leaks
 
diff --git a/stm/proofBlockDelimiter.mli b/stm/proofBlockDelimiter.mli
index e23a1d1c1..5cff0a8a7 100644
--- a/stm/proofBlockDelimiter.mli
+++ b/stm/proofBlockDelimiter.mli
@@ -21,7 +21,7 @@
     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 ]
+val is_focused_goal_simple : doc:Stm.doc -> Stateid.t -> [ `Simple of Goal.goal list | `Not ]
 
 type 'a until = [ `Stop | `Found of Stm.static_block_declaration | `Cont of 'a ]
 
diff --git a/stm/proofworkertop.ml b/stm/proofworkertop.ml
index 95012d984..81637f143 100644
--- a/stm/proofworkertop.ml
+++ b/stm/proofworkertop.ml
@@ -6,9 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-module W = AsyncTaskQueue.MakeWorker(Stm.ProofTask)
+module W = AsyncTaskQueue.MakeWorker(Stm.ProofTask) ()
 
 let () = Coqtop.toploop_init := WorkerLoop.loop W.init_stdout
 
-let () = Coqtop.toploop_run := W.main_loop
+let () = Coqtop.toploop_run := (fun _ ~state:_ -> W.main_loop ())
 
diff --git a/stm/queryworkertop.ml b/stm/queryworkertop.ml
index 85f0e6bfc..7862f2f44 100644
--- a/stm/queryworkertop.ml
+++ b/stm/queryworkertop.ml
@@ -6,9 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-module W = AsyncTaskQueue.MakeWorker(Stm.QueryTask)
+module W = AsyncTaskQueue.MakeWorker(Stm.QueryTask) ()
 
 let () = Coqtop.toploop_init := WorkerLoop.loop W.init_stdout
 
-let () = Coqtop.toploop_run := W.main_loop
+let () = Coqtop.toploop_run := (fun _ ~state:_ -> W.main_loop ())
 
diff --git a/stm/spawned.ml b/stm/spawned.ml
index 6ab096abf..fb5708f3a 100644
--- a/stm/spawned.ml
+++ b/stm/spawned.ml
@@ -73,3 +73,9 @@ let get_channels () =
     Printf.eprintf "Fatal error: ideslave communication channels not set.\n";
     exit 1
   | Some(ic, oc) -> ic, oc
+
+let process_id () =
+  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/stm/spawned.mli b/stm/spawned.mli
index c3cf4d67b..7f463c6a6 100644
--- a/stm/spawned.mli
+++ b/stm/spawned.mli
@@ -20,3 +20,5 @@ val init_channels : unit -> unit
 (* Once initialized, these are the channels to talk with our master *)
 val get_channels : unit -> CThread.thread_ic * out_channel
 
+(** {6 Name of current process.} *)
+val process_id : unit -> string
diff --git a/stm/stm.ml b/stm/stm.ml
index 3386044f2..e7c371798 100644
--- a/stm/stm.ml
+++ b/stm/stm.ml
@@ -8,25 +8,84 @@
 
 (* enable in case of stm problems  *)
 (* let stm_debug () = !Flags.debug *)
-let stm_debug () = !Flags.stm_debug
+let stm_debug = ref false
 
-let stm_pr_err s  = Format.eprintf "%s] %s\n%!"     (System.process_id ()) s
-let stm_pp_err pp = Format.eprintf "%s] @[%a@]\n%!" (System.process_id ()) Pp.pp_with pp
+let stm_pr_err s  = Format.eprintf "%s] %s\n%!"     (Spawned.process_id ()) s
+let stm_pp_err pp = Format.eprintf "%s] @[%a@]\n%!" (Spawned.process_id ()) Pp.pp_with pp
 
-let stm_prerr_endline s = if stm_debug () then begin stm_pr_err (s ()) end else ()
-let stm_pperr_endline s = if stm_debug () then begin stm_pp_err (s ()) end else ()
+let stm_prerr_endline s = if !stm_debug then begin stm_pr_err (s ()) end else ()
+let stm_pperr_endline s = if !stm_debug then begin stm_pp_err (s ()) end else ()
 
 let stm_prerr_debug   s = if !Flags.debug then begin stm_pr_err (s ()) end else ()
 
 open Pp
 open CErrors
+open Names
 open Feedback
 open Vernacexpr
-open Vernac_classifier
+
+module AsyncOpts = struct
+
+  type cache = Force
+  type async_proofs = APoff | APonLazy | APon
+  type tac_error_filter = [ `None | `Only of string list | `All ]
+
+  type stm_opt = {
+    async_proofs_n_workers : int;
+    async_proofs_n_tacworkers : int;
+
+    async_proofs_cache : cache option;
+    async_proofs_mode : async_proofs;
+
+    async_proofs_private_flags : string option;
+    async_proofs_full : bool;
+    async_proofs_never_reopen_branch : bool;
+
+    async_proofs_tac_error_resilience : tac_error_filter;
+    async_proofs_cmd_error_resilience : bool;
+    async_proofs_delegation_threshold : float;
+  }
+
+  let default_opts = {
+    async_proofs_n_workers = 1;
+    async_proofs_n_tacworkers = 2;
+
+    async_proofs_cache = None;
+
+    async_proofs_mode = APoff;
+
+    async_proofs_private_flags = None;
+    async_proofs_full = false;
+    async_proofs_never_reopen_branch = false;
+
+    async_proofs_tac_error_resilience = `Only [ "curly" ];
+    async_proofs_cmd_error_resilience = true;
+    async_proofs_delegation_threshold = 0.03;
+  }
+
+  let cur_opt = ref default_opts
+end
+
+open AsyncOpts
+
+let async_proofs_is_master opt =
+  opt.async_proofs_mode = APon &&
+  !Flags.async_proofs_worker_id = "master"
+
+(* Protect against state changes *)
+let stm_purify f x =
+  let st = Vernacstate.freeze_interp_state `No in
+  try
+    let res = f x in
+    Vernacstate.unfreeze_interp_state st;
+    res
+  with e ->
+    let e = CErrors.push e in
+    Vernacstate.unfreeze_interp_state st;
+    Exninfo.iraise e
 
 let execution_error ?loc state_id msg =
-    feedback ~id:state_id
-      (Message (Error, loc, msg))
+    feedback ~id:state_id (Message (Error, loc, msg))
 
 module Hooks = struct
 
@@ -37,11 +96,11 @@ 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 = 
+let forward_feedback, forward_feedback_hook =
   let m = Mutex.create () in
   Hook.make ~default:(function
-    | { id = id; route; contents } ->
-        try Mutex.lock m; feedback ~id:id ~route contents; Mutex.unlock m
+    | { doc_id = did; span_id = id; route; contents } ->
+        try Mutex.lock m; feedback ~did ~id ~route contents; Mutex.unlock m
         with e -> Mutex.unlock m; raise e) ()
 
 let unreachable_state, unreachable_state_hook = Hook.make
@@ -64,11 +123,6 @@ let call_process_error_once =
 
 end
 
-(* During interactive use we cache more states so that Undoing is fast *)
-let interactive () =
-  if !Flags.ide_slave || not !Flags.batch_mode then `Yes
-  else `No
-
 let async_proofs_workers_extra_env = ref [||]
 
 type aast = {
@@ -76,7 +130,7 @@ type aast = {
   loc : Loc.t option;
   indentation : int;
   strlen : int;
-  mutable expr : vernac_expr; (* mutable: Proof using hinted by aux file *)
+  mutable expr : vernac_control; (* mutable: Proof using hinted by aux file *)
 }
 let pr_ast { expr; indentation } = Pp.(int indentation ++ str " " ++ Ppvernac.pr_vernac expr)
 
@@ -84,14 +138,14 @@ let default_proof_mode () = Proof_global.get_default_proof_mode_name () [@ocaml.
 
 (* Commands piercing opaque *)
 let may_pierce_opaque = function
-  | { expr = VernacPrint _ } -> true
-  | { expr = VernacExtend (("Extraction",_), _) } -> true
-  | { expr = VernacExtend (("SeparateExtraction",_), _) } -> true
-  | { expr = VernacExtend (("ExtractionLibrary",_), _) } -> true
-  | { expr = VernacExtend (("RecursiveExtractionLibrary",_), _) } -> true
-  | { expr = VernacExtend (("ExtractionConstant",_), _) } -> true
-  | { expr = VernacExtend (("ExtractionInlinedConstant",_), _) } -> true
-  | { expr = VernacExtend (("ExtractionInductive",_), _) } -> true
+  | VernacPrint _
+  | VernacExtend (("Extraction",_), _)
+  | VernacExtend (("SeparateExtraction",_), _)
+  | VernacExtend (("ExtractionLibrary",_), _)
+  | VernacExtend (("RecursiveExtractionLibrary",_), _)
+  | VernacExtend (("ExtractionConstant",_), _)
+  | VernacExtend (("ExtractionInlinedConstant",_), _)
+  | VernacExtend (("ExtractionInductive",_), _) -> true
   | _ -> false
 
 let update_global_env () =
@@ -102,7 +156,6 @@ module Vcs_ = Vcs.Make(Stateid.Self)
 type future_proof = Proof_global.closed_proof_output Future.computation
 type proof_mode = string
 type depth = int
-type cancel_switch = bool ref
 type branch_type =
   [ `Master
   | `Proof of proof_mode * depth
@@ -116,14 +169,14 @@ type cmd_t = {
   cids : Names.Id.t list;
   cblock : proof_block_name option;
   cqueue : [ `MainQueue
-           | `TacQueue of solving_tac * anon_abstracting_tac * cancel_switch
-           | `QueryQueue of cancel_switch
+           | `TacQueue of solving_tac * anon_abstracting_tac * AsyncTaskQueue.cancel_switch
+           | `QueryQueue of AsyncTaskQueue.cancel_switch
            | `SkipQueue ] }
 type fork_t = aast * Vcs_.Branch.t * Vernacexpr.opacity_guarantee * Names.Id.t list
 type qed_t = {
   qast : aast;
   keep : vernac_qed_type;
-  mutable fproof : (future_proof * cancel_switch) option;
+  mutable fproof : (future_proof * AsyncTaskQueue.cancel_switch) option;
   brname : Vcs_.Branch.t;
   brinfo : branch_type Vcs_.branch_info
 }
@@ -143,28 +196,28 @@ type step =
   | `Qed    of qed_t * Stateid.t
   | `Sideff of seff_t * 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" ]
+let summary_pstate = Evarutil.meta_counter_summary_tag,
+                     Evd.evar_counter_summary_tag,
+                     Obligations.program_tcc_summary_tag
+
 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) *)
-}
+  | Valid of Vernacstate.t
+
 type branch = Vcs_.Branch.t * branch_type Vcs_.branch_info
 type backup = { mine : branch; others : branch list }
+
 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 *)
@@ -174,7 +227,7 @@ type 'vcs state_info = { (* TODO: Make this record private to VCS *)
 let default_info () =
   { n_reached = 0; n_goals = 0; state = Empty; vcs_backup = None,None }
 
-module DynBlockData : Dyn.S = Dyn.Make(struct end)
+module DynBlockData : Dyn.S = Dyn.Make ()
 
 (* Clusters of nodes implemented as Dag properties.  While Dag and Vcs impose
  * no constraint on properties, here we impose boxes to be non overlapping.
@@ -253,6 +306,16 @@ end (* }}} *)
 (*************************** THE DOCUMENT *************************************)
 (******************************************************************************)
 
+(* The main document type associated to a VCS *)
+type stm_doc_type =
+  | VoDoc       of string
+  | VioDoc      of string
+  | Interactive of Names.DirPath.t
+
+(* Dummy until we land the functional interp patch + fixed start_library *)
+type doc = int
+let dummy_doc : doc = 0
+
 (* Imperative wrap around VCS to obtain _the_ VCS that is the
  * representation of the document Coq is currently processing *)
 module VCS : sig
@@ -269,7 +332,13 @@ module VCS : sig
 
   type vcs = (branch_type, transaction, vcs state_info, box) Vcs_.t
 
-  val init : id -> unit
+  val init : stm_doc_type -> id -> doc
+  (* val get_type : unit -> stm_doc_type *)
+  val set_ldir : Names.DirPath.t -> unit
+  val get_ldir : unit -> Names.DirPath.t
+
+  val is_interactive : unit -> [`Yes | `No | `Shallow]
+  val is_vio_doc : unit -> bool
 
   val current_branch : unit -> Branch.t
   val checkout : Branch.t -> unit
@@ -297,7 +366,7 @@ module VCS : sig
   (* cuts from start -> stop, raising Expired if some nodes are not there *)
   val slice : block_start:id -> block_stop:id -> vcs
   val nodes_in_slice : block_start:id -> block_stop:id -> Stateid.t list
-  
+
   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
@@ -332,10 +401,10 @@ end = struct (* {{{ *)
 
        In case you are hitting the race enable stm_debug.
     *)
-    if stm_debug () then Flags.we_are_parsing := false;
+    if !stm_debug then Flags.we_are_parsing := false;
 
     let fname =
-      "stm_" ^ Str.global_replace (Str.regexp " ") "_" (System.process_id ()) in
+      "stm_" ^ Str.global_replace (Str.regexp " ") "_" (Spawned.process_id ()) in
     let string_of_transaction = function
       | Cmd { cast = t } | Fork (t, _,_,_) ->
           (try Pp.string_of_ppcmds (pr_ast t) with _ -> "ERR")
@@ -346,7 +415,7 @@ end = struct (* {{{ *)
       | Noop -> " "
       | Alias (id,_) -> sprintf "Alias(%s)" (Stateid.to_string id)
       | Qed { qast } -> Pp.string_of_ppcmds (pr_ast qast) in
-    let is_green id = 
+    let is_green id =
       match get_info vcs id with
       | Some { state = Valid _ } -> true
       | _ -> false in
@@ -414,7 +483,7 @@ end = struct (* {{{ *)
     let outerboxes boxes =
        List.filter (fun b ->
          not (List.exists (fun b1 ->
-           not (same_box b1 b) && contains b1 b) boxes)           
+           not (same_box b1 b) && contains b1 b) boxes)
          ) boxes in
     let rec rec_print b =
       boxes := CList.remove same_box b !boxes;
@@ -451,9 +520,30 @@ end = struct (* {{{ *)
   type vcs = (branch_type, transaction, vcs state_info, box) t
   let vcs : vcs ref = ref (empty Stateid.dummy)
 
-  let init id =
+  let doc_type = ref (Interactive (Names.DirPath.make []))
+  let ldir = ref Names.DirPath.empty
+
+  let init dt id =
+    doc_type := dt;
     vcs := empty id;
-    vcs := set_info !vcs id (default_info ())
+    vcs := set_info !vcs id (default_info ());
+    dummy_doc
+
+  let set_ldir ld =
+    ldir := ld
+
+  let get_ldir () = !ldir
+  (* let get_type () = !doc_type *)
+
+  let is_interactive () =
+    match !doc_type with
+    | Interactive _ -> `Yes
+    | _ -> `No
+
+  let is_vio_doc () =
+    match !doc_type with
+    | VioDoc _ -> true
+    | _ -> false
 
   let current_branch () = current_branch !vcs
 
@@ -474,12 +564,10 @@ end = struct (* {{{ *)
     vcs := rewrite_merge !vcs id ~ours ~theirs:Noop ~at branch
   let reachable id = reachable !vcs id
   let mk_branch_name { expr = x } = Branch.make
-    (let rec aux x = match x with
-    | VernacDefinition (_,((_,i),_),_) -> Names.string_of_id i
-    | VernacStartTheoremProof (_,[Some ((_,i),_),_]) -> Names.string_of_id i
-    | VernacTime (_, e)
-    | VernacTimeout (_, e) -> aux e
-    | _ -> "branch" in aux x)
+    (match Vernacprop.under_control x with
+    | VernacDefinition (_,({CAst.v=Name i},_),_) -> Id.to_string i
+    | VernacStartTheoremProof (_,[({CAst.v=i},_),_]) -> Id.to_string i
+    | _ -> "branch")
   let edit_branch = Branch.make "edit"
   let branch ?root ?pos name kind = vcs := branch !vcs ?root ?pos name kind
   let get_info id =
@@ -488,7 +576,7 @@ end = struct (* {{{ *)
     | None -> raise Vcs_aux.Expired
   let set_state id s =
     (get_info id).state <- s;
-    if Flags.async_proofs_is_master () then Hooks.(call state_ready id)
+    if async_proofs_is_master !cur_opt then Hooks.(call state_ready id)
   let get_state id = (get_info id).state
   let reached id =
     let info = get_info id in
@@ -523,7 +611,7 @@ end = struct (* {{{ *)
       let id = new_node () in
       merge id ~ours:(Sideff action) ~into:b Branch.master)
     (List.filter (fun b -> not (Branch.equal b Branch.master)) (branches ()))
-  
+
   let visit id = Vcs_aux.visit !vcs id
 
   let nodes_in_slice ~block_start ~block_stop =
@@ -622,7 +710,7 @@ end = struct (* {{{ *)
     val command : now:bool -> (unit -> unit) -> unit
 
   end = struct
-    
+
     let m = Mutex.create ()
     let c = Condition.create ()
     let job = ref None
@@ -663,7 +751,7 @@ end = struct (* {{{ *)
 
 end (* }}} *)
 
-let state_of_id id =
+let state_of_id ~doc id =
   try match (VCS.get_info id).state with
     | Valid s -> `Valid (Some s)
     | Error (e,_) -> `Error e
@@ -673,7 +761,7 @@ let state_of_id id =
 
 (****** A cache: fills in the nodes of the VCS document with their value ******)
 module State : sig
-  
+
   (** The function is from unit, so it uses the current state to define
       a new one.  I.e. one may been to install the right state before
       defining a new one.
@@ -683,29 +771,36 @@ module State : sig
     ?safe_id:Stateid.t ->
     ?redefine:bool -> ?cache:Summary.marshallable ->
     ?feedback_processed:bool -> (unit -> unit) -> Stateid.t -> unit
+
   val fix_exn_ref : (Exninfo.iexn -> Exninfo.iexn) ref
 
   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 -> Exninfo.iexn -> Exninfo.iexn
+
   (* to send states across worker/master *)
-  type frozen_state
-  val get_cached : Stateid.t -> frozen_state
-  val same_env : frozen_state -> frozen_state -> bool
+  val get_cached : Stateid.t -> Vernacstate.t
+  val same_env : Vernacstate.t -> Vernacstate.t -> bool
 
   type proof_part
+
   type partial_state =
-    [ `Full of frozen_state
-    | `Proof of Stateid.t * proof_part ]
-  val proof_part_of_frozen : frozen_state -> proof_part
+    [ `Full of Vernacstate.t
+    | `ProofOnly of Stateid.t * proof_part ]
+
+  val proof_part_of_frozen : Vernacstate.t -> proof_part
   val assign : Stateid.t -> partial_state -> unit
 
+  (* Handlers for initial state, prior to document creation. *)
+  val register_root_state : unit -> unit
+  val restore_root_state : unit -> unit
+
   (* Only for internal use to catch problems in parse_sentence, should
      be removed in the state handling refactoring.  *)
   val cur_id : Stateid.t ref
+
 end = struct (* {{{ *)
 
   (* cur_id holds Stateid.dummy in case the last attempt to define a state
@@ -713,31 +808,26 @@ end = struct (* {{{ *)
   let cur_id = ref Stateid.dummy
   let fix_exn_ref = ref (fun x -> x)
 
-  (* helpers *)
-  let freeze_global_state marshallable =
-    { system = States.freeze ~marshallable;
-      proof = Proof_global.freeze ~marshallable;
-      shallow = (marshallable = `Shallow) }
-  let unfreeze_global_state { system; proof } =
-    States.unfreeze system; Proof_global.unfreeze proof
-
-  (* hack to make futures functional *)
-  let () = Future.set_freeze
-    (fun () -> Obj.magic (freeze_global_state `No, !cur_id))
-    (fun t -> let s,i = Obj.magic t in unfreeze_global_state s; cur_id := i)
-  
-  type frozen_state = state
   type proof_part =
-    Proof_global.state * Summary.frozen_bits (* only meta counters *)
+    Proof_global.t *
+    int *                                   (* Evarutil.meta_counter_summary_tag *)
+    int *                                   (* Evd.evar_counter_summary_tag *)
+    Obligations.program_info Names.Id.Map.t (* Obligations.program_tcc_summary_tag *)
+
   type partial_state =
-    [ `Full of frozen_state
-    | `Proof of Stateid.t * proof_part ]
-  let proof_part_of_frozen { proof; system } =
+    [ `Full of Vernacstate.t
+    | `ProofOnly of Stateid.t * proof_part ]
+
+  let proof_part_of_frozen { Vernacstate.proof; system } =
+    let st = States.summary_of_state system in
     proof,
-    Summary.project_summary (States.summary_of_state system) summary_pstate
+    Summary.project_from_summary st Util.(pi1 summary_pstate),
+    Summary.project_from_summary st Util.(pi2 summary_pstate),
+    Summary.project_from_summary st Util.(pi3 summary_pstate)
 
   let freeze marshallable id =
-    VCS.set_state id (Valid (freeze_global_state marshallable))
+    VCS.set_state id (Valid (Vernacstate.freeze_interp_state marshallable))
+
   let freeze_invalid id iexn = VCS.set_state id (Error iexn)
 
   let is_cached ?(cache=`No) id only_valid =
@@ -760,12 +850,16 @@ end = struct (* {{{ *)
   let install_cached 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 
+       Vernacstate.unfreeze_interp_state s;
+       cur_id := id
+
+    | { 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 ()
+        if VCS.is_interactive () = `No && Stateid.equal id !cur_id then ()
         else anomaly Pp.(str "installing a non cached state.")
 
   let get_cached id =
@@ -775,6 +869,7 @@ end = struct (* {{{ *)
     with VCS.Expired -> anomaly Pp.(str "not a cached state (expired).")
 
   let assign id what =
+    let open Vernacstate in
     if VCS.get_state id <> Empty then () else
     try match what with
     | `Full s ->
@@ -782,22 +877,27 @@ end = struct (* {{{ *)
            try
             let prev = (VCS.visit id).next in
             if is_cached_and_valid prev
-            then { s with proof = 
+            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 (Valid s)
-    | `Proof(ontop,(pstate,counters)) ->
+    | `ProofOnly(ontop,(pstate,c1,c2,c3)) ->
          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
            let s = { s with system =
              States.replace_summary s.system
-               (Summary.surgery_summary
-                 (States.summary_of_state s.system)
-               counters) } in
+               begin
+                 let st = States.summary_of_state s.system in
+                 let st = Summary.modify_summary st Util.(pi1 summary_pstate) c1 in
+                 let st = Summary.modify_summary st Util.(pi2 summary_pstate) c2 in
+                 let st = Summary.modify_summary st Util.(pi3 summary_pstate) c3 in
+                 st
+               end
+                } in
            VCS.set_state id (Valid s)
     with VCS.Expired -> ()
 
@@ -810,12 +910,12 @@ end = struct (* {{{ *)
         execution_error ?loc id (iprint (e, info));
         (e, Stateid.add info ~valid id)
 
-  let same_env { system = s1 } { system = s2 } =
+  let same_env { Vernacstate.system = s1 } { Vernacstate.system = s2 } =
     let s1 = States.summary_of_state s1 in
-    let e1 = Summary.project_summary s1 [Global.global_env_summary_name] in
+    let e1 = Summary.project_from_summary s1 Global.global_env_summary_tag in
     let s2 = States.summary_of_state s2 in
-    let e2 = Summary.project_summary s2 [Global.global_env_summary_name] in
-    Summary.pointer_equal e1 e2
+    let e2 = Summary.project_from_summary s2 Global.global_env_summary_tag in
+    e1 == e2
 
   let define ?safe_id ?(redefine=false) ?(cache=`No) ?(feedback_processed=true)
         f id
@@ -855,6 +955,15 @@ end = struct (* {{{ *)
       Hooks.(call unreachable_state id ie);
       Exninfo.iraise ie
 
+  let init_state = ref None
+
+  let register_root_state () =
+    init_state := Some (Vernacstate.freeze_interp_state `No)
+
+  let restore_root_state () =
+    cur_id := Stateid.dummy;
+    Vernacstate.unfreeze_interp_state (Option.get !init_state);
+
 end (* }}} *)
 
 (* indentation code for Show Script, initially contributed
@@ -892,7 +1001,7 @@ let indent_script_item ((ng1,ngl1),nl,beginend,ppl) (cmd,ng) =
   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
+  let ind, nl, new_beginend = match Vernacprop.under_control cmd with
     | VernacSubproof _ -> pred ind, nl, (pred ind)::beginend
     | VernacEndSubproof -> List.hd beginend, false, List.tl beginend
     | VernacBullet _ -> pred ind, nl, beginend
@@ -920,7 +1029,7 @@ let get_script prf =
          find ((x.expr, (VCS.get_info id).n_goals)::acc) view.next
     | `Sideff (CherryPickEnv, 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 
+         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
@@ -948,35 +1057,36 @@ 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 } =
+let stm_vernac_interp ?proof ?route id st { verbose; loc; expr } : Vernacstate.t =
   (* 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 id;
+  set_id_for_feedback ?route dummy_doc 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
+  *)
+  let is_filtered_command = function
+    | VernacResetName _ | VernacResetInitial | VernacBack _
+    | VernacBackTo _ | VernacRestart | VernacUndo _ | VernacUndoTo _
+    | VernacBacktrack _ | VernacAbortAll | VernacAbort _ -> true
+    | _ -> false
   in
-  let aux_interp cmd =
-  if is_filtered_command cmd then
-    stm_pperr_endline Pp.(fun () -> str "ignoring " ++ Ppvernac.pr_vernac expr)
-  else match cmd with
-  | VernacShow ShowScript -> ShowScript.show_script ()
-  | expr ->
-    stm_pperr_endline Pp.(fun () -> str "interpreting " ++ Ppvernac.pr_vernac expr);
-    try Vernacentries.interp ?verbosely:(Some verbose) ?proof (Loc.tag ?loc expr)
-    with e ->
-      let e = CErrors.push e in
-      Exninfo.iraise Hooks.(call_process_error_once e)
-  in aux_interp expr
+  let aux_interp st expr =
+    let cmd = Vernacprop.under_control expr in
+    if is_filtered_command cmd then
+      (stm_pperr_endline Pp.(fun () -> str "ignoring " ++ Ppvernac.pr_vernac expr); st)
+    else
+      match cmd with
+      | VernacShow ShowScript -> ShowScript.show_script (); st (** XX we are ignoring control here *)
+      | _ ->
+        stm_pperr_endline Pp.(fun () -> str "interpreting " ++ Ppvernac.pr_vernac expr);
+        try Vernacentries.interp ?verbosely:(Some verbose) ?proof ~st (Loc.tag ?loc expr)
+        with e ->
+          let e = CErrors.push e in
+          Exninfo.iraise Hooks.(call_process_error_once e)
+  in aux_interp st expr
 
 (****************************** CRUFT *****************************************)
 (******************************************************************************)
@@ -990,8 +1100,8 @@ module Backtrack : sig
   (* we could navigate the dag, but this ways easy *)
   val branches_of : Stateid.t -> backup
 
-  (* To be installed during initialization *)
-  val undo_vernac_classifier : vernac_expr -> vernac_classification
+  (* Returns the state that the command should backtract to *)
+  val undo_vernac_classifier : vernac_control -> Stateid.t * vernac_when
 
 end = struct (* {{{ *)
 
@@ -1039,44 +1149,58 @@ end = struct (* {{{ *)
           match VCS.visit id with
           | { step = `Fork ((_,_,_,l),_) } -> l, false,0
           | { step = `Cmd { cids = l; ctac } } -> l, ctac,0
-          | { step = `Alias (_,{ expr = VernacUndo n}) } -> [], false, n
+          | { step = `Alias (_,{ expr }) } when not (Vernacprop.has_Fail expr) ->
+          begin match Vernacprop.under_control expr with
+                | VernacUndo n -> [], false, n
+                | _ -> [],false,0
+          end
           | _ -> [],false,0 in
         match f acc (id, vcs, ids, tactic, undo) with
         | `Stop x -> x
         | `Cont acc -> next acc
- 
+
+  let undo_costly_in_batch_mode =
+    CWarnings.create ~name:"undo-batch-mode" ~category:"non-interactive" Pp.(fun v ->
+        str "Command " ++ Ppvernac.pr_vernac v ++
+        str (" is not recommended in batch mode. In particular, going back in the document" ^
+             " is not efficient in batch mode due to Coq not caching previous states for memory optimization reasons." ^
+             " If your use is intentional, you may want to disable this warning and pass" ^
+             " the \"-async-proofs-cache force\" option to Coq."))
+
   let undo_vernac_classifier v =
+    if VCS.is_interactive () = `No && !cur_opt.async_proofs_cache <> Some Force
+    then undo_costly_in_batch_mode v;
     try
-      match v with
+      match Vernacprop.under_control v with
       | VernacResetInitial ->
-          VtStm (VtBack Stateid.initial, true), VtNow
-      | VernacResetName (_,name) ->
+          Stateid.initial, VtNow
+      | VernacResetName {CAst.v=name} ->
           let id = VCS.get_branch_pos (VCS.current_branch ()) in
           (try
             let oid =
               fold_until (fun b (id,_,label,_,_) ->
                 if b then `Stop id else `Cont (List.mem name label))
               false id in
-            VtStm (VtBack oid, true), VtNow
+            oid, VtNow
           with Not_found ->
-            VtStm (VtBack id, true), VtNow)
+            id, VtNow)
       | VernacBack n ->
           let id = VCS.get_branch_pos (VCS.current_branch ()) in
           let oid = fold_until (fun n (id,_,_,_,_) ->
             if Int.equal n 0 then `Stop id else `Cont (n-1)) n id in
-          VtStm (VtBack oid, true), VtNow
+          oid, VtNow
       | VernacUndo n ->
           let id = VCS.get_branch_pos (VCS.current_branch ()) in
           let oid = fold_until (fun n (id,_,_,tactic,undo) ->
             let value = (if tactic then 1 else 0) - undo in
             if Int.equal n 0 then `Stop id else `Cont (n-value)) n id in
-          VtStm (VtBack oid, true), VtLater
+          oid, VtLater
       | VernacUndoTo _
       | VernacRestart as e ->
           let m = match e with VernacUndoTo m -> m | _ -> 0 in
           let id = VCS.get_branch_pos (VCS.current_branch ()) in
           let vcs =
-            match (VCS.get_info id).vcs_backup with 
+            match (VCS.get_info id).vcs_backup with
             | None, _ -> anomaly Pp.(str"Backtrack: tip with no vcs_backup.")
             | Some vcs, _ -> vcs in
           let cb, _ =
@@ -1087,17 +1211,17 @@ end = struct (* {{{ *)
             0 id in
           let oid = fold_until (fun n (id,_,_,_,_) ->
             if Int.equal n 0 then `Stop id else `Cont (n-1)) (n-m-1) id in
-          VtStm (VtBack oid, true), VtLater
+          oid, VtLater
       | VernacAbortAll ->
           let id = VCS.get_branch_pos (VCS.current_branch ()) in
           let oid = fold_until (fun () (id,vcs,_,_,_) ->
             match Vcs_.branches vcs with [_] -> `Stop id | _ -> `Cont ())
             () id in
-          VtStm (VtBack oid, true), VtLater
+          oid, VtLater
       | VernacBacktrack (id,_,_)
       | VernacBackTo id ->
-          VtStm (VtBack (Stateid.of_int id), not !Flags.batch_mode), VtNow
-      | _ -> VtUnknown, VtNow
+          Stateid.of_int id, VtNow
+      | _ -> anomaly Pp.(str "incorrect VtMeta classification")
     with
     | Not_found ->
        CErrors.user_err ~hdr:"undo_vernac_classifier"
@@ -1108,18 +1232,15 @@ end (* }}} *)
 let hints = ref Aux_file.empty_aux_file
 let set_compilation_hints file =
   hints := Aux_file.load_aux_file_for file
+
 let get_hint_ctx loc =
   let s = Aux_file.get ?loc !hints "context_used" in
-  match Str.split (Str.regexp ";") s with
-  | ids :: _ ->
-      let ids = List.map Names.Id.of_string (Str.split (Str.regexp " ") ids) in
-      let ids = List.map (fun id -> Loc.tag id) ids in
-      begin match ids with
-      | [] -> SsEmpty
-      | x :: xs ->
-          List.fold_left (fun a x -> SsUnion (SsSingl x,a)) (SsSingl x) xs
-      end
-  | _ -> raise Not_found
+  let ids = List.map Names.Id.of_string (Str.split (Str.regexp " ") s) in
+  let ids = List.map (fun id -> CAst.make id) ids in
+  match ids with
+  | [] -> SsEmpty
+  | x :: xs ->
+    List.fold_left (fun a x -> SsUnion (SsSingl x,a)) (SsSingl x) xs
 
 let get_hint_bp_time proof_name =
   try float_of_string (Aux_file.get !hints proof_name)
@@ -1132,7 +1253,7 @@ let record_pb_time ?loc proof_name time =
     Aux_file.record_in_aux_at proof_name proof_build_time;
     hints := Aux_file.set !hints proof_name proof_build_time
   end
- 
+
 exception RemoteException of Pp.t
 let _ = CErrors.register_handler (function
   | RemoteException ppcmd -> ppcmd
@@ -1143,7 +1264,7 @@ let _ = CErrors.register_handler (function
 
 type document_node = {
   indentation : int;
-  ast : Vernacexpr.vernac_expr;
+  ast : Vernacexpr.vernac_control;
   id : Stateid.t;
 }
 
@@ -1158,11 +1279,11 @@ type static_block_detection =
 type recovery_action = {
   base_state : Stateid.t;
   goals_to_admit : Goal.goal list;
-  recovery_command : Vernacexpr.vernac_expr option;
+  recovery_command : Vernacexpr.vernac_control option;
 }
 
 type dynamic_block_error_recovery =
-  static_block_declaration -> [ `ValidBlock of recovery_action | `Leaks ]
+  doc -> static_block_declaration -> [ `ValidBlock of recovery_action | `Leaks ]
 
 let proof_block_delimiters = ref []
 
@@ -1183,15 +1304,15 @@ let prev_node { 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
+  match !cur_opt.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   
+  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 ())
+     (async_proofs_is_master !cur_opt || Flags.async_proofs_is_worker ())
   then (
   match cur_node id with
   | None -> ()
@@ -1212,7 +1333,7 @@ let detect_proof_block id name =
 (* Unused module warning doesn't understand [module rec] *)
 [@@@ocaml.warning "-60"]
 module rec ProofTask : sig
- 
+
   type competence = Stateid.t list
   type task_build_proof = {
     t_exn_info : Stateid.t * Stateid.t;
@@ -1235,8 +1356,8 @@ module rec ProofTask : sig
 
   include AsyncTaskQueue.Task
   with type task := task
-  and  type competence := competence
-  and  type request := request
+   and type competence := competence
+   and type request := request
 
   val build_proof_here :
     ?loc:Loc.t ->
@@ -1245,7 +1366,7 @@ module rec ProofTask : sig
       Proof_global.closed_proof_output Future.computation
 
   (* If set, only tasks overlapping with this list are processed *)
-  val set_perspective : Stateid.t list -> unit  
+  val set_perspective : Stateid.t list -> unit
 
 end = struct (* {{{ *)
 
@@ -1267,10 +1388,12 @@ end = struct (* {{{ *)
     | BuildProof of task_build_proof
     | States of Stateid.t list
 
+  type worker_status = Fresh | Old of competence
+
   type request =
   | ReqBuildProof of (Future.UUID.t,VCS.vcs) Stateid.request * bool * competence
   | ReqStates of Stateid.t list
-  
+
   type error = {
     e_error_at    : Stateid.t;
     e_safe_id     : Stateid.t;
@@ -1290,10 +1413,10 @@ end = struct (* {{{ *)
 
   let task_match age t =
     match age, t with
-    | `Fresh, BuildProof { t_states } ->
-        not !Flags.async_proofs_full ||
+    | Fresh, BuildProof { t_states } ->
+        not !cur_opt.async_proofs_full ||
         List.exists (fun x -> CList.mem_f Stateid.equal x !perspective) t_states
-    | `Old my_states, States l ->
+    | Old my_states, States l ->
         List.for_all (fun x -> CList.mem_f Stateid.equal x my_states) l
     | _ -> false
 
@@ -1309,7 +1432,7 @@ end = struct (* {{{ *)
     | BuildProof {
         t_exn_info;t_start;t_stop;t_loc;t_uuid;t_name;t_states;t_drop
       } ->
-        assert(age = `Fresh);
+        assert(age = Fresh);
         try Some (ReqBuildProof ({
           Stateid.exn_info = t_exn_info;
           stop = t_stop;
@@ -1319,19 +1442,19 @@ end = struct (* {{{ *)
           name = t_name }, t_drop, t_states))
         with VCS.Expired -> None
 
-  let use_response (s : competence AsyncTaskQueue.worker_status) t r =
+  let use_response (s : worker_status) t r =
     match s, t, r with
-    | `Old c, States _, RespStates l ->
+    | Old c, States _, RespStates l ->
         List.iter (fun (id,s) -> State.assign id s) l; `End
-    | `Fresh, BuildProof { t_assign; t_loc; t_name; t_states; t_drop },
+    | Fresh, BuildProof { t_assign; t_loc; t_name; t_states; t_drop },
               RespBuiltProof (pl, time) ->
         feedback (InProgress ~-1);
         t_assign (`Val pl);
         record_pb_time ?loc:t_loc t_name time;
-        if !Flags.async_proofs_full || t_drop
+        if !cur_opt.async_proofs_full || t_drop
         then `Stay(t_states,[States t_states])
         else `End
-    | `Fresh, BuildProof { t_assign; t_loc; t_name; t_states },
+    | Fresh, BuildProof { t_assign; t_loc; t_name; t_states },
             RespError { e_error_at; e_safe_id = valid; e_msg; e_safe_states } ->
         feedback (InProgress ~-1);
         let info = Stateid.add ~valid Exninfo.null e_error_at in
@@ -1354,7 +1477,7 @@ end = struct (* {{{ *)
   let build_proof_here ?loc ~drop_pt (id,valid) eop =
     Future.create (State.exn_on id ~valid) (fun () ->
       let wall_clock1 = Unix.gettimeofday () in
-      if !Flags.batch_mode then Reach.known_state ~cache:`No eop
+      if VCS.is_interactive () = `No then Reach.known_state ~cache:`No eop
       else Reach.known_state ~cache:`Shallow eop;
       let wall_clock2 = Unix.gettimeofday () in
       Aux_file.record_in_aux_at ?loc "proof_build_time"
@@ -1376,18 +1499,28 @@ end = struct (* {{{ *)
        * the few errors tactics don't catch, like the "fix" tactic building
        * a bad fixpoint *)
       let fix_exn = Future.fix_exn_of future_proof in
+      (* STATE: We use the current installed imperative state *)
+      let st = Vernacstate.freeze_interp_state `No in
       if not drop then begin
-        let checked_proof = Future.chain ~pure:false future_proof (fun p ->
+        let checked_proof = Future.chain future_proof (fun p ->
+
+          (* Unfortunately close_future_proof and friends are not pure so we need
+             to set the state manually here *)
+          Vernacstate.unfreeze_interp_state st;
           let pobject, _ =
             Proof_global.close_future_proof ~feedback_id: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
+
+          let st = Vernacstate.freeze_interp_state `No in
           stm_vernac_interp stop
-            ~proof:(pobject, terminator)
+            ~proof:(pobject, terminator) st
             { verbose = false; loc; indentation = 0; strlen = 0;
-              expr = (VernacEndProof (Proved (Opaque None,None))) }) in
+              expr = VernacExpr ([], VernacEndProof (Proved (Opaque,None))) }) in
         ignore(Future.join checked_proof);
       end;
+      (* STATE: Restore the state XXX: handle exn *)
+      Vernacstate.unfreeze_interp_state st;
       RespBuiltProof(proof,time)
     with
     | e when CErrors.noncritical e || e = Stack_overflow ->
@@ -1404,11 +1537,11 @@ end = struct (* {{{ *)
 
   let perform_states query =
     if query = [] then [] else
-    let is_tac e = match classify_vernac e with
+    let is_tac e = match Vernac_classifier.classify_vernac e with
     | VtProofStep _, _ -> true
     | _ -> false
     in
-    let initial = 
+    let initial =
       let rec aux id =
         try match VCS.visit id with { next } -> aux next
         with VCS.Expired -> id in
@@ -1421,13 +1554,13 @@ end = struct (* {{{ *)
           then Some (prev, State.get_cached prev, step)
           else None
         with VCS.Expired -> None in
-      let this = 
+      let this =
         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 (id, `ProofOnly (prev, State.proof_part_of_frozen n))
       | Some _, Some s ->
           msg_debug (Pp.str "STM: sending back a fat state");
           Some (id, `Full s)
@@ -1445,12 +1578,13 @@ end = struct (* {{{ *)
     | ReqStates sl -> RespStates (perform_states sl)
 
   let on_marshal_error s = function
-    | States _ -> msg_error(Pp.strbrk("Marshalling error: "^s^". "^
-        "The system state could not be sent to the master process."))
+    | States _ ->
+      msg_warning Pp.(strbrk("Marshalling error: "^s^". "^
+                             "The system state could not be sent to the master process."))
     | BuildProof { t_exn_info; t_stop; t_assign; t_loc; t_drop = drop_pt } ->
-      msg_error(Pp.strbrk("Marshalling error: "^s^". "^
-        "The system state could not be sent to the worker process. "^
-        "Falling back to local, lazy, evaluation."));
+      msg_warning Pp.(strbrk("Marshalling error: "^s^". "^
+                             "The system state could not be sent to the worker process. "^
+                             "Falling back to local, lazy, evaluation."));
       t_assign(`Comp(build_proof_here ?loc:t_loc ~drop_pt t_exn_info t_stop));
       feedback (InProgress ~-1)
 
@@ -1463,11 +1597,11 @@ and Slaves : sig
   val build_proof :
     ?loc:Loc.t -> drop_pt:bool ->
     exn_info:(Stateid.t * Stateid.t) -> block_start:Stateid.t -> block_stop:Stateid.t ->
-      name:string -> future_proof * cancel_switch
+      name:string -> future_proof * AsyncTaskQueue.cancel_switch
 
   (* blocking function that waits for the task queue to be empty *)
   val wait_all_done : unit -> unit
-  
+
   (* initialize the whole machinery (optional) *)
   val init : unit -> unit
 
@@ -1488,13 +1622,12 @@ and Slaves : sig
 
 end = struct (* {{{ *)
 
-  module TaskQueue = AsyncTaskQueue.MakeQueue(ProofTask)
-  
-  let queue = ref None
+  module TaskQueue = AsyncTaskQueue.MakeQueue(ProofTask) ()
 
+  let queue = ref None
   let init () =
-    if Flags.async_proofs_is_master () then
-      queue := Some (TaskQueue.create !Flags.async_proofs_n_workers)
+    if async_proofs_is_master !cur_opt then
+      queue := Some (TaskQueue.create !cur_opt.async_proofs_n_workers)
     else
       queue := Some (TaskQueue.create 0)
 
@@ -1523,36 +1656,43 @@ 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;
-      stm_vernac_interp stop ~proof
+      (* STATE SPEC:
+       * - start: First non-expired state! [This looks very fishy]
+       * - end  : start + qed
+       * => takes nothing from the itermediate states.
+       *)
+      (* STATE We use the state resulting from reaching start. *)
+      let st = Vernacstate.freeze_interp_state `No in
+      ignore(stm_vernac_interp stop ~proof st
         { verbose = false; loc; indentation = 0; strlen = 0;
-          expr = (VernacEndProof (Proved (Opaque None,None))) };
+          expr = VernacExpr ([], VernacEndProof (Proved (Opaque,None))) });
       `OK proof
       end
     with e ->
       let (e, info) = CErrors.push e in
       (try match Stateid.get info with
       | None ->
-          msg_error Pp.(
+        msg_warning Pp.(
             str"File " ++ str name ++ str ": proof of " ++ str r_name ++
             spc () ++ iprint (e, info))
       | Some (_, cur) ->
           match VCS.visit cur with
           | { step = `Cmd { cast = { loc } } }
-          | { step = `Fork (( { loc }, _, _, _), _) } 
-          | { step = `Qed ( { qast = { loc } }, _) } 
+          | { step = `Fork (( { loc }, _, _, _), _) }
+          | { step = `Qed ( { qast = { loc } }, _) }
           | { step = `Sideff (ReplayCommand { loc }, _) } ->
               let start, stop = Option.cata Loc.unloc (0,0) loc in
-              msg_error Pp.(
+              msg_warning Pp.(
                 str"File " ++ str name ++ str ": proof of " ++ str r_name ++
                 str ": chars " ++ int start ++ str "-" ++ int stop ++
                 spc () ++ iprint (e, info))
           | _ ->
-              msg_error Pp.(
+              msg_warning Pp.(
                 str"File " ++ str name ++ str ": proof of " ++ str r_name ++
                 spc () ++ iprint (e, info))
     with e ->
-      msg_error Pp.(str"unable to print error message: " ++
-                    str (Printexc.to_string e)));
+      msg_warning Pp.(str"unable to print error message: " ++
+                      str (Printexc.to_string e)));
       if drop then `ERROR_ADMITTED else `ERROR
 
   let finish_task name (u,cst,_) d p l i =
@@ -1581,16 +1721,15 @@ end = struct (* {{{ *)
         let pr =
           Future.from_val (map (Option.get (Global.body_of_constant_body c))) in
         let uc =
-          Future.chain
-            ~pure:true uc Univ.hcons_universe_context_set in
-        let pr = Future.chain ~pure:true pr discharge in
-        let pr = Future.chain ~pure:true pr Constr.hcons in
+          Future.chain uc Univ.hcons_universe_context_set in
+        let pr = Future.chain pr discharge in
+        let pr = Future.chain pr Constr.hcons in
         Future.sink pr;
         let extra = Future.join uc in
         u.(bucket) <- uc;
         p.(bucket) <- pr;
         u, Univ.ContextSet.union cst extra, false
-  
+
   let check_task name l i =
     match check_task_aux "" name l i with
     | `OK _ | `OK_ADMITTED -> true
@@ -1627,7 +1766,7 @@ end = struct (* {{{ *)
     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
-      if !Flags.compilation_mode = Flags.BuildVio then begin
+      if VCS.is_vio_doc () then begin
         let f,assign =
          Future.create_delegate ~blocking:true ~name:pname (State.exn_on id ~valid) in
         let t_uuid = Future.uuid f in
@@ -1635,11 +1774,11 @@ end = struct (* {{{ *)
           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 ~block_start ~block_stop }) in
-        TaskQueue.enqueue_task (Option.get !queue) (task,cancel_switch);
+        TaskQueue.enqueue_task (Option.get !queue) task ~cancel_switch;
         f, cancel_switch
       end else
         ProofTask.build_proof_here ?loc ~drop_pt t_exn_info block_stop, cancel_switch
-    else 
+    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);
@@ -1647,7 +1786,7 @@ end = struct (* {{{ *)
         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 ~block_start ~block_stop }) in
-      TaskQueue.enqueue_task (Option.get !queue) (task,cancel_switch);
+      TaskQueue.enqueue_task (Option.get !queue) task ~cancel_switch;
       f, cancel_switch
 
   let wait_all_done () = TaskQueue.join (Option.get !queue)
@@ -1661,7 +1800,7 @@ end = struct (* {{{ *)
     let reqs =
       CList.map_filter
         ProofTask.(fun x ->
-             match request_of_task `Fresh x with
+             match request_of_task Fresh x with
              | Some (ReqBuildProof (r, b, _)) -> Some(r, b)
              | _ -> None)
         tasks in
@@ -1674,7 +1813,7 @@ end (* }}} *)
 
 and TacTask : sig
 
-  type output = (Constr.constr * Evd.evar_universe_context) option
+  type output = (Constr.constr * UState.t) option
   type task = {
     t_state    : Stateid.t;
     t_state_fb : Stateid.t;
@@ -1682,14 +1821,14 @@ and TacTask : sig
     t_ast      : int * aast;
     t_goal     : Goal.goal;
     t_kill     : unit -> unit;
-    t_name     : string }  
+    t_name     : string }
 
   include AsyncTaskQueue.Task with type task := task
 
 end = struct (* {{{ *)
 
-  type output = (Constr.constr * Evd.evar_universe_context) option
-  
+  type output = (Constr.constr * UState.t) option
+
   let forward_feedback msg = Hooks.(call forward_feedback msg)
 
   type task = {
@@ -1699,7 +1838,7 @@ end = struct (* {{{ *)
     t_ast      : int * aast;
     t_goal     : Goal.goal;
     t_kill     : unit -> unit;
-    t_name     : string }  
+    t_name     : string }
 
   type request = {
     r_state    : Stateid.t;
@@ -1710,13 +1849,15 @@ end = struct (* {{{ *)
     r_name     : string }
 
   type response =
-    | RespBuiltSubProof of (Constr.constr * Evd.evar_universe_context)
+    | RespBuiltSubProof of (Constr.constr * UState.t)
     | RespError of Pp.t
     | RespNoProgress
 
   let name = ref "tacworker"
   let extra_env () = [||]
   type competence = unit
+  type worker_status = Fresh | Old of competence
+
   let task_match _ _ = true
 
   (* run by the master, on a thread *)
@@ -1725,13 +1866,13 @@ end = struct (* {{{ *)
       r_state    = t_state;
       r_state_fb = t_state_fb;
       r_document =
-        if age <> `Fresh then None
+        if age <> Fresh then None
         else Some (VCS.slice ~block_start:t_state ~block_stop:t_state);
       r_ast      = t_ast;
       r_goal     = t_goal;
       r_name     = t_name }
     with VCS.Expired -> None
-          
+
   let use_response _ { t_assign; t_state; t_state_fb; t_kill } resp =
     match resp with
     | RespBuiltSubProof o -> t_assign (`Val (Some o)); `Stay ((),[])
@@ -1744,7 +1885,7 @@ end = struct (* {{{ *)
         t_assign (`Exn e);
         t_kill ();
         `Stay ((),[])
-                    
+
   let on_marshal_error err { t_name } =
     stm_pr_err ("Fatal marshal error: " ^ t_name );
     flush_all (); exit 1
@@ -1752,7 +1893,7 @@ end = struct (* {{{ *)
   let on_task_cancellation_or_expiration_or_slave_death = function
     | Some { t_kill } -> t_kill ()
     | _ -> ()
- 
+
   let command_focus = Proof.new_focus_kind ()
   let focus_cond = Proof.no_cond command_focus
 
@@ -1760,7 +1901,7 @@ end = struct (* {{{ *)
     Option.iter VCS.restore vcs;
     try
       Reach.known_state ~cache:`No id;
-      Future.purify (fun () ->
+      stm_purify (fun () ->
        let _,_,_,_,sigma0 = Proof.proof (Proof_global.give_me_the_proof ()) in
        let g = Evd.find sigma0 r_goal in
        let is_ground c = Evarutil.is_ground_term sigma0 (EConstr.of_constr c) in
@@ -1774,7 +1915,14 @@ end = struct (* {{{ *)
        else begin
         let (i, ast) = r_ast in
         Proof_global.simple_with_current_proof (fun _ p -> Proof.focus focus_cond () i p);
-        stm_vernac_interp r_state_fb ast;
+        (* STATE SPEC:
+         * - start : id
+         * - return: id
+         * => captures state id in a future closure, which will
+           discard execution state but for the proof + univs.
+        *)
+        let st = Vernacstate.freeze_interp_state `No in
+        ignore(stm_vernac_interp r_state_fb st ast);
         let _,_,_,_,sigma = Proof.proof (Proof_global.give_me_the_proof ()) in
         match Evd.(evar_body (find sigma r_goal)) with
         | Evd.Evar_empty -> RespNoProgress
@@ -1790,31 +1938,32 @@ end = struct (* {{{ *)
 
   let name_of_task { t_name } = t_name
   let name_of_request { r_name } = r_name
-  
+
 end (* }}} *)
 
 and Partac : sig
 
   val vernac_interp :
-    solve:bool -> abstract:bool -> cancel_switch ->
-    int -> Stateid.t -> Stateid.t -> aast ->
-      unit
+    solve:bool -> abstract:bool -> cancel_switch:AsyncTaskQueue.cancel_switch ->
+    int -> Stateid.t -> Stateid.t -> aast -> unit
 
 end = struct (* {{{ *)
-    
-  module TaskQueue = AsyncTaskQueue.MakeQueue(TacTask)
 
-  let vernac_interp ~solve ~abstract cancel nworkers safe_id id
+  module TaskQueue = AsyncTaskQueue.MakeQueue(TacTask) ()
+
+  let vernac_interp ~solve ~abstract ~cancel_switch nworkers safe_id id
     { indentation; verbose; loc; expr = e; strlen }
   =
-    let e, time, fail =
-      let rec find ~time ~fail = function
-        | VernacTime (_,e) -> find ~time:true ~fail e
-        | VernacRedirect (_,(_,e)) -> find ~time ~fail e
-        | VernacFail e -> find ~time ~fail:true e
-        | e -> e, time, fail in find ~time:false ~fail:false e in
-    Vernacentries.with_fail fail (fun () ->
-    (if time then System.with_time !Flags.time else (fun x -> x)) (fun () ->
+    let e, time, batch, fail =
+      let rec find ~time ~batch ~fail = function
+        | VernacTime (batch,{CAst.v=e}) -> find ~time:true ~batch ~fail e
+        | VernacRedirect (_,{CAst.v=e}) -> find ~time ~batch ~fail e
+        | VernacFail e -> find ~time ~batch ~fail:true e
+        | e -> e, time, batch, fail in
+      find ~time:false ~batch:false ~fail:false e in
+    let st = Vernacstate.freeze_interp_state `No in
+    Vernacentries.with_fail st fail (fun () ->
+    (if time then System.with_time ~batch else (fun x -> x)) (fun () ->
     ignore(TaskQueue.with_n_workers nworkers (fun queue ->
     Proof_global.with_current_proof (fun _ p ->
       let goals, _, _, _, _ = Proof.proof p in
@@ -1827,10 +1976,10 @@ end = struct (* {{{ *)
         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_state = safe_id; t_state_fb = id;
             t_assign = assign; t_ast; t_goal = g; t_name;
-            t_kill = (fun () -> if solve then TaskQueue.cancel_all queue) },
-           cancel);
+            t_kill = (fun () -> if solve then TaskQueue.cancel_all queue) }
+           ~cancel_switch;
         g,f)
         1 goals in
       TaskQueue.join queue;
@@ -1849,9 +1998,10 @@ end = struct (* {{{ *)
           let open Notations in
           match Future.join f with
           | Some (pt, uc) ->
+            let sigma, env = Pfedit.get_current_context () in
             stm_pperr_endline (fun () -> hov 0 (
               str"g=" ++ int (Evar.repr gid) ++ spc () ++
-              str"t=" ++ (Printer.pr_constr pt) ++ spc () ++
+              str"t=" ++ (Printer.pr_constr_env env sigma pt) ++ spc () ++
               str"uc=" ++ Termops.pr_evar_universe_context uc));
             (if abstract then Tactics.tclABSTRACT None else (fun x -> x))
               (V82.tactic (Refiner.tclPUSHEVARUNIVCONTEXT uc) <*>
@@ -1861,7 +2011,7 @@ end = struct (* {{{ *)
         end)
       in
       Proof.run_tactic (Global.env()) assign_tac p)))) ())
-  
+
 end (* }}} *)
 
 and QueryTask : sig
@@ -1870,10 +2020,10 @@ and QueryTask : sig
   include AsyncTaskQueue.Task with type task := task
 
 end = struct (* {{{ *)
-  
+
   type task =
     { t_where : Stateid.t; t_for : Stateid.t ; t_what : aast }
-  
+
   type request =
     { r_where : Stateid.t ; r_for : Stateid.t ; r_what : aast; r_doc : VCS.vcs }
   type response = unit
@@ -1881,6 +2031,8 @@ end = struct (* {{{ *)
   let name = ref "queryworker"
   let extra_env _ = [||]
   type competence = unit
+  type worker_status = Fresh | Old of competence
+
   let task_match _ _ = true
 
   let request_of_task _ { t_where; t_what; t_for } =
@@ -1890,7 +2042,7 @@ end = struct (* {{{ *)
       r_doc   = VCS.slice ~block_start:t_where ~block_stop:t_where;
       r_what  = t_what }
     with VCS.Expired -> None
-  
+
   let use_response _ _ _ = `End
 
   let on_marshal_error _ _ =
@@ -1898,44 +2050,50 @@ end = struct (* {{{ *)
     flush_all (); exit 1
 
   let on_task_cancellation_or_expiration_or_slave_death _ = ()
-  
+
   let forward_feedback msg = Hooks.(call forward_feedback msg)
 
   let perform { r_where; r_doc; r_what; r_for } =
     VCS.restore r_doc;
     VCS.print ();
     Reach.known_state ~cache:`No r_where;
+    (* STATE *)
+    let st = Vernacstate.freeze_interp_state `No in
     try
-      stm_vernac_interp r_for { r_what with verbose = true };
+      (* STATE SPEC:
+       * - start: r_where
+       * - end  : after execution of r_what
+       *)
+      ignore(stm_vernac_interp r_for st { r_what with verbose = true });
       feedback ~id:r_for Processed
     with e when CErrors.noncritical e ->
       let e = CErrors.push e in
       let msg = iprint e     in
       feedback ~id: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)
 
 end (* }}} *)
 
-and Query : sig 
+and Query : sig
 
   val init : unit -> unit
-  val vernac_interp : cancel_switch -> Stateid.t ->  Stateid.t -> aast -> unit
+  val vernac_interp : cancel_switch:AsyncTaskQueue.cancel_switch -> Stateid.t ->  Stateid.t -> aast -> unit
 
 end = struct (* {{{ *)
 
-  module TaskQueue = AsyncTaskQueue.MakeQueue(QueryTask)
+  module TaskQueue = AsyncTaskQueue.MakeQueue(QueryTask) ()
 
   let queue = ref None
 
-  let vernac_interp switch prev id q =
+  let vernac_interp ~cancel_switch prev id q =
     assert(TaskQueue.n_workers (Option.get !queue) > 0);
     TaskQueue.enqueue_task (Option.get !queue)
-      QueryTask.({ t_where = prev; t_for = id; t_what = q }, switch)
+      QueryTask.({ t_where = prev; t_for = id; t_what = q }) ~cancel_switch
 
   let init () = queue := Some (TaskQueue.create
-    (if !Flags.async_proofs_full then 1 else 0))
+    (if !cur_opt.async_proofs_full then 1 else 0))
 
 end (* }}} *)
 
@@ -1947,21 +2105,18 @@ and Reach : sig
 
 end = struct (* {{{ *)
 
-let pstate = summary_pstate
-
 let async_policy () =
-  let open Flags in
-  if is_universe_polymorphism () then false
-  else if interactive () = `Yes then
-    (async_proofs_is_master () || !async_proofs_mode = APonLazy)
+  if Flags.is_universe_polymorphism () then false
+  else if VCS.is_interactive () = `Yes then
+    (async_proofs_is_master !cur_opt || !cur_opt.async_proofs_mode = APonLazy)
   else
-    (!compilation_mode = BuildVio || !async_proofs_mode <> APoff)
+    (VCS.is_vio_doc () || !cur_opt.async_proofs_mode <> APoff)
 
 let delegate name =
-     get_hint_bp_time name >= !Flags.async_proofs_delegation_threshold
-  || !Flags.compilation_mode = Flags.BuildVio
-  || !Flags.async_proofs_full
- 
+     get_hint_bp_time name >= !cur_opt.async_proofs_delegation_threshold
+  || VCS.is_vio_doc ()
+  || !cur_opt.async_proofs_full
+
 let warn_deprecated_nested_proofs =
   CWarnings.create ~name:"deprecated-nested-proofs" ~category:"deprecated"
          (fun () ->
@@ -1975,88 +2130,107 @@ let collect_proof keep cur hd brkind id =
    | [] -> no_name
    | id :: _ -> Names.Id.to_string id in
  let loc = (snd cur).loc in
- let rec is_defined_expr = function
-   | VernacEndProof (Proved ((Transparent|Opaque (Some _)),_)) -> true
-   | VernacTime (_, e) -> is_defined_expr e
-   | VernacRedirect (_, (_, e)) -> is_defined_expr e
-   | VernacTimeout (_, e) -> is_defined_expr e
+ let is_defined_expr = function
+   | VernacEndProof (Proved (Transparent,_)) -> true
    | _ -> false in
  let is_defined = function
-   | _, { expr = e } -> is_defined_expr e in
+   | _, { expr = e } -> is_defined_expr (Vernacprop.under_control e)
+                        && (not (Vernacprop.has_Fail e)) in
+ let proof_using_ast = function
+   | VernacProof(_,Some _) -> true
+   | _ -> false
+ in
  let proof_using_ast = function
-   | Some (_, ({ expr = VernacProof(_,Some _) } as v)) -> Some v
+   | Some (_, v) when proof_using_ast (Vernacprop.under_control v.expr)
+                      && (not (Vernacprop.has_Fail v.expr)) -> Some v
    | _ -> None in
  let has_proof_using x = proof_using_ast x <> None in
  let proof_no_using = function
-   | Some (_, ({ expr = VernacProof(t,None) } as v)) -> t,v
+   | VernacProof(t,None) -> t
+   | _ -> assert false
+ in
+ let proof_no_using = function
+   | Some (_, v) -> proof_no_using (Vernacprop.under_control v.expr), v
    | _ -> assert false in
  let has_proof_no_using = function
-   | Some (_, { expr = VernacProof(_,None) }) -> true
+   | VernacProof(_,None) -> true
+   | _ -> false
+ in
+ let has_proof_no_using = function
+   | Some (_, v) -> has_proof_no_using (Vernacprop.under_control v.expr)
+                    && (not (Vernacprop.has_Fail v.expr))
    | _ -> false in
  let too_complex_to_delegate = function
-   | { expr = (VernacDeclareModule _
-              | VernacDefineModule _
-              | VernacDeclareModuleType _
-              | VernacInclude _) } -> true
-   | { expr =  (VernacRequire _ | VernacImport _) } -> true
+   | VernacDeclareModule _
+   | VernacDefineModule _
+   | VernacDeclareModuleType _
+   | VernacInclude _
+   | VernacRequire _
+   | VernacImport _ -> true
    | ast -> may_pierce_opaque ast in
  let parent = function Some (p, _) -> p | None -> assert false in
- let is_empty = function `Async(_,_,[],_,_) | `MaybeASync(_,_,[],_,_) -> true | _ -> false in
+ let is_empty = function `Async(_,[],_,_) | `MaybeASync(_,[],_,_) -> true | _ -> false in
  let rec collect last accn id =
     let view = VCS.visit id in
     match view.step with
     | (`Sideff (ReplayCommand x,_) | `Cmd { cast = x })
-      when too_complex_to_delegate x -> `Sync(no_name,None,`Print)
+      when too_complex_to_delegate (Vernacprop.under_control x.expr) ->
+       `Sync(no_name,`Print)
     | `Cmd { cast = x } -> collect (Some (id,x)) (id::accn) view.next
     | `Sideff (ReplayCommand x,_) -> collect (Some (id,x)) (id::accn) view.next
     (* An Alias could jump everywhere... we hope we can ignore it*)
-    | `Alias _ -> `Sync (no_name,None,`Alias)
+    | `Alias _ -> `Sync (no_name,`Alias)
     | `Fork((_,_,_,_::_::_), _) ->
-        `Sync (no_name,proof_using_ast last,`MutualProofs)
+        `Sync (no_name,`MutualProofs)
     | `Fork((_,_,Doesn'tGuaranteeOpacity,_), _) ->
-        `Sync (no_name,proof_using_ast last,`Doesn'tGuaranteeOpacity)
+        `Sync (no_name,`Doesn'tGuaranteeOpacity)
     | `Fork((_,hd',GuaranteesOpacity,ids), _) when has_proof_using last ->
         assert (VCS.Branch.equal hd hd' || VCS.Branch.equal hd VCS.edit_branch);
         let name = name ids in
-        `ASync (parent last,proof_using_ast last,accn,name,delegate name)
+        `ASync (parent last,accn,name,delegate name)
     | `Fork((_, hd', GuaranteesOpacity, ids), _) when
        has_proof_no_using last && not (State.is_cached_and_valid (parent last)) &&
-       !Flags.compilation_mode = Flags.BuildVio ->
+       VCS.is_vio_doc () ->
         assert (VCS.Branch.equal hd hd'||VCS.Branch.equal hd VCS.edit_branch);
         (try
           let name, hint = name ids, get_hint_ctx loc  in
           let t, v = proof_no_using last in
-          v.expr <- VernacProof(t, Some hint);
-          `ASync (parent last,proof_using_ast last,accn,name,delegate name)
+          v.expr <- VernacExpr([], VernacProof(t, Some hint));
+          `ASync (parent last,accn,name,delegate name)
         with Not_found ->
           let name = name ids in
-          `MaybeASync (parent last, None, accn, name, delegate name))
+          `MaybeASync (parent last, accn, name, delegate name))
     | `Fork((_, hd', GuaranteesOpacity, ids), _) ->
         assert (VCS.Branch.equal hd hd' || VCS.Branch.equal hd VCS.edit_branch);
         let name = name ids in
-        `MaybeASync (parent last, None, accn, name, delegate name)
+        `MaybeASync (parent last, accn, name, delegate name)
     | `Sideff _ ->
        warn_deprecated_nested_proofs ();
-        `Sync (no_name,None,`NestedProof)
-    | _ -> `Sync (no_name,None,`Unknown) in
+        `Sync (no_name,`NestedProof)
+    | _ -> `Sync (no_name,`Unknown) in
  let make_sync why = function
-   | `Sync(name,pua,_) -> `Sync (name,pua,why)
-   | `MaybeASync(_,pua,_,name,_) -> `Sync (name,pua,why)
-   | `ASync(_,pua,_,name,_) -> `Sync (name,pua,why) in
+   | `Sync(name,_) -> `Sync (name,why)
+   | `MaybeASync(_,_,name,_) -> `Sync (name,why)
+   | `ASync(_,_,name,_) -> `Sync (name,why) in
+
  let check_policy rc = if async_policy () then rc else make_sync `Policy rc in
+ let is_vernac_exact = function
+   | VernacExactProof _ -> true
+   | _ -> false
+ in
  match cur, (VCS.visit id).step, brkind with
- | (parent, { expr = VernacExactProof _ }), `Fork _, _
- | (parent, { expr = VernacTime (_, VernacExactProof _) }), `Fork _, _ ->
-     `Sync (no_name,None,`Immediate)
+ | (parent, x), `Fork _, _ when is_vernac_exact (Vernacprop.under_control x.expr)
+                                && (not (Vernacprop.has_Fail x.expr)) ->
+     `Sync (no_name,`Immediate)
  | _, _, { VCS.kind = `Edit _ }  -> check_policy (collect (Some cur) [] id)
  | _ ->
-     if is_defined cur then `Sync (no_name,None,`Transparent)
-     else if keep == VtDrop then `Sync (no_name,None,`Aborted)
+     if is_defined cur then `Sync (no_name,`Transparent)
+     else if keep == VtDrop then `Sync (no_name,`Aborted)
      else
        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_and_valid id) || !Flags.async_proofs_full)
+          (not(State.is_cached_and_valid id) || !cur_opt.async_proofs_full)
        then check_policy rc
        else make_sync `AlreadyEvaluated rc
 
@@ -2086,7 +2260,7 @@ 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
@@ -2104,7 +2278,7 @@ let known_state ?(redefine_qed=false) ~cache id =
       let decl, name = List.hd valid_boxes in
       try
         let _, dynamic_check = List.assoc name !proof_block_delimiters in
-        match dynamic_check decl with
+        match dynamic_check dummy_doc decl with
         | `Leaks -> Exninfo.iraise exn
         | `ValidBlock { base_state; goals_to_admit; recovery_command } -> begin
            let tac =
@@ -2114,14 +2288,20 @@ let known_state ?(redefine_qed=false) ~cache id =
              Proofview.give_up else Proofview.tclUNIT ()
               end in
            match (VCS.get_info base_state).state with
-           | Valid { proof } ->
+           | Valid { Vernacstate.proof } ->
                Proof_global.unfreeze proof;
                Proof_global.with_current_proof (fun _ p ->
                  feedback ~id:id Feedback.AddedAxiom;
                  fst (Pfedit.solve Vernacexpr.SelectAll None tac p), ());
-               Option.iter (fun expr -> stm_vernac_interp id {
+               (* STATE SPEC:
+                * - start: Modifies the input state adding a proof.
+                * - end  : maybe after recovery command.
+               *)
+               (* STATE: We use an updated state with proof *)
+               let st = Vernacstate.freeze_interp_state `No in
+               Option.iter (fun expr -> ignore(stm_vernac_interp id st {
                   verbose = true; loc = None; expr; indentation = 0;
-                  strlen = 0 })
+                  strlen = 0 } ))
                recovery_command
            | _ -> assert false
         end
@@ -2132,9 +2312,9 @@ let known_state ?(redefine_qed=false) ~cache id =
 
   (* 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)
+    if !cur_opt.async_proofs_tac_error_resilience = `None ||
+       (async_proofs_is_master !cur_opt &&
+        !cur_opt.async_proofs_mode = APoff)
     then f ()
     else
       try f ()
@@ -2143,9 +2323,9 @@ let known_state ?(redefine_qed=false) ~cache id =
         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)
+    if not !cur_opt.async_proofs_cmd_error_resilience ||
+       (async_proofs_is_master !cur_opt &&
+        !cur_opt.async_proofs_mode = APoff)
     then f x
     else
       try f x
@@ -2154,15 +2334,21 @@ let known_state ?(redefine_qed=false) ~cache id =
   (* ugly functions to process nested lemmas, i.e. hard to reproduce
    * side effects *)
   let cherry_pick_non_pstate () =
-    Summary.freeze_summary ~marshallable:`No ~complement:true pstate,
-    Lib.freeze ~marshallable:`No in
+    let st = Summary.freeze_summaries ~marshallable:`No in
+    let st = Summary.remove_from_summary st Util.(pi1 summary_pstate) in
+    let st = Summary.remove_from_summary st Util.(pi2 summary_pstate) in
+    let st = Summary.remove_from_summary st Util.(pi3 summary_pstate) in
+    st, Lib.freeze ~marshallable:`No in
+
   let inject_non_pstate (s,l) =
-    Summary.unfreeze_summary s; Lib.unfreeze l; update_global_env ()
+    Summary.unfreeze_summaries ~partial:true s; Lib.unfreeze l; update_global_env ()
   in
-  let rec pure_cherry_pick_non_pstate safe_id id = Future.purify (fun id ->
-    stm_prerr_endline (fun () -> "cherry-pick non pstate " ^ Stateid.to_string id);
-    reach ~safe_id id;
-    cherry_pick_non_pstate ()) id
+  let rec pure_cherry_pick_non_pstate safe_id id =
+    stm_purify (fun id ->
+        stm_prerr_endline (fun () -> "cherry-pick non pstate " ^ Stateid.to_string id);
+        reach ~safe_id id;
+        cherry_pick_non_pstate ())
+      id
 
   (* traverses the dag backward from nodes being already calculated *)
   and reach ?safe_id ?(redefine_qed=false) ?(cache=cache) id =
@@ -2180,41 +2366,49 @@ 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 (solve,abstract,cancel); cblock } ->
+      | `Cmd { cast = x; cqueue = `TacQueue (solve,abstract,cancel_switch); cblock } ->
           (fun () ->
             resilient_tactic id cblock (fun () ->
               reach ~cache:`Shallow view.next;
-              Partac.vernac_interp ~solve ~abstract
-                cancel !Flags.async_proofs_n_tacworkers view.next id x)
+              Partac.vernac_interp ~solve ~abstract ~cancel_switch
+                !cur_opt.async_proofs_n_tacworkers view.next id x)
           ), cache, true
-      | `Cmd { cast = x; cqueue = `QueryQueue cancel }
-        when Flags.async_proofs_is_master () -> (fun () ->
+      | `Cmd { cast = x; cqueue = `QueryQueue cancel_switch }
+        when async_proofs_is_master !cur_opt -> (fun () ->
             reach view.next;
-            Query.vernac_interp cancel view.next id x
+            Query.vernac_interp ~cancel_switch view.next id x
           ), cache, false
       | `Cmd { cast = x; ceff = eff; ctac = true; cblock } -> (fun () ->
             resilient_tactic id cblock (fun () ->
               reach view.next;
-              stm_vernac_interp id x);
+              (* State resulting from reach *)
+              let st = Vernacstate.freeze_interp_state `No in
+              ignore(stm_vernac_interp id st x)
+            );
 	    if eff then update_global_env ()
           ), (if eff then `Yes else cache), true
       | `Cmd { cast = x; ceff = eff } -> (fun () ->
-          (match !Flags.async_proofs_mode with
-           | Flags.APon | Flags.APonLazy ->
+          (match !cur_opt.async_proofs_mode with
+           | APon | APonLazy ->
              resilient_command reach view.next
-           | Flags.APoff -> reach view.next);
-          stm_vernac_interp id x;
+           | APoff -> reach view.next);
+          let st = Vernacstate.freeze_interp_state `No in
+          ignore(stm_vernac_interp id st x);
           if eff then update_global_env ()
         ), (if eff then `Yes else cache), true
       | `Fork ((x,_,_,_), None) -> (fun () ->
             resilient_command reach view.next;
-            stm_vernac_interp id x;
+            let st = Vernacstate.freeze_interp_state `No in
+            ignore(stm_vernac_interp id st x);
             wall_clock_last_fork := Unix.gettimeofday ()
           ), `Yes, true
       | `Fork ((x,_,_,_), Some prev) -> (fun () -> (* nested proof *)
             reach ~cache:`Shallow prev;
             reach view.next;
-            (try stm_vernac_interp id x;
+
+            (try
+               let st = Vernacstate.freeze_interp_state `No in
+               ignore(stm_vernac_interp id st x);
             with e when CErrors.noncritical e ->
               let (e, info) = CErrors.push e in
               let info = Stateid.add info ~valid:prev id in
@@ -2223,7 +2417,7 @@ let known_state ?(redefine_qed=false) ~cache id =
           ), `Yes, true
       | `Qed ({ qast = x; keep; brinfo; brname } as qed, eop) ->
           let rec aux = function
-          | `ASync (block_start, pua, nodes, name, delegate) -> (fun () ->
+          | `ASync (block_start, nodes, name, delegate) -> (fun () ->
                 assert(keep == VtKeep || keep == VtKeepAsAxiom);
                 let drop_pt = keep == VtKeepAsAxiom in
                 let block_stop, exn_info, loc = eop, (id, eop), x.loc in
@@ -2234,7 +2428,7 @@ let known_state ?(redefine_qed=false) ~cache id =
                 | { VCS.kind = `Edit (_,_,_, okeep, _) }, Some (ofp, cancel) ->
                     assert(redefine_qed = true);
                     if okeep != keep then
-                      msg_error(strbrk("The command closing the proof changed. "
+                      msg_warning(strbrk("The command closing the proof changed. "
                         ^"The kernel cannot take this into account and will "
                         ^(if keep == VtKeep then "not check " else "reject ")
                         ^"the "^(if keep == VtKeep then "new" else "incomplete")
@@ -2264,16 +2458,20 @@ let known_state ?(redefine_qed=false) ~cache id =
                       Proof_global.close_future_proof ~feedback_id:id fp in
                     if not delegate then ignore(Future.compute fp);
                     reach view.next;
-                    stm_vernac_interp id ~proof x;
+                    let st = Vernacstate.freeze_interp_state `No in
+                    ignore(stm_vernac_interp id ~proof st x);
                     feedback ~id: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; stm_vernac_interp id x; Proof_global.discard_all ()
+          | `Sync (name, `Immediate) -> (fun () ->
+                reach eop;
+                let st = Vernacstate.freeze_interp_state `No in
+                ignore(stm_vernac_interp id st x);
+                Proof_global.discard_all ()
               ), `Yes, true
-          | `Sync (name, pua, reason) -> (fun () ->
+          | `Sync (name, reason) -> (fun () ->
                 log_processing_sync id name reason;
                 reach eop;
                 let wall_clock = Unix.gettimeofday () in
@@ -2292,23 +2490,27 @@ let known_state ?(redefine_qed=false) ~cache id =
                 if keep != VtKeepAsAxiom then
                   reach view.next;
                 let wall_clock2 = Unix.gettimeofday () in
-                stm_vernac_interp id ?proof x;
+                let st = Vernacstate.freeze_interp_state `No in
+                ignore(stm_vernac_interp id ?proof st x);
                 let wall_clock3 = Unix.gettimeofday () in
                 Aux_file.record_in_aux_at ?loc:x.loc "proof_check_time"
                   (Printf.sprintf "%.3f" (wall_clock3 -. wall_clock2));
                 Proof_global.discard_all ()
               ), `Yes, true
-          | `MaybeASync (start, pua, nodes, name, delegate) -> (fun () ->
+          | `MaybeASync (start, nodes, name, delegate) -> (fun () ->
                 reach ~cache:`Shallow start;
                 (* no sections *)
                 if CList.is_empty (Environ.named_context (Global.env ()))
-                then Util.pi1 (aux (`ASync (start, pua, nodes, name, delegate))) ()
-                else Util.pi1 (aux (`Sync (name, pua, `NoPU_NoHint_NoES))) ()
+                then Util.pi1 (aux (`ASync (start, nodes, name, delegate))) ()
+                else Util.pi1 (aux (`Sync (name, `NoPU_NoHint_NoES))) ()
               ), (if redefine_qed then `No else `Yes), true
           in
           aux (collect_proof keep (view.next, x) brname brinfo eop)
       | `Sideff (ReplayCommand x,_) -> (fun () ->
-            reach view.next; stm_vernac_interp id x; update_global_env ()
+            reach view.next;
+            let st = Vernacstate.freeze_interp_state `No in
+            ignore(stm_vernac_interp id st x);
+            update_global_env ()
           ), cache, true
       | `Sideff (CherryPickEnv, origin) -> (fun () ->
             reach view.next;
@@ -2316,7 +2518,7 @@ let known_state ?(redefine_qed=false) ~cache id =
           ), cache, true
     in
     let cache_step =
-      if !Flags.async_proofs_cache = Some Flags.Force then `Yes
+      if !cur_opt.async_proofs_cache = Some Force then `Yes
       else cache_step in
     State.define ?safe_id
       ~cache:cache_step ~redefine:redefine_qed ~feedback_processed step id;
@@ -2329,16 +2531,91 @@ end (* }}} *)
 (********************************* STM API ************************************)
 (******************************************************************************)
 
-let init () =
-  VCS.init Stateid.initial;
-  set_undo_classifier Backtrack.undo_vernac_classifier;
-  State.define ~cache:`Yes (fun () -> ()) Stateid.initial;
+(* Main initalization routine *)
+type stm_init_options = {
+  (* The STM will set some internal flags differently depending on the
+     specified [doc_type]. This distinction should dissappear at some
+     some point. *)
+  doc_type     : stm_doc_type;
+
+  (* Initial load path in scope for the document. Usually extracted
+     from -R options / _CoqProject *)
+  iload_path   : Mltop.coq_path list;
+
+  (* Require [require_libs] before the initial state is
+     ready. Parameters follow [Library], that is to say,
+     [lib,prefix,import_export] means require library [lib] from
+     optional [prefix] and [import_export] if [Some false/Some true]
+     is used.  *)
+  require_libs : (string * string option * bool option) list;
+
+  (* STM options that apply to the current document. *)
+  stm_options  : AsyncOpts.stm_opt;
+}
+(* fb_handler   : Feedback.feedback -> unit; *)
+
+(*
+let doc_type_module_name (std : stm_doc_type) =
+  match std with
+  | VoDoc mn | VioDoc mn | Vio2Vo mn -> mn
+  | Interactive mn -> Names.DirPath.to_string mn
+*)
+
+let init_core () =
+  if !cur_opt.async_proofs_mode = APon then Control.enable_thread_delay := true;
+  State.register_root_state ()
+
+let new_doc { doc_type ; iload_path; require_libs; stm_options } =
+
+  let load_objs libs =
+    let rq_file (dir, from, exp) =
+      let mp = Libnames.(Qualid (Loc.tag @@ qualid_of_string dir)) in
+      let mfrom = Option.map (fun fr -> Libnames.(Qualid (Loc.tag @@ qualid_of_string fr))) from in
+      Flags.silently (Vernacentries.vernac_require mfrom exp) [mp] in
+    List.(iter rq_file (rev libs))
+  in
+
+  (* Set the options from the new documents *)
+  AsyncOpts.cur_opt := stm_options;
+
+  (* We must reset the whole state before creating a document! *)
+  State.restore_root_state ();
+
+  let doc = VCS.init doc_type Stateid.initial in
+
+  (* Set load path; important, this has to happen before we declare
+     the library below as [Declaremods/Library] will infer the module
+     name by looking at the load path! *)
+  List.iter Mltop.add_coq_path iload_path;
+
+  begin match doc_type with
+  | Interactive ln ->
+    Safe_typing.allow_delayed_constants := true;
+    Declaremods.start_library ln
+
+  | VoDoc ln ->
+    let ldir = Flags.verbosely Library.start_library ln in
+    VCS.set_ldir ldir;
+    set_compilation_hints ln
+
+  | VioDoc ln ->
+    Safe_typing.allow_delayed_constants := true;
+    let ldir = Flags.verbosely Library.start_library ln in
+    VCS.set_ldir ldir;
+    set_compilation_hints ln
+  end;
+
+  (* Import initial libraries. *)
+  load_objs require_libs;
+
+  (* We record the state at this point! *)
+  State.define ~cache:`Yes ~redefine:true (fun () -> ()) Stateid.initial;
   Backtrack.record ();
   Slaves.init ();
-  if Flags.async_proofs_is_master () then begin
+  if async_proofs_is_master !cur_opt then begin
     stm_prerr_endline (fun () -> "Initializing workers");
     Query.init ();
-    let opts = match !Flags.async_proofs_private_flags with
+    let opts = match !cur_opt.async_proofs_private_flags with
       | None -> []
       | Some s -> Str.split_delim (Str.regexp ",") s in
     begin try
@@ -2347,34 +2624,39 @@ let init () =
       async_proofs_workers_extra_env := Array.of_list
         (Str.split_delim (Str.regexp ";") (Str.replace_first env_opt "" env))
     with Not_found -> () end;
-  end
+  end;
+  doc, VCS.cur_tip ()
 
-let observe id =
+let observe ~doc id =
   let vcs = VCS.backup () in
   try
-    Reach.known_state ~cache:(interactive ()) id;
-    VCS.print ()
+    Reach.known_state ~cache:(VCS.is_interactive ()) id;
+    VCS.print ();
+    doc
   with e ->
     let e = CErrors.push e in
     VCS.print ();
     VCS.restore vcs;
     Exninfo.iraise e
 
-let finish () =
+let finish ~doc =
   let head = VCS.current_branch () in
-  observe (VCS.get_branch_pos head);
+  let doc =observe ~doc (VCS.get_branch_pos head) in
   VCS.print ();
   (* EJGA: Setting here the proof state looks really wrong, and it
      hides true bugs cf bug #5363. Also, what happens with observe? *)
   (* Some commands may by side effect change the proof mode *)
-  match VCS.get_branch head with
+  (match VCS.get_branch head with
   | { VCS.kind = `Edit (mode,_,_,_,_) } -> Proof_global.activate_proof_mode mode [@ocaml.warning "-3"]
   | { VCS.kind = `Proof (mode, _) } -> Proof_global.activate_proof_mode mode [@ocaml.warning "-3"]
   | _ -> ()
+  ); doc
 
-let wait () =
+let wait ~doc =
+  let doc = finish ~doc in
   Slaves.wait_all_done ();
-  VCS.print ()
+  VCS.print ();
+  doc
 
 let rec join_admitted_proofs id =
   if Stateid.equal id Stateid.initial then () else
@@ -2385,33 +2667,33 @@ let rec join_admitted_proofs id =
        join_admitted_proofs view.next
   | _ -> join_admitted_proofs view.next
 
-let join () =
-  finish ();
-  wait ();
+let join ~doc =
+  let doc = wait ~doc in
   stm_prerr_endline (fun () -> "Joining the environment");
   Global.join_safe_environment ();
   stm_prerr_endline (fun () -> "Joining Admitted proofs");
   join_admitted_proofs (VCS.get_branch_pos (VCS.current_branch ()));
   VCS.print ();
-  VCS.print ()
+  doc
 
 let dump_snapshot () = Slaves.dump_snapshot (), RemoteCounter.snapshot ()
-type document = VCS.vcs
+
 type tasks = int Slaves.tasks * RemoteCounter.remote_counters_status
 let check_task name (tasks,rcbackup) i =
   RemoteCounter.restore rcbackup;
   let vcs = VCS.backup () in
   try
-    let rc = Future.purify (Slaves.check_task name tasks) i in
+    let rc = stm_purify (Slaves.check_task name tasks) i in
     VCS.restore vcs;
     rc
   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;
   let finish_task u (_,_,i) =
     let vcs = VCS.backup () in
-    let u = Future.purify (Slaves.finish_task name u d p t) i in
+    let u = stm_purify (Slaves.finish_task name u d p t) i in
     VCS.restore vcs;
     u in
   try
@@ -2419,7 +2701,7 @@ let finish_tasks name u d p (t,rcbackup as tasks) =
     (u,a,true), p
   with e ->
     let e = CErrors.push e in
-    msg_error (str"File " ++ str name ++ str ":" ++ spc () ++ iprint e);
+    msg_warning (str"File " ++ str name ++ str ":" ++ spc () ++ iprint e);
     exit 1
 
 let merge_proof_branch ~valid ?id qast keep brname =
@@ -2441,7 +2723,7 @@ let merge_proof_branch ~valid ?id qast keep brname =
       VCS.rewrite_merge qed_id ~ours:(Qed (qed ofp)) ~at:master_id brname;
       VCS.delete_branch brname;
       VCS.gc ();
-      Reach.known_state ~redefine_qed:true ~cache:`No qed_id;
+      let _st = Reach.known_state ~redefine_qed:true ~cache:`No qed_id in
       VCS.checkout VCS.Branch.master;
       `Unfocus qed_id
   | { VCS.kind = `Master } ->
@@ -2463,17 +2745,49 @@ let handle_failure (e, info) vcs =
       VCS.print ();
       Exninfo.iraise (e, info)
 
-let snapshot_vio ldir long_f_dot_vo =
-  finish ();
+let snapshot_vio ~doc ldir long_f_dot_vo =
+  let doc = finish ~doc in
   if List.length (VCS.branches ()) > 1 then
     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 ())
+    (Global.opaque_tables ());
+  doc
 
 let reset_task_queue = Slaves.reset_task_queue
 
 (* Document building *)
-let process_transaction ?(newtip=Stateid.fresh ())
+let process_back_meta_command ~part_of_script ~newtip ~head oid aast w =
+  match part_of_script, w with
+  | 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 ~valid aast VtDrop branch))
+      (VCS.branches ());
+    VCS.checkout_shallowest_proof_branch ();
+    let head = VCS.current_branch () in
+    List.iter (fun b ->
+        if not(VCS.Branch.equal b head) then begin
+          VCS.checkout b;
+          VCS.commit (VCS.new_node ()) (Alias (oid,aast));
+        end)
+      (VCS.branches ());
+    VCS.checkout_shallowest_proof_branch ();
+    VCS.commit id (Alias (oid,aast));
+    Backtrack.record (); if w == VtNow then ignore(finish ~doc:dummy_doc); `Ok
+
+  | false, VtNow ->
+    stm_prerr_endline (fun () -> "undo to state " ^ Stateid.to_string oid);
+    Backtrack.backto oid;
+    VCS.checkout_shallowest_proof_branch ();
+    Reach.known_state ~cache:(VCS.is_interactive ()) oid; `Ok
+
+  | false, VtLater ->
+    anomaly(str"undo classifier: VtMeta + VtLater must imply part_of_script.")
+
+let process_transaction ?(newtip=Stateid.fresh ()) ?(part_of_script=true)
   ({ verbose; loc; expr } as x) c =
   stm_pperr_endline (fun () -> str "{{{ processing: " ++ pr_ast x);
   let vcs = VCS.backup () in
@@ -2482,63 +2796,32 @@ let process_transaction ?(newtip=Stateid.fresh ())
     VCS.checkout head;
     let rc = begin
       stm_prerr_endline (fun () ->
-        "  classified as: " ^ string_of_vernac_classification c);
+        "  classified as: " ^ Vernac_classifier.string_of_vernac_classification c);
       match c with
-      (* Joining various parts of the document *)
-      | VtStm (VtJoinDocument, b), VtNow -> join (); `Ok
-      | VtStm (VtWait, b),         VtNow -> finish (); wait (); `Ok
-      | VtStm ((VtJoinDocument|VtWait),_), VtLater ->
-          anomaly(str"classifier: join actions cannot be classified as VtLater.")
-
-      (* Back *)
-      | 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 ~valid x VtDrop branch))
-            (VCS.branches ());
-          VCS.checkout_shallowest_proof_branch ();
-          let head = VCS.current_branch () in
-          List.iter (fun b ->
-            if not(VCS.Branch.equal b head) then begin
-              VCS.checkout b;
-              VCS.commit (VCS.new_node ()) (Alias (oid,x));
-            end)
-            (VCS.branches ());
-          VCS.checkout_shallowest_proof_branch ();
-          VCS.commit id (Alias (oid,x));
-          Backtrack.record (); if w == VtNow then finish (); `Ok
-      | VtStm (VtBack id, false), VtNow ->
-          stm_prerr_endline (fun () -> "undo to state " ^ Stateid.to_string id);
-          Backtrack.backto id;
-          VCS.checkout_shallowest_proof_branch ();
-          Reach.known_state ~cache:(interactive ()) id; `Ok
-      | VtStm (VtBack id, false), VtLater ->
-          anomaly(str"classifier: VtBack + VtLater must imply part_of_script.")
-
+      (* Meta *)
+      | VtMeta, _ ->
+        let id, w = Backtrack.undo_vernac_classifier expr in
+        process_back_meta_command ~part_of_script ~newtip ~head id x w
       (* Query *)
-      | VtQuery (false, route), VtNow ->
-        begin
-          let query_sid = VCS.cur_tip () in
-          try stm_vernac_interp ~route (VCS.cur_tip ()) x
-          with e ->
-            let e = CErrors.push e in
-            Exninfo.iraise (State.exn_on ~valid:Stateid.dummy query_sid e)
-        end; `Ok
-      (* Part of the script commands don't set the query route *)
-      | VtQuery (true, _route), w ->
+      | VtQuery (false,route), VtNow ->
+        let query_sid = VCS.cur_tip () in
+        (try
+           let st = Vernacstate.freeze_interp_state `No in
+           ignore(stm_vernac_interp ~route query_sid st x)
+         with e ->
+           let e = CErrors.push e in
+           Exninfo.iraise (State.exn_on ~valid:Stateid.dummy query_sid e)); `Ok
+      | VtQuery (true, route), w ->
           let id = VCS.new_node ~id:newtip () in
           let queue =
-            if !Flags.async_proofs_full then `QueryQueue (ref false)
-            else if Flags.(!compilation_mode = BuildVio) &&
+            if !cur_opt.async_proofs_full then `QueryQueue (ref false)
+            else if VCS.is_vio_doc () &&
                     VCS.((get_branch head).kind = `Master) &&
-                    may_pierce_opaque x
+                    may_pierce_opaque (Vernacprop.under_control x.expr)
                  then `SkipQueue
             else `MainQueue in
           VCS.commit id (mkTransCmd x [] false queue);
-          Backtrack.record (); if w == VtNow then finish (); `Ok
+          Backtrack.record (); if w == VtNow then ignore(finish ~doc:dummy_doc); `Ok
 
       | VtQuery (false,_), VtLater ->
           anomaly(str"classifier: VtQuery + VtLater must imply part_of_script.")
@@ -2556,7 +2839,7 @@ let process_transaction ?(newtip=Stateid.fresh ())
             VCS.merge id ~ours:(Fork (x, bname, guarantee, names)) head
           end;
           Proof_global.activate_proof_mode mode [@ocaml.warning "-3"];
-          Backtrack.record (); if w == VtNow then finish (); `Ok
+          Backtrack.record (); if w == VtNow then ignore(finish ~doc:dummy_doc); `Ok
       | VtProofMode _, VtLater ->
           anomaly(str"VtProofMode must be executed VtNow.")
       | VtProofMode mode, VtNow ->
@@ -2574,7 +2857,7 @@ let process_transaction ?(newtip=Stateid.fresh ())
             (VCS.branches ());
           VCS.checkout_shallowest_proof_branch ();
           Backtrack.record ();
-          finish ();
+          ignore(finish ~doc:dummy_doc);
           `Ok
       | VtProofStep { parallel; proof_block_detection = cblock }, w ->
           let id = VCS.new_node ~id:newtip () in
@@ -2587,17 +2870,19 @@ let process_transaction ?(newtip=Stateid.fresh ())
              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
+          Backtrack.record (); if w == VtNow then ignore(finish ~doc:dummy_doc); `Ok
       | VtQed keep, w ->
           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 ();
+          Backtrack.record (); if w == VtNow then ignore(finish ~doc:dummy_doc);
           rc
-          
+
       (* Side effect on all branches *)
-      | VtUnknown, _ when expr = VernacToplevelControl Drop ->
-          stm_vernac_interp (VCS.get_branch_pos head) x; `Ok
+      | VtUnknown, _ when Vernacprop.under_control expr = VernacToplevelControl Drop ->
+        let st = Vernacstate.freeze_interp_state `No in
+        ignore(stm_vernac_interp (VCS.get_branch_pos head) st x);
+        `Ok
 
       | VtSideff l, w ->
           let in_proof = not (VCS.Branch.equal head VCS.Branch.master) in
@@ -2606,34 +2891,34 @@ let process_transaction ?(newtip=Stateid.fresh ())
           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 action = match x.expr with
+          let action = match Vernacprop.under_control x.expr with
 	    | VernacDefinition(_, _, DefineBody _) -> CherryPickEnv
 	    | _ -> ReplayCommand x in
 	  VCS.propagate_sideff ~action;
           VCS.checkout_shallowest_proof_branch ();
-          Backtrack.record (); if w == VtNow then finish (); `Ok
+          Backtrack.record (); if w == VtNow then ignore(finish ~doc:dummy_doc); `Ok
 
       (* Unknown: we execute it, check for open goals and propagate sideeff *)
       | VtUnknown, VtNow ->
           let in_proof = not (VCS.Branch.equal head VCS.Branch.master) in
           let id = VCS.new_node ~id:newtip () in
           let head_id = VCS.get_branch_pos head in
-          Reach.known_state ~cache:`Yes head_id; (* ensure it is ok *)
+          let _st = Reach.known_state ~cache:`Yes head_id in (* ensure it is ok *)
           let step () =
             VCS.checkout VCS.Branch.master;
             let mid = VCS.get_branch_pos VCS.Branch.master in
-            Reach.known_state ~cache:(interactive ()) mid;
-            stm_vernac_interp id x;
+            let _st' = Reach.known_state ~cache:(VCS.is_interactive ()) mid in
+            let st = Vernacstate.freeze_interp_state `No in
+            ignore(stm_vernac_interp id st 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 rec opacity_of_produced_term = function
+              let 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 x.expr,[]));
+              VCS.commit id (Fork (x,bname,opacity_of_produced_term (Vernacprop.under_control 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 [@ocaml.warning "-3"];
@@ -2660,10 +2945,10 @@ let process_transaction ?(newtip=Stateid.fresh ())
     let e = CErrors.push e in
     handle_failure e vcs
 
-let get_ast id =
+let get_ast ~doc id =
   match VCS.visit id with
   | { step = `Cmd { cast = { loc; expr } } }
-  | { step = `Fork (({ loc; expr }, _, _, _), _) } 
+  | { step = `Fork (({ loc; expr }, _, _, _), _) }
   | { step = `Qed ({ qast = { loc; expr } }, _) } ->
          Some (Loc.tag ?loc expr)
   | _ -> None
@@ -2681,7 +2966,7 @@ let stop_worker n = Slaves.cancel_worker n
 *)
 exception End_of_input
 
-let parse_sentence sid pa =
+let parse_sentence ~doc sid pa =
   (* XXX: Should this restore the previous state?
      Using reach here to try to really get to the
      proper state makes the error resilience code fail *)
@@ -2693,7 +2978,7 @@ let parse_sentence sid pa =
       (str "Currently, the parsing api only supports parsing at the tip of the document." ++ fnl () ++
        str "You wanted to parse at: "  ++ str (Stateid.to_string sid) ++
        str " but the current tip is: " ++ str (Stateid.to_string cur_tip)) ;
-  if not (Stateid.equal sid real_tip) && !Flags.debug && stm_debug () then
+  if not (Stateid.equal sid real_tip) && !Flags.debug && !stm_debug then
     Feedback.msg_debug
       (str "Warning, the real tip doesn't match the current tip." ++
        str "You wanted to parse at: "  ++ str (Stateid.to_string sid) ++
@@ -2745,7 +3030,7 @@ let compute_indentation ?loc sid = Option.cata (fun loc ->
     eff_indent, len
   ) (0, 0) loc
 
-let add ~ontop ?newtip verb (loc, ast) =
+let add ~doc ~ontop ?newtip verb (loc, ast) =
   let cur_tip = VCS.cur_tip () in
   if not (Stateid.equal ontop cur_tip) then
     user_err ?loc ~hdr:"Stm.add"
@@ -2755,13 +3040,13 @@ let add ~ontop ?newtip verb (loc, ast) =
   let indentation, strlen = compute_indentation ?loc ontop in
   CWarnings.set_current_loc loc;
   (* XXX: Classifiy vernac should be moved inside process transaction *)
-  let clas = classify_vernac ast in
+  let clas = Vernac_classifier.classify_vernac ast in
   let aast = { verbose = verb; indentation; strlen; loc; expr = ast } in
   match process_transaction ?newtip aast clas with
-  | `Ok -> VCS.cur_tip (), `NewTip
-  | `Unfocus qed_id -> qed_id, `Unfocus (VCS.cur_tip ())
+  | `Ok -> doc, VCS.cur_tip (), `NewTip
+  | `Unfocus qed_id -> doc, qed_id, `Unfocus (VCS.cur_tip ())
 
-let set_perspective id_list = Slaves.set_perspective id_list
+let set_perspective ~doc id_list = Slaves.set_perspective id_list
 
 type focus = {
   start : Stateid.t;
@@ -2769,23 +3054,32 @@ type focus = {
   tip : Stateid.t
 }
 
-let query ~at ~route s =
-  Future.purify (fun s ->
-    if Stateid.equal at Stateid.dummy then finish ()
+let query ~doc ~at ~route s =
+  stm_purify (fun s ->
+    if Stateid.equal at Stateid.dummy then ignore(finish ~doc:dummy_doc)
     else Reach.known_state ~cache:`Yes at;
-    let loc, ast = parse_sentence at s in
-    let indentation, strlen = compute_indentation ?loc at 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 aast (VtStm (w,false), VtNow))
-    | _ ->
-       ignore(process_transaction aast (VtQuery (false, route), VtNow)))
+    try
+      while true do
+        let loc, ast            = parse_sentence ~doc at s in
+        let indentation, strlen = compute_indentation ?loc at in
+        CWarnings.set_current_loc loc;
+        let clas = Vernac_classifier.classify_vernac ast in
+        let aast = { verbose = true; indentation; strlen; loc; expr = ast } in
+        match clas with
+        | VtMeta , _ -> (* TODO: can this still happen ? *)
+          ignore(process_transaction ~part_of_script:false aast (VtMeta,VtNow))
+        | _ ->
+          ignore(process_transaction aast (VtQuery (false,route), VtNow))
+      done;
+    with
+    | End_of_input -> ()
+    | exn ->
+      let iexn = CErrors.push exn in
+      Exninfo.iraise iexn
+    )
   s
 
-let edit_at id =
+let edit_at ~doc id =
   if Stateid.equal id Stateid.dummy then anomaly(str"edit_at dummy.") else
   let vcs = VCS.backup () in
   let on_cur_branch id =
@@ -2830,7 +3124,7 @@ let edit_at id =
       VCS.edit_branch (`Edit (mode, qed_id, master_id, keep, old_branch));
     VCS.delete_boxes_of id;
     cancel_switch := true;
-    Reach.known_state ~cache:(interactive ()) id;
+    Reach.known_state ~cache:(VCS.is_interactive ()) id;
     VCS.checkout_shallowest_proof_branch ();
     `Focus { stop = qed_id; start = master_id; tip } in
   let no_edit = function
@@ -2852,8 +3146,8 @@ let edit_at id =
     VCS.delete_boxes_of id;
     VCS.gc ();
     VCS.print ();
-    if not !Flags.async_proofs_full then
-      Reach.known_state ~cache:(interactive ()) id;
+    if not !cur_opt.async_proofs_full then
+      Reach.known_state ~cache:(VCS.is_interactive ()) id;
     VCS.checkout_shallowest_proof_branch ();
     `NewTip in
   try
@@ -2868,7 +3162,7 @@ let edit_at id =
       | _, Some _, None -> assert false
       | 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
+          if has_failed qed_id && is_pure qed_id && not !cur_opt.async_proofs_never_reopen_branch
           then reopen_branch start id mode qed_id tip bn
           else backto id (Some bn)
       | true, Some { qed = qed_id }, Some(mode,bn) ->
@@ -2882,7 +3176,7 @@ let edit_at id =
       | true, None, _ ->
           if on_cur_branch id then begin
             VCS.reset_branch (VCS.current_branch ()) id;
-            Reach.known_state ~cache:(interactive ()) id;
+            Reach.known_state ~cache:(VCS.is_interactive ()) id;
             VCS.checkout_shallowest_proof_branch ();
             `NewTip
           end else if is_ancestor_of_cur_branch id then begin
@@ -2894,7 +3188,7 @@ let edit_at id =
       | false, None, None -> backto id None
     in
     VCS.print ();
-    rc
+    doc, rc
   with e ->
     let (e, info) = CErrors.push e in
     match Stateid.get info with
@@ -2908,15 +3202,15 @@ let edit_at id =
         VCS.print ();
         Exninfo.iraise (e, info)
 
-let backup () = VCS.backup ()
-let restore d = VCS.restore d
+let get_current_state ~doc = VCS.cur_tip ()
+let get_ldir ~doc = VCS.get_ldir ()
 
-let get_current_state () = VCS.cur_tip ()
+let get_doc did = dummy_doc
 
 (*********************** TTY API (PG, coqtop, coqc) ***************************)
 (******************************************************************************)
 
-let current_proof_depth () =
+let current_proof_depth ~doc =
   let head = VCS.current_branch () in
   match VCS.get_branch head with
   | { VCS.kind = `Master } -> 0
@@ -2929,13 +3223,13 @@ let current_proof_depth () =
 let unmangle n =
   let n = VCS.Branch.to_string n in
   let idx = String.index n '_' + 1 in
-  Names.id_of_string (String.sub n idx (String.length n - idx))
+  Names.Id.of_string (String.sub n idx (String.length n - idx))
 
 let proofname b = match VCS.get_branch b with
   | { VCS.kind = (`Proof _| `Edit _) } -> Some b
   | _ -> None
 
-let get_all_proof_names () =
+let get_all_proof_names ~doc =
   List.map unmangle (CList.map_filter proofname (VCS.branches ()))
 
 (* Export hooks *)
diff --git a/stm/stm.mli b/stm/stm.mli
index 188b176ba..8a4de34b4 100644
--- a/stm/stm.mli
+++ b/stm/stm.mli
@@ -10,10 +10,75 @@ open Names
 
 (** state-transaction-machine interface *)
 
+(* Flags *)
+module AsyncOpts : sig
+
+  type cache = Force
+  type async_proofs = APoff | APonLazy | APon
+  type tac_error_filter = [ `None | `Only of string list | `All ]
+
+  type stm_opt = {
+    async_proofs_n_workers : int;
+    async_proofs_n_tacworkers : int;
+
+    async_proofs_cache : cache option;
+    async_proofs_mode : async_proofs;
+
+    async_proofs_private_flags : string option;
+    async_proofs_full : bool;
+    async_proofs_never_reopen_branch : bool;
+
+    async_proofs_tac_error_resilience : tac_error_filter;
+    async_proofs_cmd_error_resilience : bool;
+    async_proofs_delegation_threshold : float;
+  }
+
+  val default_opts : stm_opt
+
+end
+
+(** The STM doc type determines some properties such as what
+    uncompleted proofs are allowed and recording of aux files. *)
+type stm_doc_type =
+  | VoDoc       of string
+  | VioDoc      of string
+  | Interactive of DirPath.t
+
+(* Main initalization routine *)
+type stm_init_options = {
+  (* The STM will set some internal flags differently depending on the
+     specified [doc_type]. This distinction should dissappear at some
+     some point. *)
+  doc_type     : stm_doc_type;
+
+  (* Initial load path in scope for the document. Usually extracted
+     from -R options / _CoqProject *)
+  iload_path   : Mltop.coq_path list;
+
+  (* Require [require_libs] before the initial state is
+     ready. Parameters follow [Library], that is to say,
+     [lib,prefix,import_export] means require library [lib] from
+     optional [prefix] and [import_export] if [Some false/Some true]
+     is used.  *)
+  require_libs : (string * string option * bool option) list;
+
+  (* STM options that apply to the current document. *)
+  stm_options  : AsyncOpts.stm_opt;
+}
+(* fb_handler   : Feedback.feedback -> unit; *)
+
+(** The type of a STM document *)
+type doc
+
+val init_core : unit -> unit
+
+(* Starts a new document *)
+val new_doc  : stm_init_options -> doc * Stateid.t
+
 (* [parse_sentence sid pa] Reads a sentence from [pa] with parsing
    state [sid] Returns [End_of_input] if the stream ends *)
-val parse_sentence : Stateid.t -> Pcoq.Gram.coq_parsable ->
-  Vernacexpr.vernac_expr Loc.located
+val parse_sentence : doc:doc -> Stateid.t -> Pcoq.Gram.coq_parsable ->
+  Vernacexpr.vernac_control Loc.located
 
 (* Reminder: A parsable [pa] is constructed using
    [Pcoq.Gram.coq_parsable stream], where [stream : char Stream.t]. *)
@@ -26,14 +91,14 @@ exception End_of_input
    sync, but it will eventually call edit_at on the fly if needed.
    If [newtip] is provided, then the returned state id is guaranteed
    to be [newtip] *)
-val add : ontop:Stateid.t -> ?newtip:Stateid.t ->
-  bool -> Vernacexpr.vernac_expr Loc.located ->
-  Stateid.t * [ `NewTip | `Unfocus of Stateid.t ]
+val add : doc:doc -> ontop:Stateid.t -> ?newtip:Stateid.t ->
+  bool -> Vernacexpr.vernac_control Loc.located ->
+  doc * Stateid.t * [ `NewTip | `Unfocus of Stateid.t ]
 
 (* [query at ?report_with cmd] Executes [cmd] at a given state [at],
    throwing away side effects except messages. Feedback will
    be sent with [report_with], which defaults to the dummy state id *)
-val query :
+val query : doc:doc ->
   at:Stateid.t -> route:Feedback.route_id -> Pcoq.Gram.coq_parsable -> unit
 
 (* [edit_at id] is issued to change the editing zone.  [`NewTip] is returned if
@@ -46,24 +111,27 @@ val query :
    If Flags.async_proofs_full is set, then [id] is not [observe]d, else it is.
 *)
 type focus = { start : Stateid.t; stop : Stateid.t; tip : Stateid.t }
-val edit_at : Stateid.t -> [ `NewTip | `Focus of focus ]
+val edit_at : doc:doc -> Stateid.t -> doc * [ `NewTip | `Focus of focus ]
 
 (* Evaluates the tip of the current branch *)
-val finish : unit -> unit
+val finish : doc:doc -> doc
+
+(* Internal use (fake_ide) only, do not use *)
+val wait : doc:doc -> doc
 
-val observe : Stateid.t -> unit
+val observe : doc:doc -> Stateid.t -> doc
 
 val stop_worker : string -> unit
 
 (* Joins the entire document.  Implies finish, but also checks proofs *)
-val join : unit -> unit
+val join : doc:doc -> doc
 
 (* Saves on the disk a .vio corresponding to the current status:
    - if the worker pool is empty, all tasks are saved
    - if the worker proof is not empty, then it waits until all workers
      are done with their current jobs and then dumps (or fails if one
      of the completed tasks is a failure) *)
-val snapshot_vio : DirPath.t -> string -> unit
+val snapshot_vio : doc:doc -> DirPath.t -> string -> doc
 
 (* Empties the task queue, can be used only if the worker pool is empty (E.g.
  * after having built a .vio in batch mode *)
@@ -78,23 +146,17 @@ val finish_tasks : string ->
     tasks -> Library.seg_univ * Library.seg_proofs
 
 (* Id of the tip of the current branch *)
-val get_current_state : unit -> Stateid.t
-
-(* Misc *)
-val init : unit -> unit
+val get_current_state : doc:doc -> Stateid.t
+val get_ldir : doc:doc -> Names.DirPath.t
 
 (* This returns the node at that position *)
-val get_ast : Stateid.t -> (Vernacexpr.vernac_expr Loc.located) option
+val get_ast : doc:doc -> Stateid.t -> (Vernacexpr.vernac_control Loc.located) option
 
 (* Filename *)
 val set_compilation_hints : string -> unit
 
 (* Reorders the task queue putting forward what is in the perspective *)
-val set_perspective : Stateid.t list -> unit
-
-type document
-val backup : unit -> document
-val restore : document -> unit
+val set_perspective : doc:doc -> Stateid.t list -> unit
 
 (** workers **************************************************************** **)
 
@@ -109,20 +171,20 @@ module QueryTask : AsyncTaskQueue.Task
    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. } ..
@@ -130,7 +192,7 @@ module QueryTask : AsyncTaskQueue.Task
    Corresponding DAG:
 
       .. (3) <-- { -- (4) <-- tac1 -- (5) <-- tac2 -- (6) <-- } -- (7) ..
-                       
+
    Declaration of block  [-------------------------------------------]
 
       start = 5            the first state_id that could fail in the block
@@ -151,7 +213,7 @@ type static_block_declaration = {
 
 type document_node = {
   indentation : int;
-  ast : Vernacexpr.vernac_expr;
+  ast : Vernacexpr.vernac_control;
   id : Stateid.t;
 }
 
@@ -166,11 +228,11 @@ type static_block_detection =
 type recovery_action = {
   base_state : Stateid.t;
   goals_to_admit : Goal.goal list;
-  recovery_command : Vernacexpr.vernac_expr option;
+  recovery_command : Vernacexpr.vernac_control option;
 }
 
 type dynamic_block_error_recovery =
-  static_block_declaration -> [ `ValidBlock of recovery_action | `Leaks ]
+  doc -> static_block_declaration -> [ `ValidBlock of recovery_action | `Leaks ]
 
 val register_proof_block_delimiter :
   Vernacexpr.proof_block_name ->
@@ -194,14 +256,14 @@ val state_ready_hook : (Stateid.t -> unit) Hook.t
 (* Messages from the workers to the master *)
 val forward_feedback_hook : (Feedback.feedback -> unit) Hook.t
 
-type state = {
-  system : States.state;
-  proof : Proof_global.state;
-  shallow : bool
-}
-val state_of_id :
-  Stateid.t -> [ `Valid of state option | `Expired | `Error of exn ]
+val get_doc : Feedback.doc_id -> doc
+
+val state_of_id : doc:doc ->
+  Stateid.t -> [ `Valid of Vernacstate.t option | `Expired | `Error of exn ]
 
 (* Queries for backward compatibility *)
-val current_proof_depth : unit -> int
-val get_all_proof_names : unit -> Id.t list
+val current_proof_depth : doc:doc -> int
+val get_all_proof_names : doc:doc -> Id.t list
+
+(** Enable STM debugging *)
+val stm_debug : bool ref
diff --git a/stm/tacworkertop.ml b/stm/tacworkertop.ml
index 186c8f8b7..22b45a9be 100644
--- a/stm/tacworkertop.ml
+++ b/stm/tacworkertop.ml
@@ -6,9 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-module W = AsyncTaskQueue.MakeWorker(Stm.TacTask)
+module W = AsyncTaskQueue.MakeWorker(Stm.TacTask) ()
 
 let () = Coqtop.toploop_init := WorkerLoop.loop W.init_stdout
 
-let () = Coqtop.toploop_run := W.main_loop
+let () = Coqtop.toploop_run := (fun _ ~state:_ -> W.main_loop ())
 
diff --git a/stm/vernac_classifier.ml b/stm/vernac_classifier.ml
index c2ebea961..93d58b2a9 100644
--- a/stm/vernac_classifier.ml
+++ b/stm/vernac_classifier.ml
@@ -6,9 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Vernacexpr
 open CErrors
+open Util
 open Pp
+open CAst
+open Vernacexpr
 
 let default_proof_mode () = Proof_global.get_default_proof_mode_name () [@ocaml.warning "-3"]
 
@@ -31,8 +33,7 @@ let string_of_vernac_type = function
         Option.default "" proof_block_detection
   | VtProofMode s -> "ProofMode " ^ s
   | VtQuery (b, route) -> "Query " ^ string_of_in_script b ^ " route " ^ string_of_int route
-  | VtStm ((VtJoinDocument|VtWait), b) -> "Stm " ^ string_of_in_script b
-  | VtStm (VtBack _, b) -> "Stm Back " ^ string_of_in_script b
+  | VtMeta -> "Meta "
 
 let string_of_vernac_when = function
   | VtLater -> "Later"
@@ -48,42 +49,19 @@ let declare_vernac_classifier
 =
   classifiers := !classifiers @ [s,f]
 
-let make_polymorphic (a, b as x) =
-  match a with
-  | VtStartProof (x, _, ids) ->
-      VtStartProof (x, Doesn'tGuaranteeOpacity, ids), b
-  | _ -> x
-
-let undo_classifier = ref (fun _ -> assert false)
-let set_undo_classifier f = undo_classifier := f
+let idents_of_name : Names.Name.t -> Names.Id.t list =
+  function
+  | Names.Anonymous -> []
+  | Names.Name n -> [n]
 
-let rec classify_vernac e =
-  let static_classifier e = match e with
+let classify_vernac e =
+  let static_classifier ~poly e = match e with
     (* Univ poly compatibility: we run it now, so that we can just
      * look at Flags in stm.ml.  Would be nicer to have the stm
      * look at the entire dag to detect this option. *)
-    | VernacSetOption (["Universe"; "Polymorphism"],_)
-    | VernacUnsetOption (["Universe"; "Polymorphism"]) -> VtSideff [], VtNow
-    (* Stm *)
-    | VernacStm Wait         -> VtStm (VtWait, true), VtNow
-    | VernacStm JoinDocument -> VtStm (VtJoinDocument, true), VtNow
-    (* Nested vernac exprs *)
-    | VernacProgram e -> classify_vernac e
-    | VernacLocal (_,e) -> classify_vernac e
-    | VernacPolymorphic (b, e) -> 
-      if b || Flags.is_universe_polymorphism () (* Ok or not? *) then
-	make_polymorphic (classify_vernac e)
-      else classify_vernac e
-    | VernacTimeout (_,e) -> classify_vernac e
-    | VernacTime (_,e) | VernacRedirect (_, (_,e)) -> classify_vernac e
-    | VernacFail e -> (* Fail Qed or Fail Lemma must not join/fork the DAG *)
-        (match classify_vernac e with
-        | ( VtQuery _ | VtProofStep _ | VtSideff _
-          | VtStm _ | VtProofMode _ ), _ as x -> x
-        | VtQed _, _ ->
-            VtProofStep { parallel = `No; proof_block_detection = None },
-            VtNow
-        | (VtStartProof _ | VtUnknown), _ -> VtUnknown, VtNow)
+    | ( VernacSetOption (l,_) | VernacUnsetOption l)
+      when CList.equal String.equal l Vernacentries.universe_polymorphism_option_name ->
+       VtSideff [], VtNow
     (* Qed *)
     | VernacAbort _ -> VtQed VtDrop, VtLater
     | VernacEndProof Admitted -> VtQed VtKeepAsAxiom, VtLater
@@ -110,48 +88,56 @@ let rec classify_vernac e =
     | VernacUnsetOption (["Default";"Proof";"Using"])
     | VernacSetOption (["Default";"Proof";"Using"],_) -> VtSideff [], VtNow
     (* StartProof *)
-    | VernacDefinition (
-       (Some Decl_kinds.Discharge,Decl_kinds.Definition),((_,i),_),ProveBody _) ->
-        VtStartProof(default_proof_mode (),Doesn'tGuaranteeOpacity,[i]), VtLater
-    | VernacDefinition (_,((_,i),_),ProveBody _) ->
-        VtStartProof(default_proof_mode (),GuaranteesOpacity,[i]), VtLater
+    | VernacDefinition ((Decl_kinds.DoDischarge,_),({v=i},_),ProveBody _) ->
+      VtStartProof(default_proof_mode (),Doesn'tGuaranteeOpacity, idents_of_name i), VtLater
+
+    | VernacDefinition (_,({v=i},_),ProveBody _) ->
+       let guarantee = if poly then Doesn'tGuaranteeOpacity else GuaranteesOpacity in
+        VtStartProof(default_proof_mode (),guarantee, idents_of_name i), VtLater
     | VernacStartTheoremProof (_,l) ->
-        let ids = 
-          CList.map_filter (function (Some ((_,i),pl), _) -> Some i | _ -> None) l in
-        VtStartProof (default_proof_mode (),GuaranteesOpacity,ids), VtLater
-    | VernacGoal _ -> VtStartProof (default_proof_mode (),GuaranteesOpacity,[]), VtLater
-    | VernacFixpoint (_,l) ->
+        let ids = List.map (fun (({v=i}, _), _) -> i) l in
+       let guarantee = if poly then Doesn'tGuaranteeOpacity else GuaranteesOpacity in
+        VtStartProof (default_proof_mode (),guarantee,ids), VtLater
+    | VernacFixpoint (discharge,l) ->
+       let guarantee =
+         if discharge = Decl_kinds.DoDischarge || poly then Doesn'tGuaranteeOpacity
+         else GuaranteesOpacity
+       in
         let ids, open_proof =
-          List.fold_left (fun (l,b) ((((_,id),_),_,_,_,p),_) ->
+          List.fold_left (fun (l,b) ((({v=id},_),_,_,_,p),_) ->
             id::l, b || p = None) ([],false) l in
         if open_proof
-        then VtStartProof (default_proof_mode (),GuaranteesOpacity,ids), VtLater
+        then VtStartProof (default_proof_mode (),guarantee,ids), VtLater
         else VtSideff ids, VtLater
-    | VernacCoFixpoint (_,l) ->
+    | VernacCoFixpoint (discharge,l) ->
+       let guarantee =
+         if discharge = Decl_kinds.DoDischarge || poly then Doesn'tGuaranteeOpacity
+         else GuaranteesOpacity
+       in
         let ids, open_proof =
-          List.fold_left (fun (l,b) ((((_,id),_),_,_,p),_) ->
+          List.fold_left (fun (l,b) ((({v=id},_),_,_,p),_) ->
             id::l, b || p = None) ([],false) l in
         if open_proof
-        then VtStartProof (default_proof_mode (),GuaranteesOpacity,ids), VtLater
+        then VtStartProof (default_proof_mode (),guarantee,ids), VtLater
         else VtSideff ids, VtLater
     (* Sideff: apply to all open branches. usually run on master only *)
     | VernacAssumption (_,_,l) ->
-        let ids = List.flatten (List.map (fun (_,(l,_)) -> List.map (fun (id, _) -> snd id) l) l) in
-        VtSideff ids, VtLater    
-    | VernacDefinition (_,((_,id),_),DefineBody _) -> VtSideff [id], VtLater
+        let ids = List.flatten (List.map (fun (_,(l,_)) -> List.map (fun (id, _) -> id.v) l) l) in
+        VtSideff ids, VtLater
+    | VernacDefinition (_,({v=id},_),DefineBody _) -> VtSideff (idents_of_name id), VtLater
     | VernacInductive (_, _,_,l) ->
-        let ids = List.map (fun (((_,((_,id),_)),_,_,_,cl),_) -> id :: match cl with
-        | Constructors l -> List.map (fun (_,((_,id),_)) -> id) l
-        | RecordDecl (oid,l) -> (match oid with Some (_,x) -> [x] | _ -> []) @
+        let ids = List.map (fun (((_,({v=id},_)),_,_,_,cl),_) -> id :: match cl with
+        | Constructors l -> List.map (fun (_,({v=id},_)) -> id) l
+        | RecordDecl (oid,l) -> (match oid with Some {v=x} -> [x] | _ -> []) @
            CList.map_filter (function
-            | ((_,AssumExpr((_,Names.Name n),_)),_),_ -> Some n
+            | ((_,AssumExpr({v=Names.Name n},_)),_),_ -> Some n
             | _ -> None) l) l in
         VtSideff (List.flatten ids), VtLater
     | VernacScheme l ->
-        let ids = List.map snd (CList.map_filter (fun (x,_) -> x) l) in
+        let ids = List.map (fun {v}->v) (CList.map_filter (fun (x,_) -> x) l) in
         VtSideff ids, VtLater
-    | VernacCombinedScheme ((_,id),_) -> VtSideff [id], VtLater
-    | VernacBeginSection (_,id) -> VtSideff [id], VtLater
+    | VernacCombinedScheme ({v=id},_) -> VtSideff [id], VtLater
+    | VernacBeginSection {v=id} -> VtSideff [id], VtLater
     | VernacUniverse _ | VernacConstraint _
     | VernacCanonical _ | VernacCoercion _ | VernacIdentityCoercion _
     | VernacAddLoadPath _ | VernacRemoveLoadPath _ | VernacAddMLPath _
@@ -175,40 +161,57 @@ let rec classify_vernac e =
     (* (Local) Notations have to disappear *)
     | VernacEndSegment _ -> VtSideff [], VtNow
     (* Modules with parameters have to be executed: can import notations *)
-    | VernacDeclareModule (exp,(_,id),bl,_)
-    | VernacDefineModule (exp,(_,id),bl,_,_) ->
+    | VernacDeclareModule (exp,{v=id},bl,_)
+    | VernacDefineModule (exp,{v=id},bl,_,_) ->
         VtSideff [id], if bl = [] && exp = None then VtLater else VtNow
-    | VernacDeclareModuleType ((_,id),bl,_,_) ->
+    | VernacDeclareModuleType ({v=id},bl,_,_) ->
         VtSideff [id], if bl = [] then VtLater else VtNow
     (* These commands alter the parser *)
     | VernacOpenCloseScope _ | VernacDelimiters _ | VernacBindScope _
     | VernacInfix _ | VernacNotation _ | VernacNotationAddFormat _
-    | VernacSyntaxExtension _ 
+    | VernacSyntaxExtension _
     | VernacSyntacticDefinition _
     | VernacRequire _ | VernacImport _ | VernacInclude _
     | VernacDeclareMLModule _
     | VernacContext _ (* TASSI: unsure *)
-    | VernacProofMode _ 
+    | VernacProofMode _ -> VtSideff [], VtNow
     (* These are ambiguous *)
     | VernacInstance _ -> VtUnknown, VtNow
     (* Stm will install a new classifier to handle these *)
     | VernacBack _ | VernacAbortAll
     | VernacUndoTo _ | VernacUndo _
     | VernacResetName _ | VernacResetInitial
-    | VernacBacktrack _ | VernacBackTo _ | VernacRestart -> !undo_classifier e
+    | VernacBacktrack _ | VernacBackTo _ | VernacRestart -> VtMeta, VtNow
     (* What are these? *)
     | VernacToplevelControl _
     | VernacRestoreState _
-    | VernacWriteState _ -> VtUnknown, VtNow
+    | VernacWriteState _ -> VtSideff [], VtNow
     (* Plugins should classify their commands *)
     | VernacExtend (s,l) ->
         try List.assoc s !classifiers l ()
         with Not_found -> anomaly(str"No classifier for"++spc()++str (fst s)++str".")
   in
-  let res = static_classifier e in
-    if Flags.is_universe_polymorphism () then
-      make_polymorphic res
-    else res
+  let rec static_control_classifier ~poly = function
+    | VernacExpr (f, e) ->
+      let poly = List.fold_left (fun poly f ->
+          match f with
+          | VernacPolymorphic b -> b
+          | (VernacProgram | VernacLocal _) -> poly
+        ) poly f in
+      static_classifier ~poly e
+    | VernacTimeout (_,e) -> static_control_classifier ~poly e
+    | VernacTime (_,{v=e}) | VernacRedirect (_, {v=e}) ->
+       static_control_classifier ~poly e
+    | VernacFail e -> (* Fail Qed or Fail Lemma must not join/fork the DAG *)
+        (match static_control_classifier ~poly e with
+        | ( VtQuery _ | VtProofStep _ | VtSideff _
+          | VtProofMode _ | VtMeta), _ as x -> x
+        | VtQed _, _ ->
+            VtProofStep { parallel = `No; proof_block_detection = None },
+            VtNow
+        | (VtStartProof _ | VtUnknown), _ -> VtUnknown, VtNow)
+  in
+  static_control_classifier ~poly:(Flags.is_universe_polymorphism ()) e
 
 let classify_as_query = VtQuery (true,Feedback.default_route), VtLater
 let classify_as_sideeff = VtSideff [], VtLater
diff --git a/stm/vernac_classifier.mli b/stm/vernac_classifier.mli
index 2fa1e0b8d..c0571c1d6 100644
--- a/stm/vernac_classifier.mli
+++ b/stm/vernac_classifier.mli
@@ -12,15 +12,12 @@ open Genarg
 val string_of_vernac_classification : vernac_classification -> string
 
 (** What does a vernacular do *)
-val classify_vernac : vernac_expr -> vernac_classification
+val classify_vernac : vernac_control -> vernac_classification
 
 (** Install a vernacular classifier for VernacExtend *)
 val declare_vernac_classifier :
   Vernacexpr.extend_name -> (raw_generic_argument list -> unit -> vernac_classification) -> unit
 
-(** Set by Stm *)
-val set_undo_classifier : (vernac_expr -> vernac_classification) -> unit
-
 (** Standard constant classifiers *)
 val classify_as_query : vernac_classification
 val classify_as_sideeff : vernac_classification
diff --git a/stm/vio_checking.ml b/stm/vio_checking.ml
index 9507e90ba..da6a095ab 100644
--- a/stm/vio_checking.ml
+++ b/stm/vio_checking.ml
@@ -14,7 +14,7 @@ let check_vio (ts,f) =
   Stm.set_compilation_hints long_f_dot_v;
   List.fold_left (fun acc ids -> Stm.check_task f tasks ids && acc) true ts
 
-module Worker = Spawn.Sync(struct end)
+module Worker = Spawn.Sync ()
 
 module IntOT = struct
   type t = int
diff --git a/stm/workerLoop.ml b/stm/workerLoop.ml
index 64121eb3d..d606f19bf 100644
--- a/stm/workerLoop.ml
+++ b/stm/workerLoop.ml
@@ -6,14 +6,18 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
+(* Default priority *)
+open CoqworkmgrApi
+let async_proofs_worker_priority = ref Low
+
 let rec parse = function
   | "--xml_format=Ppcmds" :: rest -> parse rest
   | x :: rest -> x :: parse rest
   | [] -> []
 
-let loop init args =
-  let args = parse args in
+let loop init _coq_args extra_args =
+  let args = parse extra_args in
   Flags.quiet := true;
   init ();
-  CoqworkmgrApi.init !Flags.async_proofs_worker_priority;
+  CoqworkmgrApi.init !async_proofs_worker_priority;
   args
diff --git a/stm/workerLoop.mli b/stm/workerLoop.mli
index 53f745935..c42b48a28 100644
--- a/stm/workerLoop.mli
+++ b/stm/workerLoop.mli
@@ -6,4 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-val loop : (unit -> unit) -> string list -> string list
+(* Default priority *)
+val async_proofs_worker_priority : CoqworkmgrApi.priority ref
+
+val loop : (unit -> unit) -> Coqargs.coq_cmdopts -> string list -> string list
diff --git a/tactics/auto.ml b/tactics/auto.ml
index 7aa5114a4..eec7a5f2a 100644
--- a/tactics/auto.ml
+++ b/tactics/auto.ml
@@ -32,7 +32,7 @@ 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
+  let hyps = Proofview.Goal.hyps gl in
   secvars_of_hyps hyps
 
 (* tell auto not to reuse already instantiated metas in unification (for
@@ -187,35 +187,34 @@ let _ =
   add_option ["Info";"Trivial"] global_info_trivial;
   add_option ["Info";"Auto"] global_info_auto
 
-let no_dbg () = (Off,0,ref [])
+type debug_kind = ReportForTrivial | ReportForAuto
+
+let no_dbg (_,whatfor,_,_) = (Off,whatfor,0,ref [])
 
 let mk_trivial_dbg debug =
   let d =
     if debug == Debug || !global_debug_trivial then Debug
     else if debug == Info || !global_info_trivial then Info
     else Off
-  in (d,0,ref [])
-
-(** Note : we start the debug depth of auto at 1 to distinguish it
-   for trivial (whose depth is 0). *)
+  in (d,ReportForTrivial,0,ref [])
 
 let mk_auto_dbg debug =
   let d =
     if debug == Debug || !global_debug_auto then Debug
     else if debug == Info || !global_info_auto then Info
     else Off
-  in (d,1,ref [])
+  in (d,ReportForAuto,0,ref [])
 
-let incr_dbg = function (dbg,depth,trace) -> (dbg,depth+1,trace)
+let incr_dbg = function (dbg,whatfor,depth,trace) -> (dbg,whatfor,depth+1,trace)
 
 (** A tracing tactic for debug/info trivial/auto *)
 
-let tclLOG (dbg,depth,trace) pp tac =
+let tclLOG (dbg,_,depth,trace) pp tac =
   match dbg with
     | Off -> tac
     | Debug ->
        (* For "debug (trivial/auto)", we directly output messages *)
-      let s = String.make depth '*' in
+      let s = String.make (depth+1) '*' in
       Proofview.V82.tactic begin fun gl ->
 	try
 	  let out = Proofview.V82.of_tactic tac gl in
@@ -256,23 +255,23 @@ 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-1) ' ') ++ pp () ++ str "."
+  str (String.make d ' ') ++ pp () ++ str "."
 
 let pr_info_trace = function
-  | (Info,_,{contents=(d,Some pp)::l}) ->
+  | (Info,_,_,{contents=(d,Some pp)::l}) ->
       Feedback.msg_info (prlist_with_sep fnl pr_info_atom (cleanup_info_trace d [(d,pp)] l))
   | _ -> ()
 
 let pr_info_nop = function
-  | (Info,_,_) -> Feedback.msg_info (str "idtac.")
+  | (Info,_,_,_) -> Feedback.msg_info (str "idtac.")
   | _ -> ()
 
 let pr_dbg_header = function
-  | (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: *)")
+  | (Off,_,_,_) -> ()
+  | (Debug,ReportForTrivial,_,_) -> Feedback.msg_debug (str "(* debug trivial: *)")
+  | (Debug,ReportForAuto,_,_) -> Feedback.msg_debug (str "(* debug auto: *)")
+  | (Info,ReportForTrivial,_,_) -> Feedback.msg_info (str "(* info trivial: *)")
+  | (Info,ReportForAuto,_,_) -> Feedback.msg_info (str "(* info auto: *)")
 
 let tclTRY_dbg d tac =
   let delay f = Proofview.tclUNIT () >>= fun () -> f () in
@@ -317,7 +316,7 @@ let rec trivial_fail_db dbg mod_delta db_list local_db =
           let sigma = Tacmach.New.project gl in
           let env = Proofview.Goal.env gl in
           let nf c = Evarutil.nf_evar sigma c in
-          let decl = Tacmach.New.pf_last_hyp (Proofview.Goal.assume gl) in
+          let decl = Tacmach.New.pf_last_hyp gl in
           let hyp = Context.Named.Declaration.map_constr nf decl in
 	  let hintl = make_resolve_hyp env sigma hyp
 	  in trivial_fail_db dbg mod_delta db_list
@@ -382,14 +381,14 @@ and tac_of_hint dbg db_list local_db concl (flags, ({pat=p; code=t;poly=poly;db=
         (unify_resolve_gen poly flags (c,cl))
 	(* With "(debug) trivial", we shouldn't end here, and
 	   with "debug auto" we don't display the details of inner trivial *)
-        (trivial_fail_db (no_dbg ()) (not (Option.is_empty flags)) db_list local_db)
+        (trivial_fail_db (no_dbg dbg) (not (Option.is_empty flags)) db_list local_db)
     | Unfold_nth c ->
       Proofview.Goal.enter begin fun gl ->
        if exists_evaluable_reference (Tacmach.New.pf_env gl) c then
 	 Tacticals.New.tclPROGRESS (reduce (Unfold [AllOccurrences,c]) Locusops.onConcl)
        else Tacticals.New.tclFAIL 0 (str"Unbound reference")
        end
-    | Extern tacast -> 
+    | Extern tacast ->
       conclPattern concl p tacast
   in
   let pr_hint () =
@@ -397,7 +396,8 @@ and tac_of_hint dbg db_list local_db concl (flags, ({pat=p; code=t;poly=poly;db=
     | None -> mt ()
     | Some n -> str " (in " ++ str n ++ str ")"
     in
-    pr_hint t ++ origin
+    let sigma, env = Pfedit.get_current_context () in
+    pr_hint env sigma t ++ origin
   in
   tclLOG dbg pr_hint (run_hint t tactic)
 
@@ -514,8 +514,8 @@ let delta_auto debug mod_delta n lems dbnames =
 
 let delta_auto = 
   if Flags.profile then
-    let key = Profile.declare_profile "delta_auto" in
-      Profile.profile5 key delta_auto
+    let key = CProfile.declare_profile "delta_auto" in
+      CProfile.profile5 key delta_auto
   else delta_auto
 
 let auto ?(debug=Off) n = delta_auto debug false n
diff --git a/tactics/auto.mli b/tactics/auto.mli
index b9cd4932c..59809331e 100644
--- a/tactics/auto.mli
+++ b/tactics/auto.mli
@@ -16,14 +16,14 @@ open Decl_kinds
 open Hints
 open Tactypes
 
-val compute_secvars : 'a Proofview.Goal.t -> Id.Pred.t
+val compute_secvars : 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 ->
-  'a Proofview.Goal.t -> clausenv * constr
+  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
diff --git a/tactics/autorewrite.ml b/tactics/autorewrite.ml
index ed612c0fc..de98f6382 100644
--- a/tactics/autorewrite.ml
+++ b/tactics/autorewrite.ml
@@ -9,7 +9,7 @@
 open Equality
 open Names
 open Pp
-open Term
+open Constr
 open Termops
 open CErrors
 open Util
@@ -20,7 +20,7 @@ open Locus
 type rew_rule = { rew_lemma: constr;
 		  rew_type: types;
 		  rew_pat: constr;
-		  rew_ctx: Univ.universe_context_set;
+		  rew_ctx: Univ.ContextSet.t;
 		  rew_l2r: bool;
 		  rew_tac: Genarg.glob_generic_argument option }
 
@@ -73,12 +73,12 @@ let find_matches bas pat =
   let res = HintDN.search_pattern base pat in
   List.map snd res
 
-let print_rewrite_hintdb bas =
+let print_rewrite_hintdb env sigma bas =
   (str "Database " ++ str bas ++ fnl () ++
 	   prlist_with_sep fnl
 	   (fun h ->
 	     str (if h.rew_l2r then "rewrite -> " else "rewrite <- ") ++
-	       Printer.pr_lconstr h.rew_lemma ++ str " of type " ++ Printer.pr_lconstr h.rew_type ++
+               Printer.pr_lconstr_env env sigma h.rew_lemma ++ str " of type " ++ Printer.pr_lconstr_env env sigma h.rew_type ++
 	       Option.cata (fun tac -> str " then use tactic " ++
 	       Pputils.pr_glb_generic (Global.env()) tac) (mt ()) h.rew_tac)
 	   (find_rewrites bas))
diff --git a/tactics/autorewrite.mli b/tactics/autorewrite.mli
index edbb7c6b7..44acf3c01 100644
--- a/tactics/autorewrite.mli
+++ b/tactics/autorewrite.mli
@@ -8,7 +8,7 @@
 
 (** This files implements the autorewrite tactic. *)
 
-open Term
+open Constr
 open Equality
 
 (** Rewriting rules before tactic interpretation *)
@@ -28,7 +28,7 @@ val autorewrite_in : ?conds:conditions -> Names.Id.t -> unit Proofview.tactic ->
 type rew_rule = { rew_lemma: constr;
 		  rew_type: types;
 		  rew_pat: constr;
-		  rew_ctx: Univ.universe_context_set;
+		  rew_ctx: Univ.ContextSet.t;
 		  rew_l2r: bool;
 		  rew_tac: Genarg.glob_generic_argument option }
 
@@ -40,7 +40,7 @@ val auto_multi_rewrite : ?conds:conditions -> string list -> Locus.clause -> uni
 
 val auto_multi_rewrite_with : ?conds:conditions -> unit Proofview.tactic -> string list -> Locus.clause -> unit Proofview.tactic
 
-val print_rewrite_hintdb : string -> Pp.t
+val print_rewrite_hintdb : Environ.env -> Evd.evar_map -> string -> Pp.t
 
 open Clenv
 
@@ -58,5 +58,5 @@ type hypinfo = {
 
 val find_applied_relation :
   ?loc:Loc.t -> bool ->
-  Environ.env -> Evd.evar_map -> Term.constr -> bool -> hypinfo
+  Environ.env -> Evd.evar_map -> constr -> bool -> hypinfo
 
diff --git a/tactics/class_tactics.ml b/tactics/class_tactics.ml
index b98b10315..a95e6b941 100644
--- a/tactics/class_tactics.ml
+++ b/tactics/class_tactics.ml
@@ -376,7 +376,7 @@ let rec e_trivial_fail_db only_classes db_list local_db secvars =
     Proofview.Goal.enter
     begin fun gl ->
     let tacs = e_trivial_resolve db_list local_db secvars only_classes
-                                 (project gl) (pf_concl gl) in
+                                 (pf_env gl) (project gl) (pf_concl gl) in
       tclFIRST (List.map (fun (x,_,_,_,_) -> x) tacs)
     end
   in
@@ -386,7 +386,7 @@ let rec e_trivial_fail_db only_classes db_list local_db secvars =
   in
   tclFIRST (List.map tclCOMPLETE tacl)
 
-and e_my_find_search db_list local_db secvars hdc complete only_classes sigma concl =
+and e_my_find_search db_list local_db secvars hdc complete only_classes env sigma concl =
   let open Proofview.Notations in
   let prods, concl = EConstr.decompose_prod_assum sigma concl in
   let nprods = List.length prods in
@@ -467,24 +467,24 @@ and e_my_find_search db_list local_db secvars hdc complete only_classes sigma co
       let pp =
         match p with
         | Some pat when get_typeclasses_filtered_unification () ->
-           str " with pattern " ++ Printer.pr_constr_pattern pat
+           str " with pattern " ++ Printer.pr_constr_pattern_env env sigma 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))
+        | Extern _ -> (tac, b, true, name, lazy (pr_hint env sigma t ++ pp))
+        | _ -> (tac, b, false, name, lazy (pr_hint env sigma t ++ pp))
   in List.map tac_of_hint hintl
 
-and e_trivial_resolve db_list local_db secvars only_classes sigma concl =
+and e_trivial_resolve db_list local_db secvars only_classes env sigma concl =
   let hd = try Some (decompose_app_bound sigma concl) with Bound -> None in
   try
-    e_my_find_search db_list local_db secvars hd true only_classes sigma concl
+    e_my_find_search db_list local_db secvars hd true only_classes env sigma concl
   with Not_found -> []
 
-let e_possible_resolve db_list local_db secvars only_classes sigma concl =
+let e_possible_resolve db_list local_db secvars only_classes env sigma concl =
   let hd = try Some (decompose_app_bound sigma concl) with Bound -> None in
   try
-    e_my_find_search db_list local_db secvars hd false only_classes sigma concl
+    e_my_find_search db_list local_db secvars hd false only_classes env sigma concl
   with Not_found -> []
 
 let cut_of_hints h =
@@ -718,7 +718,7 @@ module V85 = struct
     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 poss = e_possible_resolve hints info.hints secvars info.only_classes env s concl in
     let unique = is_unique env s concl in
     let rec aux i foundone = function
       | (tac, _, extern, name, pp) :: tl ->
@@ -996,7 +996,7 @@ module Search = struct
              Hint_db.transparent_state cached_hints == st
     then cached_hints
     else
-      let hints = make_hints {it = Goal.goal (Proofview.Goal.assume g); sigma = project g}
+      let hints = make_hints {it = Goal.goal g; sigma = project g}
                              st only_classes sign
       in
       autogoal_cache := (cwd, only_classes, sign, hints); hints
@@ -1041,7 +1041,6 @@ module Search = struct
 
   let fail_if_nonclass info =
     Proofview.Goal.enter begin fun gl ->
-      let gl = Proofview.Goal.assume gl in
       let sigma = Proofview.Goal.sigma gl in
       if is_class_type sigma (Proofview.Goal.concl gl) then
         Proofview.tclUNIT ()
@@ -1071,7 +1070,7 @@ module Search = struct
             else str" without backtracking"));
     let secvars = compute_secvars gl in
     let poss =
-      e_possible_resolve hints info.search_hints secvars info.search_only_classes sigma concl in
+      e_possible_resolve hints info.search_hints secvars info.search_only_classes env sigma 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
@@ -1089,7 +1088,7 @@ module Search = struct
             pr_depth (idx :: info.search_depth) ++ str": " ++
               Lazy.force pp ++
               (if !foundone != true then
-                 str" on" ++ spc () ++ pr_ev sigma (Proofview.Goal.goal (Proofview.Goal.assume gl))
+                 str" on" ++ spc () ++ pr_ev sigma (Proofview.Goal.goal gl)
                else mt ())
           in
           let msg =
@@ -1110,7 +1109,7 @@ module Search = struct
         if !typeclasses_debug > 0 then
           Feedback.msg_debug
             (pr_depth (succ j :: i :: info.search_depth) ++ str" : " ++
-               pr_ev sigma' (Proofview.Goal.goal (Proofview.Goal.assume gl')));
+               pr_ev sigma' (Proofview.Goal.goal gl'));
         let eq c1 c2 = EConstr.eq_constr sigma' c1 c2 in
         let hints' =
           if b && not (Context.Named.equal eq (Goal.hyps gl') (Goal.hyps gl))
@@ -1119,7 +1118,7 @@ module Search = struct
             make_autogoal_hints info.search_only_classes ~st gl'
           else info.search_hints
         in
-        let dep' = info.search_dep || Proofview.unifiable sigma' (Goal.goal (Proofview.Goal.assume gl')) gls in
+        let dep' = info.search_dep || Proofview.unifiable sigma' (Goal.goal gl') gls in
         let info' =
           { search_depth = succ j :: i :: info.search_depth;
             last_tac = pp;
@@ -1136,7 +1135,7 @@ module Search = struct
         (if !typeclasses_debug > 0 then
            Feedback.msg_debug
              (pr_depth (i :: info.search_depth) ++ str": " ++ Lazy.force pp
-              ++ str" on" ++ spc () ++ pr_ev sigma (Proofview.Goal.goal (Proofview.Goal.assume gl))
+              ++ str" on" ++ spc () ++ pr_ev sigma (Proofview.Goal.goal gl)
               ++ str", " ++ int j ++ str" subgoal(s)" ++
                 (Option.cata (fun k -> str " in addition to the first " ++ int k)
                              (mt()) k)));
@@ -1261,7 +1260,7 @@ module Search = struct
     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 (Proofview.Goal.assume gl)) gls in
+      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
 
@@ -1569,7 +1568,7 @@ let _ =
   Hook.set Typeclasses.solve_all_instances_hook solve_inst
 
 let resolve_one_typeclass env ?(sigma=Evd.empty) gl unique =
-  let nc, gl, subst, _, _ = Evarutil.push_rel_context_to_named_context env sigma gl in
+  let nc, gl, subst, _ = Evarutil.push_rel_context_to_named_context env sigma gl in
   let (gl,t,sigma) =
     Goal.V82.mk_goal sigma nc gl Store.empty in
   let (ev, _) = destEvar sigma t in
diff --git a/tactics/contradiction.ml b/tactics/contradiction.ml
index 5e2006ccc..467754a84 100644
--- a/tactics/contradiction.ml
+++ b/tactics/contradiction.ml
@@ -53,7 +53,7 @@ let filter_hyp f tac =
     | d::rest when f (NamedDecl.get_type d) -> tac (NamedDecl.get_id d)
     | _::rest -> seek rest in
   Proofview.Goal.enter begin fun gl ->
-    let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
+    let hyps = Proofview.Goal.hyps gl in
     seek hyps
   end
 
@@ -98,7 +98,7 @@ let contradiction_context =
                  end)
 	  | _ -> seek_neg rest
     in
-    let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
+    let hyps = Proofview.Goal.hyps gl in
     seek_neg hyps
   end
 
diff --git a/tactics/eauto.ml b/tactics/eauto.ml
index 2b5bbfcd1..785d2f515 100644
--- a/tactics/eauto.ml
+++ b/tactics/eauto.ml
@@ -10,13 +10,13 @@ open Pp
 open CErrors
 open Util
 open Names
-open Nameops
 open Term
 open Termops
 open EConstr
 open Proof_type
 open Tacticals
 open Tacmach
+open Evd
 open Tactics
 open Clenv
 open Auto
@@ -32,7 +32,7 @@ let eauto_unif_flags = auto_flags_of_state full_transparent_state
 let e_give_exact ?(flags=eauto_unif_flags) c =
   Proofview.Goal.enter begin fun gl ->
   let t1 = Tacmach.New.pf_unsafe_type_of gl c in
-  let t2 = Tacmach.New.pf_concl (Proofview.Goal.assume gl) in
+  let t2 = Tacmach.New.pf_concl gl in
   let sigma = Tacmach.New.project gl in
   if occur_existential sigma t1 || occur_existential sigma t2 then
      Tacticals.New.tclTHEN (Clenvtac.unify ~flags t1) (exact_no_check c)
@@ -148,12 +148,12 @@ let rec e_trivial_fail_db db_list local_db =
   let tacl =
     registered_e_assumption ::
     (Tacticals.New.tclTHEN Tactics.intro next) ::
-    (List.map fst (e_trivial_resolve (Tacmach.New.project gl) db_list local_db secvars (Tacmach.New.pf_concl gl)))
+    (List.map fst (e_trivial_resolve (Tacmach.New.pf_env gl) (Tacmach.New.project gl) db_list local_db secvars (Tacmach.New.pf_concl gl)))
   in
   Tacticals.New.tclFIRST (List.map Tacticals.New.tclCOMPLETE tacl)
   end
 
-and e_my_find_search sigma db_list local_db secvars hdc concl =
+and e_my_find_search env sigma db_list local_db secvars hdc concl =
   let hint_of_db = hintmap_of sigma secvars hdc concl in
   let hintl =
       List.map_append (fun db ->
@@ -178,19 +178,19 @@ and e_my_find_search sigma db_list local_db secvars hdc concl =
         | Extern tacast -> conclPattern concl p tacast
        in
        let tac = run_hint t tac in
-       (tac, lazy (pr_hint t)))
+       (tac, lazy (pr_hint env sigma t)))
   in
   List.map tac_of_hint hintl
 
-and e_trivial_resolve sigma db_list local_db secvars gl =
+and e_trivial_resolve env sigma db_list local_db secvars gl =
   let hd = try Some (decompose_app_bound sigma gl) with Bound -> None in
-  try priority (e_my_find_search sigma db_list local_db secvars hd gl)
+  try priority (e_my_find_search env sigma db_list local_db secvars hd gl)
   with Not_found -> []
 
-let e_possible_resolve sigma db_list local_db secvars gl =
+let e_possible_resolve env sigma db_list local_db secvars gl =
   let hd = try Some (decompose_app_bound sigma gl) with Bound -> None in
   try List.map (fun (b, (tac, pp)) -> (tac, b, pp))
-               (e_my_find_search sigma db_list local_db secvars hd gl)
+               (e_my_find_search env sigma db_list local_db secvars hd gl)
   with Not_found -> []
 
 let find_first_goal gls =
@@ -261,7 +261,7 @@ module SearchProblem = struct
       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 map_assum id = (e_give_exact (mkVar id), (-1), lazy (str "exact" ++ spc () ++ Id.print id)) in
       let assumption_tacs =
         let tacs = List.map map_assum hyps in
         let l = filter_tactics s.tacres tacs in
@@ -290,7 +290,7 @@ module SearchProblem = struct
 	let l =
           let concl = Reductionops.nf_evar (project g) (pf_concl g) in
 	  filter_tactics s.tacres
-                         (e_possible_resolve (project g) s.dblist (List.hd s.localdb) secvars concl)
+                         (e_possible_resolve (pf_env g) (project g) s.dblist (List.hd s.localdb) secvars concl)
 	in
 	List.map
 	  (fun (lgls, cost, pp) ->
@@ -404,8 +404,8 @@ let e_search_auto debug (in_depth,p) lems db_list gl =
     pr_info_nop d;
     user_err Pp.(str "eauto: search failed")
 
-(* let e_search_auto_key = Profile.declare_profile "e_search_auto" *)
-(* let e_search_auto = Profile.profile5 e_search_auto_key e_search_auto *)
+(* let e_search_auto_key = CProfile.declare_profile "e_search_auto" *)
+(* let e_search_auto = CProfile.profile5 e_search_auto_key e_search_auto *)
 
 let eauto_with_bases ?(debug=Off) np lems db_list =
   tclTRY (e_search_auto debug np lems db_list)
@@ -439,7 +439,7 @@ let autounfolds db occs cls gl =
     in
     let (ids, csts) = Hint_db.unfolds db in
     let hyps = pf_ids_of_hyps gl in
-    let ids = Idset.filter (fun id -> List.mem id hyps) ids in
+    let ids = Id.Set.filter (fun id -> List.mem id hyps) ids in
       Cset.fold (fun cst -> cons (AllOccurrences, EvalConstRef cst)) csts
 	(Id.Set.fold (fun id -> cons (AllOccurrences, EvalVarRef id)) ids [])) db)
   in Proofview.V82.of_tactic (unfold_option unfolds cls) gl
diff --git a/tactics/elimschemes.ml b/tactics/elimschemes.ml
index 2d2a0c1b2..e427adb15 100644
--- a/tactics/elimschemes.ml
+++ b/tactics/elimschemes.ml
@@ -13,7 +13,8 @@
 
 (* This file builds schemes related to case analysis and recursion schemes *)
 
-open Term
+open Sorts
+open Constr
 open Indrec
 open Declarations
 open Typeops
diff --git a/tactics/elimschemes.mli b/tactics/elimschemes.mli
index e3fe7ddae..50b052f23 100644
--- a/tactics/elimschemes.mli
+++ b/tactics/elimschemes.mli
@@ -13,10 +13,10 @@ open Ind_tables
 val optimize_non_type_induction_scheme : 
   'a Ind_tables.scheme_kind ->
   Indrec.dep_flag ->
-  Term.sorts_family ->
+  Sorts.family ->
   'b ->
   Names.inductive ->
-  (Constr.constr * Evd.evar_universe_context) * Safe_typing.private_constants
+  (Constr.constr * UState.t) * Safe_typing.private_constants
 
 val rect_scheme_kind_from_prop : individual scheme_kind
 val ind_scheme_kind_from_prop : individual scheme_kind
diff --git a/tactics/eqdecide.ml b/tactics/eqdecide.ml
index e16fcec7c..8764ef085 100644
--- a/tactics/eqdecide.ml
+++ b/tactics/eqdecide.ml
@@ -73,7 +73,7 @@ let generalize_right mk typ c1 c2 =
     let env = Proofview.Goal.env gl in
     let store = Proofview.Goal.extra gl in
   Refine.refine ~typecheck:false begin fun sigma ->
-    let na = Name (next_name_away_with_default "x" Anonymous (Termops.ids_of_context env)) in
+    let na = Name (next_name_away_with_default "x" Anonymous (Termops.vars_of_env env)) in
     let newconcl = mkProd (na, typ, mk typ c1 (mkRel 1)) in
     let (sigma, x) = Evarutil.new_evar env sigma ~principal:true ~store newconcl in
     (sigma, mkApp (x, [|c2|]))
@@ -89,6 +89,12 @@ let mkBranches (eqonleft,mk,c1,c2,typ) =
      clear_last;
      intros]
 
+let inj_flags = Some {
+    Equality.keep_proof_equalities = true; (* necessary *)
+    Equality.injection_in_context = true; (* does not matter here *)
+    Equality.injection_pattern_l2r_order = true; (* does not matter here *)
+  }
+
 let discrHyp id =
   let c env sigma = (sigma, (mkVar id, NoBindings)) in
   let tac c = Equality.discr_tac false (Some (None, ElimOnConstr c)) in
@@ -114,7 +120,7 @@ let idx = Id.of_string "x"
 let idy = Id.of_string "y"
 
 let mkGenDecideEqGoal rectype ops g =
-  let hypnames = pf_ids_of_hyps g in
+  let hypnames = pf_ids_set_of_hyps g in
   let xname    = next_ident_away idx hypnames
   and yname    = next_ident_away idy hypnames in
   (mkNamedProd xname rectype
@@ -136,7 +142,7 @@ let eqCase tac =
 
 let injHyp id =
   let c env sigma = (sigma, (mkVar id, NoBindings)) in
-  let tac c = Equality.injClause None false (Some (None, ElimOnConstr c)) in
+  let tac c = Equality.injClause inj_flags 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 ce57682c6..d7667668e 100644
--- a/tactics/eqschemes.ml
+++ b/tactics/eqschemes.ml
@@ -48,6 +48,7 @@ open CErrors
 open Util
 open Names
 open Term
+open Constr
 open Vars
 open Declarations
 open Environ
@@ -64,7 +65,7 @@ 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
-let fresh env id = next_global_ident_away id []
+let fresh env id = next_global_ident_away id Id.Set.empty
 let with_context_set ctx (b, ctx') = 
   (b, Univ.ContextSet.union ctx ctx')
 
@@ -106,8 +107,8 @@ let get_coq_eq ctx =
 
 let univ_of_eq env eq =
   let eq = EConstr.of_constr eq in
-  match kind_of_term (EConstr.Unsafe.to_constr (Retyping.get_type_of env Evd.empty eq)) with
-  | Prod (_,t,_) -> (match kind_of_term t with Sort (Type u) -> u | _ -> assert false)
+  match Constr.kind (EConstr.Unsafe.to_constr (Retyping.get_type_of env Evd.empty eq)) with
+  | Prod (_,t,_) -> (match Constr.kind t with Sort (Type u) -> u | _ -> assert false)
   | _ -> assert false
 
 (**********************************************************************)
@@ -141,7 +142,7 @@ let get_sym_eq_data env (ind,u) =
   let paramsctxt = Vars.subst_instance_context u mib.mind_params_ctxt in
   let paramsctxt1,_ =
     List.chop (mib.mind_nparams-mip.mind_nrealargs) paramsctxt in
-  if not (List.equal Term.eq_constr params2 constrargs) then
+  if not (List.equal Constr.equal params2 constrargs) then
     error "Constructors arguments must repeat the parameters.";
   (* nrealargs_ctxt and nrealargs are the same here *)
   (specif,mip.mind_nrealargs,realsign,paramsctxt,paramsctxt1)
diff --git a/tactics/eqschemes.mli b/tactics/eqschemes.mli
index 4acfa7a28..90ae67c6c 100644
--- a/tactics/eqschemes.mli
+++ b/tactics/eqschemes.mli
@@ -9,7 +9,7 @@
 (** This file builds schemes relative to equality inductive types *)
 
 open Names
-open Term
+open Constr
 open Environ
 open Ind_tables
 
@@ -22,14 +22,14 @@ val rew_l2r_forward_dep_scheme_kind : individual scheme_kind
 val rew_r2l_dep_scheme_kind : individual scheme_kind
 val rew_r2l_scheme_kind : individual scheme_kind
 
-val build_r2l_rew_scheme : bool -> env -> inductive -> sorts_family -> 
+val build_r2l_rew_scheme : bool -> env -> inductive -> Sorts.family -> 
   constr Evd.in_evar_universe_context
-val build_l2r_rew_scheme : bool -> env -> inductive -> sorts_family -> 
+val build_l2r_rew_scheme : bool -> env -> inductive -> Sorts.family -> 
   constr Evd.in_evar_universe_context * Safe_typing.private_constants
 val build_r2l_forward_rew_scheme :
-  bool -> env -> inductive -> sorts_family -> constr Evd.in_evar_universe_context
+  bool -> env -> inductive -> Sorts.family -> constr Evd.in_evar_universe_context
 val build_l2r_forward_rew_scheme :
-  bool -> env -> inductive -> sorts_family -> constr Evd.in_evar_universe_context
+  bool -> env -> inductive -> Sorts.family -> constr Evd.in_evar_universe_context
 
 (** Builds a symmetry scheme for a symmetrical equality type *)
 
@@ -43,5 +43,5 @@ val sym_involutive_scheme_kind : individual scheme_kind
 (** Builds a congruence scheme for an equality type *)
 
 val congr_scheme_kind : individual scheme_kind
-val build_congr : env -> constr * constr * Univ.universe_context_set -> inductive -> 
+val build_congr : env -> constr * constr * Univ.ContextSet.t -> inductive -> 
   constr Evd.in_evar_universe_context
diff --git a/tactics/equality.ml b/tactics/equality.ml
index 3ea9538f3..9a1ac768c 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -48,6 +48,12 @@ module NamedDecl = Context.Named.Declaration
 
 (* Options *)
 
+type inj_flags = {
+    keep_proof_equalities : bool;
+    injection_in_context : bool;
+    injection_pattern_l2r_order : bool;
+  }
+
 let discriminate_introduction = ref true
 
 let discr_do_intro () = !discriminate_introduction
@@ -63,7 +69,9 @@ let _ =
 
 let injection_pattern_l2r_order = ref true
 
-let use_injection_pattern_l2r_order () = !injection_pattern_l2r_order
+let use_injection_pattern_l2r_order = function
+  | None -> !injection_pattern_l2r_order
+  | Some flags -> flags.injection_pattern_l2r_order
 
 let _ =
   declare_bool_option
@@ -75,9 +83,9 @@ let _ =
 
 let injection_in_context = ref false
 
-let use_injection_in_context () =
-  !injection_in_context
-  && Flags.version_strictly_greater Flags.V8_5
+let use_injection_in_context = function
+  | None -> !injection_in_context && Flags.version_strictly_greater Flags.V8_5
+  | Some flags -> flags.injection_in_context
 
 let _ =
   declare_bool_option
@@ -258,7 +266,7 @@ let rewrite_elim with_evars frzevars cls c e =
   end
 
 let tclNOTSAMEGOAL tac =
-  let goal gl = Proofview.Goal.goal (Proofview.Goal.assume gl) in
+  let goal gl = Proofview.Goal.goal gl in
   Proofview.Goal.nf_enter begin fun gl ->
     let sigma = project gl in
     let ev = goal gl in
@@ -316,7 +324,7 @@ let general_elim_clause with_evars frzevars tac cls c t l l2r elim =
     in
     let typ = match cls with
     | None -> pf_concl gl
-    | Some id -> pf_get_hyp_typ id (Proofview.Goal.assume gl)
+    | Some id -> pf_get_hyp_typ id gl
     in
     let cs = instantiate_lemma typ in
     if firstonly then tclFIRST (List.map try_clause cs)
@@ -366,16 +374,16 @@ let find_elim hdcncl lft2rgt dep cls ot =
         | Some true, None
         | Some false, Some _ ->
 	  let c1 = destConstRef pr1 in 
-	  let mp,dp,l = repr_con (constant_of_kn (canonical_con c1)) in 
+	  let mp,dp,l = Constant.repr3 (Constant.make1 (Constant.canonical c1)) in 
 	  let l' = Label.of_id (add_suffix (Label.to_id l) "_r")  in 
-	  let c1' = Global.constant_of_delta_kn (make_kn mp dp l') in
+	  let c1' = Global.constant_of_delta_kn (KerName.make mp dp l') in
 	  begin 
 	    try 
 	      let _ = Global.lookup_constant c1' in
 		c1'
 	    with Not_found -> 
 	      user_err ~hdr:"Equality.find_elim"
-                (str "Cannot find rewrite principle " ++ pr_label l' ++ str ".")
+                (str "Cannot find rewrite principle " ++ Label.print l' ++ str ".")
 	  end
 	| _ -> destConstRef pr1
         end
@@ -721,10 +729,17 @@ let _ =
       optread  = (fun () -> !keep_proof_equalities_for_injection) ;
       optwrite = (fun b -> keep_proof_equalities_for_injection := b) }
 
-let find_positions env sigma ~no_discr t1 t2 =
+let keep_proof_equalities = function
+  | None -> !keep_proof_equalities_for_injection
+  | Some flags -> flags.keep_proof_equalities
+
+(* [keep_proofs] is relevant for types in Prop with elimination in Type *)
+(* In particular, it is relevant for injection but not for discriminate *)
+
+let find_positions env sigma ~keep_proofs ~no_discr t1 t2 =
   let project env sorts posn t1 t2 =
     let ty1 = get_type_of env sigma t1 in
-    let s = get_sort_family_of env sigma ty1 in
+    let s = get_sort_family_of ~truncation_style:true env sigma ty1 in
     if Sorts.List.mem s sorts
     then [(List.rev posn,t1,t2)] else []
   in
@@ -768,20 +783,22 @@ let find_positions env sigma ~no_discr t1 t2 =
 	    project env sorts posn t1_0 t2_0
   in
   try
-    let sorts = if !keep_proof_equalities_for_injection then [InSet;InType;InProp]
-		else [InSet;InType]
-    in
+    let sorts = if keep_proofs then [InSet;InType;InProp] else [InSet;InType] in
     Inr (findrec sorts [] t1 t2)
   with DiscrFound (path,c1,c2) ->
     Inl (path,c1,c2)
 
+let use_keep_proofs = function
+  | None -> !keep_proof_equalities_for_injection
+  | Some b -> b
+
 let discriminable env sigma t1 t2 =
-  match find_positions env sigma ~no_discr:false t1 t2 with
+  match find_positions env sigma ~keep_proofs:false ~no_discr:false t1 t2 with
     | Inl _ -> true
     | _ -> false
 
-let injectable env sigma t1 t2 =
-    match find_positions env sigma ~no_discr:true t1 t2 with
+let injectable env sigma ~keep_proofs t1 t2 =
+    match find_positions env sigma ~keep_proofs:(use_keep_proofs keep_proofs) ~no_discr:true t1 t2 with
     | Inl _ -> assert false
     | Inr [] | Inr [([],_,_)] -> false
     | Inr _ -> true
@@ -953,7 +970,7 @@ let rec build_discriminator env sigma true_0 false_0 dirn c = function
 let gen_absurdity id =
   Proofview.Goal.enter begin fun gl ->
   let sigma = project gl in
-  let hyp_typ = pf_get_hyp_typ id (Proofview.Goal.assume gl) in
+  let hyp_typ = pf_get_hyp_typ id gl in
   if is_empty_type sigma hyp_typ
   then
     simplest_elim (mkVar id)
@@ -1003,7 +1020,7 @@ let apply_on_clause (f,t) clause =
 let discr_positions env sigma (lbeq,eqn,(t,t1,t2)) eq_clause cpath dirn =
   build_coq_True () >>= fun true_0 ->
   build_coq_False () >>= fun false_0 ->
-  let e = next_ident_away eq_baseid (ids_of_context env) in
+  let e = next_ident_away eq_baseid (vars_of_env env) in
   let e_env = push_named (Context.Named.Declaration.LocalAssum (e,t)) env in
   let discriminator =
     try
@@ -1024,7 +1041,7 @@ let discrEq (lbeq,_,(t,t1,t2) as u) eq_clause =
   let sigma = eq_clause.evd in
   Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
-    match find_positions env sigma ~no_discr:false t1 t2 with
+    match find_positions env sigma ~keep_proofs:false ~no_discr:false t1 t2 with
     | Inr _ ->
 	tclZEROMSG (str"Not a discriminable equality.")
     | Inl (cpath, (_,dirn), _) ->
@@ -1069,9 +1086,8 @@ let discr with_evars = onEquality with_evars discrEq
 let discrClause with_evars = onClause (discrSimpleClause with_evars)
 
 let discrEverywhere with_evars =
-(*
-  tclORELSE
-*)
+  tclTHEN (Proofview.tclUNIT ())
+    (* Delay the interpretation of side-effect *)
     (if discr_do_intro () then
       (tclTHEN
 	(tclREPEAT introf)
@@ -1079,9 +1095,7 @@ let discrEverywhere with_evars =
           (fun id -> tclCOMPLETE (discr with_evars (mkVar id,NoBindings)))))
      else (* <= 8.2 compat *)
        tryAllHypsAndConcl (discrSimpleClause with_evars))
-(*    (fun gls ->
-       user_err ~hdr:"DiscrEverywhere" (str"No discriminable equalities."))
-*)
+
 let discr_tac with_evars = function
   | None -> discrEverywhere with_evars
   | Some c -> onInductionArg (fun clear_flag -> discr with_evars) c
@@ -1371,7 +1385,7 @@ let simplify_args env sigma t =
     | _ -> t
 
 let inject_at_positions env sigma l2r (eq,_,(t,t1,t2)) eq_clause posns tac =
-  let e = next_ident_away eq_baseid (ids_of_context env) in
+  let e = next_ident_away eq_baseid (vars_of_env env) in
   let e_env = push_named (LocalAssum (e,t)) env in
   let evdref = ref sigma in
   let filter (cpath, t1', t2') =
@@ -1403,15 +1417,15 @@ let inject_at_positions env sigma l2r (eq,_,(t,t1,t2)) eq_clause posns tac =
          (if l2r then List.rev injectors else injectors)))
       (tac (List.length injectors)))
 
-let injEqThen tac l2r (eq,_,(t,t1,t2) as u) eq_clause =
+let injEqThen keep_proofs tac l2r (eq,_,(t,t1,t2) as u) eq_clause =
   let sigma = eq_clause.evd in
   let env = eq_clause.env in
-  match find_positions env sigma ~no_discr:true t1 t2 with
+  match find_positions env sigma ~keep_proofs ~no_discr:true t1 t2 with
   | Inl _ ->
      assert false
   | Inr [] ->
      let suggestion =
-         if !keep_proof_equalities_for_injection then
+         if keep_proofs 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))
@@ -1422,21 +1436,22 @@ let injEqThen tac l2r (eq,_,(t,t1,t2) as u) eq_clause =
 	(tac (clenv_value eq_clause))
 
 let get_previous_hyp_position id gl =
+  let env, sigma = Proofview.Goal.(env gl, sigma gl) in
   let rec aux dest = function
-  | [] -> raise (RefinerError (NoSuchHyp id))
+  | [] -> raise (RefinerError (env, sigma, 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
-  aux MoveLast (Proofview.Goal.hyps (Proofview.Goal.assume gl))
+  aux MoveLast (Proofview.Goal.hyps gl)
 
-let injEq ?(old=false) with_evars clear_flag ipats =
+let injEq flags ?(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 () ->
+    | None when not old && use_injection_in_context flags ->
       Some [], true, true, true
     | None -> None, false, false, false
-    | _ -> let b = use_injection_pattern_l2r_order () in ipats, b, b, b in
+    | _ -> let b = use_injection_pattern_l2r_order flags in ipats, b, b, b in
   (* Built the post tactic depending on compatibility mode *)
   let post_tac c n =
     match ipats_style with
@@ -1456,26 +1471,26 @@ let injEq ?(old=false) with_evars clear_flag ipats =
         tclTHEN clear_tac intro_tac
       end
     | None -> tclIDTAC in
-  injEqThen post_tac l2r
+  injEqThen (keep_proof_equalities flags) post_tac l2r
 
-let inj ipats with_evars clear_flag = onEquality with_evars (injEq with_evars clear_flag ipats)
+let inj flags ipats with_evars clear_flag = onEquality with_evars (injEq flags with_evars clear_flag ipats)
 
-let injClause ipats with_evars = function
-  | None -> onNegatedEquality with_evars (injEq with_evars None ipats)
-  | Some c -> onInductionArg (inj ipats with_evars) c
+let injClause flags ipats with_evars = function
+  | None -> onNegatedEquality with_evars (injEq flags with_evars None ipats)
+  | Some c -> onInductionArg (inj flags 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 simpleInjClause flags with_evars = function
+  | None -> onNegatedEquality with_evars (injEq flags ~old:true with_evars None None)
+  | Some c -> onInductionArg (fun clear_flag -> onEquality with_evars (injEq flags ~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.tag id)))
+let injConcl flags = injClause flags None false None
+let injHyp flags clear_flag id = injClause flags None false (Some (clear_flag,ElimOnIdent CAst.(make id)))
 
-let decompEqThen ntac (lbeq,_,(t,t1,t2) as u) clause =
+let decompEqThen keep_proofs ntac (lbeq,_,(t,t1,t2) as u) clause =
   Proofview.Goal.enter begin fun gl ->
     let sigma =  clause.evd in
     let env = Proofview.Goal.env gl in
-      match find_positions env sigma ~no_discr:false t1 t2 with
+      match find_positions env sigma ~keep_proofs ~no_discr:false t1 t2 with
       | Inl (cpath, (_,dirn), _) ->
 	  discr_positions env sigma u clause cpath dirn
       | Inr [] -> (* Change: do not fail, simplify clear this trivial hyp *)
@@ -1485,18 +1500,18 @@ let decompEqThen ntac (lbeq,_,(t,t1,t2) as u) clause =
           (ntac (clenv_value clause))
   end
 
-let dEqThen with_evars ntac = function
-  | None -> onNegatedEquality with_evars (decompEqThen (ntac None))
-  | Some c -> onInductionArg (fun clear_flag -> onEquality with_evars (decompEqThen (ntac clear_flag))) c
+let dEqThen ~keep_proofs with_evars ntac = function
+  | None -> onNegatedEquality with_evars (decompEqThen (use_keep_proofs keep_proofs) (ntac None))
+  | Some c -> onInductionArg (fun clear_flag -> onEquality with_evars (decompEqThen (use_keep_proofs keep_proofs) (ntac clear_flag))) c
 
-let dEq with_evars =
-  dEqThen with_evars (fun clear_flag c x ->
+let dEq ~keep_proofs with_evars =
+  dEqThen ~keep_proofs with_evars (fun clear_flag c x ->
     (apply_clear_request clear_flag (use_clear_hyp_by_default ()) c))
 
 let intro_decomp_eq tac data (c, t) =
   Proofview.Goal.enter begin fun gl ->
     let cl = pf_apply make_clenv_binding gl (c, t) NoBindings in
-    decompEqThen (fun _ -> tac) data cl
+    decompEqThen !keep_proof_equalities_for_injection (fun _ -> tac) data cl
   end
 
 let _ = declare_intro_decomp_eq intro_decomp_eq
@@ -1568,7 +1583,7 @@ let subst_tuple_term env sigma dep_pair1 dep_pair2 b =
   let body = mkApp (lambda_create env sigma (typ,pred_body),[|dep_pair1|]) in
   let expected_goal = beta_applist sigma (abst_B,List.map fst e2_list) in
   (* Simulate now the normalisation treatment made by Logic.mk_refgoals *)
-  let expected_goal = nf_betaiota sigma expected_goal in
+  let expected_goal = nf_betaiota env sigma expected_goal in
   (* Retype to get universes right *)
   let sigma, expected_goal_ty = Typing.type_of env sigma expected_goal in
   let sigma, _ = Typing.type_of env sigma body in
@@ -1701,8 +1716,8 @@ let subst_one dep_proof_ok x (hyp,rhs,dir) =
   Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
-  let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
-  let concl = Proofview.Goal.concl (Proofview.Goal.assume gl) in
+  let hyps = Proofview.Goal.hyps gl in
+  let concl = Proofview.Goal.concl gl in
   (* The set of hypotheses using x *)
   let dephyps =
     List.rev (pi3 (List.fold_right (fun dcl (dest,deps,allhyps) ->
@@ -1734,7 +1749,6 @@ let subst_one dep_proof_ok x (hyp,rhs,dir) =
 
 let subst_one_var dep_proof_ok x =
   Proofview.Goal.enter begin fun gl ->
-    let gl = Proofview.Goal.assume gl in
     let decl = pf_get_hyp x gl in
     (* If x has a body, simply replace x with body and clear x *)
     if is_local_def decl then tclTHEN (unfold_body x) (clear [x]) else
@@ -1746,7 +1760,7 @@ let subst_one_var dep_proof_ok x =
           let test hyp _ = is_eq_x gl x hyp in
           Context.Named.fold_outside test ~init:() hyps;
           user_err ~hdr:"Subst"
-            (str "Cannot find any non-recursive equality over " ++ pr_id x ++
+            (str "Cannot find any non-recursive equality over " ++ Id.print x ++
 	       str".")
         with FoundHyp res -> res in
       subst_one dep_proof_ok x res
@@ -1775,7 +1789,6 @@ let subst_all ?(flags=default_subst_tactic_flags) () =
 
   (* First step: find hypotheses to treat in linear time *)
   let find_equations gl =
-    let gl = Proofview.Goal.assume gl in
     let env = Proofview.Goal.env gl in
     let sigma = project gl in
     let find_eq_data_decompose = find_eq_data_decompose gl in
@@ -1801,7 +1814,6 @@ let subst_all ?(flags=default_subst_tactic_flags) () =
   (* Second step: treat equations *)
   let process hyp =
     Proofview.Goal.enter begin fun gl ->
-    let gl = Proofview.Goal.assume gl in
     let sigma = project gl in
     let env = Proofview.Goal.env gl in
     let find_eq_data_decompose = find_eq_data_decompose gl in
@@ -1810,9 +1822,9 @@ let subst_all ?(flags=default_subst_tactic_flags) () =
     (* J.F.: added to prevent failure on goal containing x=x as an hyp *)
     if EConstr.eq_constr sigma x y then Proofview.tclUNIT () else
       match EConstr.kind sigma x, EConstr.kind sigma y with
-      | Var x', _ when not (occur_term sigma x y) && not (is_evaluable env (EvalVarRef x')) ->
+      | Var x', _ when not (dependent sigma x y) && not (is_evaluable env (EvalVarRef x')) ->
           subst_one flags.rewrite_dependent_proof x' (hyp,y,true)
-      | _, Var y' when not (occur_term sigma y x) && not (is_evaluable env (EvalVarRef y')) ->
+      | _, Var y' when not (dependent sigma y x) && not (is_evaluable env (EvalVarRef y')) ->
           subst_one flags.rewrite_dependent_proof y' (hyp,x,false)
       | _ ->
           Proofview.tclUNIT ()
diff --git a/tactics/equality.mli b/tactics/equality.mli
index a4d1c0f9b..65da2e7dc 100644
--- a/tactics/equality.mli
+++ b/tactics/equality.mli
@@ -67,23 +67,31 @@ val replace_in_clause_maybe_by : constr -> constr -> clause -> unit Proofview.ta
 val replace    : constr -> constr -> unit Proofview.tactic
 val replace_by : constr -> constr -> unit Proofview.tactic -> unit Proofview.tactic
 
+type inj_flags = {
+    keep_proof_equalities : bool; (* One may want it or not *)
+    injection_in_context : bool;  (* For regularity; one may want it from ML code but not interactively *)
+    injection_pattern_l2r_order : bool; (* Compatibility option: no reason not to want it *)
+  }
+
 val discr        : evars_flag -> constr with_bindings -> unit Proofview.tactic
 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 destruction_arg option -> unit Proofview.tactic
-val inj          : intro_patterns option -> evars_flag ->
+
+(* Below, if flag is [None], it takes the value from the dynamic value of the option *)
+val inj          : inj_flags option -> intro_patterns option -> evars_flag ->
   clear_flag -> constr with_bindings -> unit Proofview.tactic
-val injClause    : intro_patterns option -> evars_flag ->
+val injClause    : inj_flags option -> intro_patterns option -> evars_flag ->
   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 ->
+val injHyp       : inj_flags option -> clear_flag -> Id.t -> unit Proofview.tactic
+val injConcl     : inj_flags option -> unit Proofview.tactic
+val simpleInjClause : inj_flags option -> evars_flag ->
   constr with_bindings destruction_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 dEq : keep_proofs:(bool option) -> evars_flag -> constr with_bindings destruction_arg option -> unit Proofview.tactic
+val dEqThen : keep_proofs:(bool option) -> 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)
@@ -100,7 +108,7 @@ val rewriteInConcl : bool -> constr -> unit Proofview.tactic
 val discriminable : env -> evar_map -> constr -> constr -> bool
 
 (* Tells if tactic "injection" is applicable *)
-val injectable : env -> evar_map -> constr -> constr -> bool
+val injectable : env -> evar_map -> keep_proofs:(bool option) -> constr -> constr -> bool
 
 (* Subst *)
 
diff --git a/tactics/hints.ml b/tactics/hints.ml
index a572508d4..7f9b5ef34 100644
--- a/tactics/hints.ml
+++ b/tactics/hints.ml
@@ -56,7 +56,9 @@ let head_constr_bound sigma t =
   | _ -> raise Bound
 
 let head_constr sigma c =
-  try head_constr_bound sigma c with Bound -> user_err Pp.(str "Bound head variable.")
+  try head_constr_bound sigma c
+  with Bound -> user_err (Pp.str "Head identifier must be a constant, section variable, \
+                                  (co)inductive type, (co)inductive type constructor, or projection.")
 
 let decompose_app_bound sigma t =
   let t = strip_outer_cast sigma t in
@@ -126,14 +128,14 @@ type hints_path = global_reference hints_path_gen
 
 type hint_term =
   | IsGlobRef of global_reference
-  | IsConstr of constr * Univ.universe_context_set
+  | IsConstr of constr * Univ.ContextSet.t
 
 type 'a with_uid = {
   obj : 'a;
   uid : KerName.t;
 }
 
-type raw_hint = constr * types * Univ.universe_context_set
+type raw_hint = constr * types * Univ.ContextSet.t
 
 type hint = (raw_hint * clausenv) hint_ast with_uid
 
@@ -764,7 +766,9 @@ let rec nb_hyp sigma c = match EConstr.kind sigma c with
 
 let try_head_pattern c =
   try head_pattern_bound c
-  with BoundPattern -> user_err Pp.(str "Bound head variable.")
+  with BoundPattern ->
+    user_err (Pp.str "Head pattern or sub-pattern must be a global constant, a section variable, \
+                      an if, case, or let expression, an application, or a projection.")
 
 let with_uid c = { obj = c; uid = fresh_key () }
 
@@ -1388,39 +1392,34 @@ let make_db_list dbnames =
 (*                    Functions for printing the hints                    *)
 (**************************************************************************)
 
-let pr_hint_elt (c, _, _) = pr_econstr c
+let pr_hint_elt env sigma (c, _, _) = pr_econstr_env env sigma c
 
-let pr_hint h = match h.obj with
-  | 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)
+let pr_hint env sigma h = match h.obj with
+  | Res_pf (c, _) -> (str"simple apply " ++ pr_hint_elt env sigma c)
+  | ERes_pf (c, _) -> (str"simple eapply " ++ pr_hint_elt env sigma c)
+  | Give_exact (c, _) -> (str"exact " ++ pr_hint_elt env sigma c)
   | Res_pf_THEN_trivial_fail (c, _) ->
-      (str"simple apply " ++ pr_hint_elt c ++ str" ; trivial")
-  | Unfold_nth c -> (str"unfold " ++  pr_evaluable_reference c)
+      (str"simple apply " ++ pr_hint_elt env sigma 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 CErrors.noncritical e -> Global.env ()
-      in
-      (str "(*external*) " ++ Pputils.pr_glb_generic env tac)
+    str "(*external*) " ++ Pputils.pr_glb_generic env tac
 
-let pr_id_hint (id, v) =
-  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
+let pr_id_hint env sigma (id, v) =
+  let pr_pat p = str", pattern " ++ pr_lconstr_pattern_env env sigma p in
+  (pr_hint env sigma 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 ())
+let pr_hint_list env sigma hintlist =
+  (str "  " ++ hov 0 (prlist (pr_id_hint env sigma) hintlist) ++ fnl ())
 
-let pr_hints_db (name,db,hintlist) =
+let pr_hints_db env sigma (name,db,hintlist) =
   (str "In the database " ++ str name ++ str ":" ++
      if List.is_empty hintlist then (str " nothing" ++ fnl ())
-     else (fnl () ++ pr_hint_list hintlist))
+     else (fnl () ++ pr_hint_list env sigma hintlist))
 
 (* Print all hints associated to head c in any database *)
-let pr_hint_list_for_head c =
+let pr_hint_list_for_head env sigma c =
   let dbs = current_db () in
   let validate (name, db) =
     let hints = List.map (fun v -> 0, v) (Hint_db.map_all ~secvars:Id.Pred.full c db) in
@@ -1432,13 +1431,13 @@ let pr_hint_list_for_head c =
   else
     hov 0
       (str"For " ++ pr_global c ++ str" -> " ++ fnl () ++
-	 hov 0 (prlist pr_hints_db valid_dbs))
+         hov 0 (prlist (pr_hints_db env sigma) valid_dbs))
 
 let pr_hint_ref ref = pr_hint_list_for_head ref
 
 (* Print all hints associated to head id in any database *)
 
-let pr_hint_term sigma cl =
+let pr_hint_term env sigma cl =
   try
     let dbs = current_db () in
     let valid_dbs =
@@ -1456,18 +1455,19 @@ let pr_hint_term sigma cl =
 	(str "No hint applicable for current goal")
       else
 	(str "Applicable Hints :" ++ fnl () ++
-	    hov 0 (prlist pr_hints_db valid_dbs))
+            hov 0 (prlist (pr_hints_db env sigma) valid_dbs))
   with Match_failure _ | Failure _ ->
     (str "No hint applicable for current goal")
 
 (* print all hints that apply to the concl of the current goal *)
 let pr_applicable_hint () =
+  let env = Global.env () in
   let pts = Proof_global.give_me_the_proof () in
-  let glss = Proof.V82.subgoals pts in
-  match glss.Evd.it with
+  let glss,_,_,_,sigma = Proof.proof pts in
+  match glss with
   | [] -> CErrors.user_err Pp.(str "No focused goal.")
   | g::_ ->
-    pr_hint_term glss.Evd.sigma (Goal.V82.concl glss.Evd.sigma g)
+    pr_hint_term env sigma (Goal.V82.concl sigma g)
 
 let pp_hint_mode = function
   | ModeInput -> str"+"
@@ -1475,9 +1475,9 @@ let pp_hint_mode = function
   | ModeOutput -> str"-"
 
 (* displays the whole hint database db *)
-let pr_hint_db db =
+let pr_hint_db_env env sigma db =
   let pr_mode = prvect_with_sep spc pp_hint_mode in
-  let pr_modes l = 
+  let pr_modes l =
     if List.is_empty l then mt ()
     else str" (modes " ++ prlist_with_sep pr_comma pr_mode l ++ str")"
   in
@@ -1487,7 +1487,7 @@ let pr_hint_db db =
       | None -> str "For any goal"
       | Some head -> str "For " ++ pr_global head ++ pr_modes modes
       in
-      let hints = pr_hint_list (List.map (fun x -> (0, x)) hintlist) in
+      let hints = pr_hint_list env sigma (List.map (fun x -> (0, x)) hintlist) in
       let hint_descr = hov 0 (goal_descr ++ str " -> " ++ hints) in
       accu ++ hint_descr
     in
@@ -1502,17 +1502,22 @@ let pr_hint_db db =
   hov 2 (str"Cut: " ++ pp_hints_path (Hint_db.cut db)) ++ fnl () ++
   content
 
-let pr_hint_db_by_name dbname =
+(* Deprecated in the mli *)
+let pr_hint_db db =
+  let sigma, env = Pfedit.get_current_context () in
+  pr_hint_db_env env sigma db
+
+let pr_hint_db_by_name env sigma dbname =
   try
-    let db = searchtable_map dbname in pr_hint_db db
+    let db = searchtable_map dbname in pr_hint_db_env env sigma db
   with Not_found ->
     error_no_such_hint_database dbname
 
 (* displays all the hints of all databases *)
-let pr_searchtable () =
+let pr_searchtable env sigma =
   let fold name db accu =
     accu ++ str "In the database " ++ str name ++ str ":" ++ fnl () ++
-    pr_hint_db db ++ fnl ()
+    pr_hint_db_env env sigma db ++ fnl ()
   in
   Hintdbmap.fold fold !searchtable (mt ())
 
@@ -1530,10 +1535,13 @@ let warn_non_imported_hint =
           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
-  warn_non_imported_hint (hint,mp);
-  Proofview.tclUNIT x
+  let open Proofview in
+  tclBIND tclENV     (fun env   ->
+  tclBIND tclEVARMAP (fun sigma ->
+          let hint = pr_hint env sigma h in
+          let (mp, _, _) = KerName.repr h.uid in
+          warn_non_imported_hint (hint,mp);
+          Proofview.tclUNIT x))
 
 let run_hint tac k = match !warn_hint with
 | `LAX -> k tac.obj
diff --git a/tactics/hints.mli b/tactics/hints.mli
index 44e5370e9..cbf204981 100644
--- a/tactics/hints.mli
+++ b/tactics/hints.mli
@@ -42,7 +42,7 @@ type 'a hint_ast =
   | Extern     of Genarg.glob_generic_argument       (* Hint Extern *)
 
 type hint
-type raw_hint = constr * types * Univ.universe_context_set
+type raw_hint = constr * types * Univ.ContextSet.t
 
 type 'a hints_path_atom_gen =
   | PathHints of 'a list
@@ -146,7 +146,7 @@ type hint_info = (patvar list * constr_pattern) hint_info_gen
 
 type hint_term =
   | IsGlobRef of global_reference
-  | IsConstr of constr * Univ.universe_context_set
+  | IsConstr of constr * Univ.ContextSet.t
 
 type hints_entry =
   | HintsResolveEntry of
@@ -193,7 +193,7 @@ val prepare_hint : bool (* Check no remaining evars *) ->
 *)
 
 val make_exact_entry : env -> evar_map -> hint_info -> polymorphic -> ?name:hints_path_atom ->
-  (constr * types * Univ.universe_context_set) -> hint_entry
+  (constr * types * Univ.ContextSet.t) -> hint_entry
 
 (** [make_apply_entry (eapply,hnf,verbose) info (c,cty,ctx))].
    [eapply] is true if this hint will be used only with EApply;
@@ -211,7 +211,7 @@ val make_exact_entry : env -> evar_map -> hint_info -> polymorphic -> ?name:hint
 
 val make_apply_entry :
   env -> evar_map -> bool * bool * bool -> hint_info -> polymorphic -> ?name:hints_path_atom ->
-  (constr * types * Univ.universe_context_set) -> hint_entry
+  (constr * types * Univ.ContextSet.t) -> hint_entry
 
 (** A constr which is Hint'ed will be:
    - (1) used as an Exact, if it does not start with a product
@@ -260,14 +260,15 @@ val rewrite_db : hint_db_name
 
 (** Printing  hints *)
 
-val pr_searchtable : unit -> Pp.t
+val pr_searchtable : env -> evar_map -> Pp.t
 val pr_applicable_hint : unit -> Pp.t
-val pr_hint_ref : global_reference -> Pp.t
-val pr_hint_db_by_name : hint_db_name -> Pp.t
+val pr_hint_ref : env -> evar_map -> global_reference -> Pp.t
+val pr_hint_db_by_name : env -> evar_map -> hint_db_name -> Pp.t
+val pr_hint_db_env : env -> evar_map -> Hint_db.t -> Pp.t
 val pr_hint_db : Hint_db.t -> Pp.t
-val pr_hint : hint -> Pp.t
+[@@ocaml.deprecated "please used pr_hint_db_env"]
+val pr_hint : env -> evar_map -> hint -> Pp.t
 
 (** Hook for changing the initialization of auto *)
-
 val add_hints_init : (unit -> unit) -> unit
 
diff --git a/tactics/hipattern.ml b/tactics/hipattern.ml
index b057cf72b..2bb9be66b 100644
--- a/tactics/hipattern.ml
+++ b/tactics/hipattern.ml
@@ -39,7 +39,6 @@ type testing_function  = Evd.evar_map -> EConstr.constr -> bool
 let mkmeta n = Nameops.make_ident "X" (Some n)
 let meta1 = mkmeta 1
 let meta2 = mkmeta 2
-let meta3 = mkmeta 3
 
 let op2bool = function Some _ -> true | None -> false
 
@@ -49,7 +48,7 @@ let match_with_non_recursive_type sigma t =
         let (hdapp,args) = decompose_app sigma t in
         (match EConstr.kind sigma hdapp with
            | Ind (ind,u) ->
-               if (Global.lookup_mind (fst ind)).mind_finite == Decl_kinds.CoFinite then
+               if (Global.lookup_mind (fst ind)).mind_finite == CoFinite then
 		 Some (hdapp,args)
 	       else
 		 None
@@ -89,6 +88,12 @@ let is_lax_conjunction = function
 
 let prod_assum sigma t = fst (decompose_prod_assum sigma t)
 
+(* whd_beta normalize the types of arguments in a product *)
+let rec whd_beta_prod sigma c = match EConstr.kind sigma c with
+  | Prod (n,t,c) -> mkProd (n,Reductionops.whd_beta sigma t,whd_beta_prod sigma c)
+  | LetIn (n,d,t,c) -> mkLetIn (n,d,t,whd_beta_prod sigma c)
+  | _ -> c
+
 let match_with_one_constructor sigma style onlybinary allow_rec t =
   let (hdapp,args) = decompose_app sigma t in
   let res = match EConstr.kind sigma hdapp with
@@ -112,7 +117,9 @@ let match_with_one_constructor sigma style onlybinary allow_rec t =
 	    Some (hdapp,args)
 	  else None
 	else
-	  let ctyp = Termops.prod_applist sigma (EConstr.of_constr mip.mind_nf_lc.(0)) args in
+          let ctyp = whd_beta_prod sigma
+            (Termops.prod_applist_assum sigma (Context.Rel.length mib.mind_params_ctxt)
+                       (EConstr.of_constr mip.mind_nf_lc.(0)) args) in
 	  let cargs = List.map RelDecl.get_type (prod_assum sigma ctyp) in
 	  if not (is_lax_conjunction style) || has_nodep_prod sigma ctyp then
 	    (* Record or non strict conjunction *)
@@ -160,7 +167,7 @@ let test_strict_disjunction n lc =
   let open Term in
   Array.for_all_i (fun i c ->
     match (prod_assum (snd (decompose_prod_n_assum n c))) with
-    | [LocalAssum (_,c)] -> isRel c && Int.equal (destRel c) (n - i)
+    | [LocalAssum (_,c)] -> Constr.isRel c && Int.equal (Constr.destRel c) (n - i)
     | _ -> false) 0 lc
 
 let match_with_disjunction ?(strict=false) ?(onlybinary=false) sigma t =
@@ -252,16 +259,16 @@ open Decl_kinds
 open Evar_kinds
 
 let mkPattern c = snd (Patternops.pattern_of_glob_constr c)
-let mkGApp f args = CAst.make @@ GApp (f, args)
-let mkGHole = CAst.make @@
+let mkGApp f args = DAst.make @@ GApp (f, args)
+let mkGHole = DAst.make @@
   GHole (QuestionMark (Define false,Anonymous), Misctypes.IntroAnonymous, None)
-let mkGProd id c1 c2 = CAst.make @@
+let mkGProd id c1 c2 = DAst.make @@
   GProd (Name (Id.of_string id), Explicit, c1, c2)
-let mkGArrow c1 c2 = CAst.make @@
+let mkGArrow c1 c2 = DAst.make @@
   GProd (Anonymous, Explicit, c1, c2)
-let mkGVar id = CAst.make @@ GVar (Id.of_string id)
-let mkGPatVar id = CAst.make @@ GPatVar(Evar_kinds.FirstOrderPatVar (Id.of_string id))
-let mkGRef r = CAst.make @@ GRef (Lazy.force r, None)
+let mkGVar id = DAst.make @@ GVar (Id.of_string id)
+let mkGPatVar id = DAst.make @@ GPatVar(Evar_kinds.FirstOrderPatVar (Id.of_string id))
+let mkGRef r = DAst.make @@ GRef (Lazy.force r, None)
 let mkGAppRef r args = mkGApp (mkGRef r) args
 
 (** forall x : _, _ x x *)
@@ -365,36 +372,39 @@ let is_forall_term sigma c = op2bool (match_with_forall_term sigma c)
 
 let match_with_nodep_ind sigma t =
   let (hdapp,args) = decompose_app sigma t in
-    match EConstr.kind sigma hdapp with
-      | Ind (ind, _)  ->
-          let (mib,mip) = Global.lookup_inductive ind in
-	    if Array.length (mib.mind_packets)>1 then None else
-	      let nodep_constr c = has_nodep_prod_after mib.mind_nparams sigma (EConstr.of_constr c) in
-		if Array.for_all nodep_constr mip.mind_nf_lc then
-		  let params=
-		    if Int.equal mip.mind_nrealargs 0 then args else
-		      fst (List.chop mib.mind_nparams args) in
-		    Some (hdapp,params,mip.mind_nrealargs)
-		else
-		  None
-      | _ -> None
+  match EConstr.kind sigma hdapp with
+  | Ind (ind, _)  ->
+     let (mib,mip) = Global.lookup_inductive ind in
+     if Array.length (mib.mind_packets)>1 then None else
+       let nodep_constr c =
+         has_nodep_prod_after (Context.Rel.length mib.mind_params_ctxt) sigma (EConstr.of_constr c) in
+       if Array.for_all nodep_constr mip.mind_nf_lc then
+         let params=
+           if Int.equal mip.mind_nrealargs 0 then args else
+             fst (List.chop mib.mind_nparams args) in
+         Some (hdapp,params,mip.mind_nrealargs)
+       else
+         None
+  | _ -> None
 
 let is_nodep_ind sigma t = op2bool (match_with_nodep_ind sigma t)
 
 let match_with_sigma_type sigma t =
   let (hdapp,args) = decompose_app sigma t in
   match EConstr.kind sigma hdapp with
-    | Ind (ind, _) ->
-        let (mib,mip) = Global.lookup_inductive ind in
-          if Int.equal (Array.length (mib.mind_packets)) 1 &&
-	    (Int.equal mip.mind_nrealargs 0) &&
-	    (Int.equal (Array.length mip.mind_consnames)1) &&
-	    has_nodep_prod_after (mib.mind_nparams+1) sigma (EConstr.of_constr mip.mind_nf_lc.(0)) then
-	      (*allowing only 1 existential*)
-	      Some (hdapp,args)
-	  else
-	    None
-    | _ -> None
+  | Ind (ind, _) ->
+     let (mib,mip) = Global.lookup_inductive ind in
+     if Int.equal (Array.length (mib.mind_packets)) 1
+        && (Int.equal mip.mind_nrealargs 0)
+        && (Int.equal (Array.length mip.mind_consnames)1)
+        && has_nodep_prod_after (Context.Rel.length mib.mind_params_ctxt + 1) sigma
+             (EConstr.of_constr mip.mind_nf_lc.(0))
+     then
+       (*allowing only 1 existential*)
+       Some (hdapp,args)
+     else
+       None
+  | _ -> None
 
 let is_sigma_type sigma t = op2bool (match_with_sigma_type sigma t)
 
@@ -460,22 +470,6 @@ let find_this_eq_data_decompose gl eqn =
       user_err Pp.(str "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 (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_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 =
-  try
-    snd (first_match (match_eq_nf gls eqn) equalities)
-  with PatternMatchingFailure ->
-    user_err Pp.(str "Not an equality.")
-
 (*** Sigma-types *)
 
 let match_sigma env sigma ex =
diff --git a/tactics/hipattern.mli b/tactics/hipattern.mli
index 8ff6fe95c..01d916053 100644
--- a/tactics/hipattern.mli
+++ b/tactics/hipattern.mli
@@ -120,11 +120,11 @@ val match_with_equation:
 
 (** Match terms [eq A t u], [identity A t u] or [JMeq A t A u] 
    Returns associated lemmas and [A,t,u] or fails PatternMatchingFailure *)
-val find_eq_data_decompose : 'a Proofview.Goal.t -> constr ->
+val find_eq_data_decompose : Proofview.Goal.t -> constr ->
       coq_eq_data * EInstance.t * (types * constr * constr)
 
 (** Idem but fails with an error message instead of PatternMatchingFailure *)
-val find_this_eq_data_decompose : 'a Proofview.Goal.t -> constr ->
+val find_this_eq_data_decompose : Proofview.Goal.t -> constr ->
       coq_eq_data * EInstance.t * (types * constr * constr)
 
 (** A variant that returns more informative structure on the equality found *)
@@ -144,9 +144,6 @@ val is_matching_sigma : Environ.env -> evar_map -> constr -> bool
    [t,u,T] and a boolean telling if equality is on the left side *)
 val match_eqdec : Environ.env -> evar_map -> constr -> bool * Globnames.global_reference * constr * constr * constr
 
-(** Match an equality up to conversion; returns [(eq,t1,t2)] in normal form *)
-val dest_nf_eq : 'a Proofview.Goal.t -> constr -> (constr * constr * constr)
-
 (** Match a negation *)
 val is_matching_not : Environ.env -> evar_map -> constr -> bool
 val is_matching_imp_False : Environ.env -> evar_map -> constr -> bool
diff --git a/tactics/ind_tables.ml b/tactics/ind_tables.ml
index 7f087ea01..bc2fea2bd 100644
--- a/tactics/ind_tables.ml
+++ b/tactics/ind_tables.ml
@@ -17,7 +17,7 @@ open Mod_subst
 open Libobject
 open Nameops
 open Declarations
-open Term
+open Constr
 open CErrors
 open Util
 open Declare
@@ -29,7 +29,7 @@ open Pp
 (* Registering schemes in the environment *)
 
 type mutual_scheme_object_function =
-  internal_flag -> mutual_inductive -> constr array Evd.in_evar_universe_context * Safe_typing.private_constants
+  internal_flag -> MutInd.t -> constr array Evd.in_evar_universe_context * Safe_typing.private_constants
 type individual_scheme_object_function =
   internal_flag -> inductive -> constr Evd.in_evar_universe_context * Safe_typing.private_constants
 
@@ -57,7 +57,7 @@ let discharge_scheme (_,(kind,l)) =
   Some (kind,Array.map (fun (ind,const) ->
     (Lib.discharge_inductive ind,Lib.discharge_con const)) l)
 
-let inScheme : string * (inductive * constant) array -> obj =
+let inScheme : string * (inductive * Constant.t) array -> obj =
   declare_object {(default_object "SCHEME") with
                     cache_function = cache_scheme;
                     load_function = (fun _ -> cache_scheme);
@@ -121,12 +121,10 @@ let define internal id c p univs =
   let fd = declare_constant ~internal in
   let id = compute_name internal id in
   let ctx = Evd.normalize_evar_universe_context univs in
-  let c = Vars.subst_univs_fn_constr 
-    (Universes.make_opt_subst (Evd.evar_universe_context_subst ctx)) c in
-  let univs = Evd.evar_context_universe_context ctx in
+  let c = Universes.subst_opt_univs_constr (Evd.evar_universe_context_subst ctx) c in
   let univs =
-    if p then Polymorphic_const_entry univs
-    else Monomorphic_const_entry univs
+    if p then Polymorphic_const_entry (UState.context ctx)
+    else Monomorphic_const_entry (UState.context_set ctx)
   in
   let entry = {
     const_entry_body =
diff --git a/tactics/ind_tables.mli b/tactics/ind_tables.mli
index f825c4f4a..d73595a2f 100644
--- a/tactics/ind_tables.mli
+++ b/tactics/ind_tables.mli
@@ -6,8 +6,8 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Term
 open Names
+open Constr
 open Declare
 
 (** This module provides support for registering inductive scheme builders,
@@ -20,7 +20,7 @@ type individual
 type 'a scheme_kind
 
 type mutual_scheme_object_function =
-  internal_flag -> mutual_inductive -> constr array Evd.in_evar_universe_context * Safe_typing.private_constants
+  internal_flag -> MutInd.t -> constr array Evd.in_evar_universe_context * Safe_typing.private_constants
 type individual_scheme_object_function =
   internal_flag -> inductive -> constr Evd.in_evar_universe_context * Safe_typing.private_constants
 
@@ -37,13 +37,13 @@ val declare_individual_scheme_object : string -> ?aux:string ->
 
 val define_individual_scheme : individual scheme_kind -> 
   internal_flag (** internal *) ->
-  Id.t option -> inductive -> constant * Safe_typing.private_constants
+  Id.t option -> inductive -> Constant.t * Safe_typing.private_constants
 
 val define_mutual_scheme : mutual scheme_kind -> internal_flag (** internal *) ->
-  (int * Id.t) list -> mutual_inductive -> constant array * Safe_typing.private_constants
+  (int * Id.t) list -> MutInd.t -> Constant.t array * Safe_typing.private_constants
 
 (** Main function to retrieve a scheme in the cache or to generate it *)
-val find_scheme : ?mode:internal_flag -> 'a scheme_kind -> inductive -> constant * Safe_typing.private_constants
+val find_scheme : ?mode:internal_flag -> 'a scheme_kind -> inductive -> Constant.t * Safe_typing.private_constants
 
 val check_scheme : 'a scheme_kind -> inductive -> bool
 
diff --git a/tactics/inv.ml b/tactics/inv.ml
index 9495ca9c5..5435b63ce 100644
--- a/tactics/inv.ml
+++ b/tactics/inv.ml
@@ -10,7 +10,6 @@ open Pp
 open CErrors
 open Util
 open Names
-open Nameops
 open Term
 open Termops
 open EConstr
@@ -78,7 +77,7 @@ let make_inv_predicate env evd indf realargs id status concl =
       | Dep dflt_concl ->
 	  if not (occur_var env !evd id concl) then
 	    user_err ~hdr:"make_inv_predicate"
-              (str "Current goal does not depend on " ++ pr_id id ++ str".");
+              (str "Current goal does not depend on " ++ Id.print id ++ str".");
           (* We abstract the conclusion of goal with respect to
              realargs and c to * be concl in order to rewrite and have
              c also rewritten when the case * will be done *)
@@ -283,10 +282,11 @@ let generalizeRewriteIntros as_mode tac depids id =
 let error_too_many_names pats =
   let loc = Loc.merge_opt (fst (List.hd pats)) (fst (List.last pats)) in
   Proofview.tclENV >>= fun env ->
+  Proofview.tclEVARMAP >>= fun sigma ->
   tclZEROMSG ?loc (
     str "Unexpected " ++
     str (String.plural (List.length pats) "introduction pattern") ++
-    str ": " ++ pr_enum (Miscprint.pr_intro_pattern (fun c -> Printer.pr_constr (EConstr.Unsafe.to_constr (snd (c env Evd.empty))))) pats ++
+    str ": " ++ pr_enum (Miscprint.pr_intro_pattern (fun c -> Printer.pr_constr_env env sigma (EConstr.Unsafe.to_constr (snd (c env Evd.empty))))) pats ++
     str ".")
 
 let get_names (allow_conj,issimple) (loc, pat as x) = match pat with
@@ -334,6 +334,16 @@ let remember_first_eq id x = if !x == MoveLast then x := MoveAfter id
    If it can discriminate then the goal is proved, if not tries to use it as
    a rewrite rule. It erases the clause which is given as input *)
 
+let dest_nf_eq env sigma t = match EConstr.kind sigma t with
+| App (r, [| t; x; y |]) ->
+  let open Reductionops in
+  let lazy eq = Coqlib.coq_eq_ref in
+  if EConstr.is_global sigma eq r then
+    (t, whd_all env sigma x, whd_all env sigma y)
+  else user_err Pp.(str "Not an equality.")
+| _ ->
+  user_err Pp.(str "Not an equality.")
+
 let projectAndApply as_mode thin avoid id eqname names depids =
   let subst_hyp l2r id =
     tclTHEN (tclTRY(rewriteInConcl l2r (EConstr.mkVar id)))
@@ -343,8 +353,8 @@ let projectAndApply as_mode thin avoid id eqname names depids =
     Proofview.Goal.enter begin fun gl ->
     let sigma = project gl in
     (** We only look at the type of hypothesis "id" *)
-    let hyp = pf_nf_evar gl (pf_get_hyp_typ id (Proofview.Goal.assume gl)) in
-    let (t,t1,t2) = Hipattern.dest_nf_eq gl hyp in
+    let hyp = pf_nf_evar gl (pf_get_hyp_typ id gl) in
+    let (t,t1,t2) = dest_nf_eq (pf_env gl) sigma hyp in
     match (EConstr.kind sigma t1, EConstr.kind sigma t2) with
     | Var id1, _ -> generalizeRewriteIntros as_mode (subst_hyp true id) depids id1
     | _, Var id2 -> generalizeRewriteIntros as_mode (subst_hyp false id) depids id2
@@ -371,7 +381,7 @@ let projectAndApply as_mode thin avoid id eqname names depids =
     (* If no immediate variable in the equation, try to decompose it *)
     (* and apply a trailer which again try to substitute *)
     (fun id ->
-      dEqThen false (deq_trailer id)
+      dEqThen ~keep_proofs:None false (deq_trailer id)
 	(Some (None,ElimOnConstr (EConstr.mkVar id,NoBindings))))
     id
 
@@ -387,7 +397,7 @@ let rewrite_equations as_mode othin neqns names ba =
   Proofview.Goal.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 NamedDecl.get_id nodepids else [] in
+  let avoid = if as_mode then Id.Set.of_list (List.map NamedDecl.get_id nodepids) else Id.Set.empty in
   match othin with
     | Some thin ->
         tclTHENLIST
@@ -442,7 +452,7 @@ let raw_inversion inv_kind id status names =
     let (ind, t) =
       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
+        let msg = str "The type of " ++ Id.print id ++ str " is not inductive." in
         CErrors.user_err  msg
     in
     let IndType (indf,realargs) = find_rectype env sigma t in
diff --git a/tactics/leminv.ml b/tactics/leminv.ml
index aeb80ae57..197b3030d 100644
--- a/tactics/leminv.ml
+++ b/tactics/leminv.ml
@@ -142,7 +142,7 @@ let rec add_prods_sign env sigma t =
 
 let compute_first_inversion_scheme env sigma ind sort dep_option =
   let indf,realargs = dest_ind_type ind in
-  let allvars = ids_of_context env in
+  let allvars = vars_of_env env in
   let p = next_ident_away (Id.of_string "P") allvars in
   let pty,goal =
     if dep_option  then
@@ -214,15 +214,15 @@ let inversion_scheme env sigma t sort dep_option inv_op =
 	 else Context.Named.add d sign)
       invEnv ~init:Context.Named.empty
   end in
-  let avoid = ref [] in
-  let { sigma=sigma } = Proof.V82.subgoals pf in
+  let avoid = ref Id.Set.empty in
+  let _,_,_,_,sigma = Proof.proof pf in
   let sigma = Evd.nf_constraints sigma in
   let rec fill_holes c =
     match EConstr.kind sigma c with
     | Evar (e,args) ->
 	let h = next_ident_away (Id.of_string "H") !avoid in
 	let ty,inst = Evarutil.generalize_evar_over_rels sigma (e,args) in
-	avoid := h::!avoid;
+	avoid := Id.Set.add h !avoid;
 	ownSign := Context.Named.add (LocalAssum (h,ty)) !ownSign;
 	applist (mkVar h, inst)
     | _ -> EConstr.map sigma fill_holes c
@@ -232,25 +232,27 @@ let inversion_scheme env sigma t sort dep_option inv_op =
   let invProof = it_mkNamedLambda_or_LetIn c !ownSign in
   let invProof = EConstr.Unsafe.to_constr invProof in
   let p = Evarutil.nf_evars_universes sigma invProof in
-    p, Evd.universe_context sigma
+    p, sigma
 
-let add_inversion_lemma name env sigma t sort dep inv_op =
-  let invProof, ctx = inversion_scheme env sigma t sort dep inv_op in
-  let entry = definition_entry ~poly:(Flags.use_polymorphic_flag ())
-			       ~univs:(snd ctx) invProof in
+let add_inversion_lemma ~poly name env sigma t sort dep inv_op =
+  let invProof, sigma = inversion_scheme env sigma t sort dep inv_op in
+  let univs =
+    Evd.const_univ_entry ~poly sigma
+  in
+  let entry = definition_entry ~univs invProof in
   let _ = declare_constant name (DefinitionEntry entry, IsProof Lemma) in
   ()
 
 (* inv_op = Inv (derives de complete inv. lemma)
  * inv_op = InvNoThining (derives de semi inversion lemma) *)
 
-let add_inversion_lemma_exn na com comsort bool tac =
+let add_inversion_lemma_exn ~poly na com comsort bool tac =
   let env = Global.env () in
-  let evd = ref (Evd.from_env env) in
-  let c = Constrintern.interp_type_evars env evd com in
-  let sigma, sort = Pretyping.interp_sort !evd comsort in
+  let sigma = Evd.from_env env in
+  let sigma, c = Constrintern.interp_type_evars env sigma com in
+  let sigma, sort = Evd.fresh_sort_in_family ~rigid:univ_rigid env sigma comsort in
   try
-    add_inversion_lemma na env sigma c sort bool tac
+    add_inversion_lemma ~poly na env sigma c sort bool tac
   with
     |   UserError (Some "Case analysis",s) -> (* Reference to Indrec *)
 	  user_err ~hdr:"Inv needs Nodep Prop Set" s
diff --git a/tactics/leminv.mli b/tactics/leminv.mli
index 41b0e09b4..f221b1fd9 100644
--- a/tactics/leminv.mli
+++ b/tactics/leminv.mli
@@ -14,6 +14,6 @@ open Misctypes
 val lemInv_clause :
   quantified_hypothesis -> constr -> Id.t list -> unit Proofview.tactic
 
-val add_inversion_lemma_exn :
-  Id.t -> constr_expr -> glob_sort -> bool -> (Id.t -> unit Proofview.tactic) ->
+val add_inversion_lemma_exn : poly:bool ->
+  Id.t -> constr_expr -> Sorts.family -> bool -> (Id.t -> unit Proofview.tactic) ->
     unit
diff --git a/tactics/tacticals.ml b/tactics/tacticals.ml
index bce0dda10..e7da17cff 100644
--- a/tactics/tacticals.ml
+++ b/tactics/tacticals.ml
@@ -10,7 +10,7 @@ open Pp
 open CErrors
 open Util
 open Names
-open Term
+open Constr
 open EConstr
 open Termops
 open Declarations
@@ -224,9 +224,8 @@ let compute_induction_names = compute_induction_names_gen true
 
 (* Compute the let-in signature of case analysis or standard induction scheme *)
 let compute_constructor_signatures isrec ((_,k as ity),u) =
-  let open Term in
   let rec analrec c recargs =
-    match kind_of_term c, recargs with
+    match Constr.kind c, recargs with
     | Prod (_,_,c), recarg::rest ->
         let rest = analrec c rest in
         begin match Declareops.dest_recarg recarg with
@@ -242,7 +241,7 @@ let compute_constructor_signatures isrec ((_,k as ity),u) =
   let (mib,mip) = Global.lookup_inductive ity in
   let n = mib.mind_nparams in
   let lc =
-    Array.map (fun c -> snd (decompose_prod_n_assum n c)) mip.mind_nf_lc in
+    Array.map (fun c -> snd (Term.decompose_prod_n_assum n c)) mip.mind_nf_lc in
   let lrecargs = Declareops.dest_subterms mip.mind_recargs in
   Array.map2 analrec lc lrecargs
 
@@ -472,7 +471,7 @@ module New = struct
       let evi = Evd.find sigma evk in
       match Evd.evar_body evi with
       | Evd.Evar_empty -> Some (evk,evi)
-      | Evd.Evar_defined c -> match Term.kind_of_term c with
+      | Evd.Evar_defined c -> match Constr.kind c with
         | Term.Evar (evk,l) -> is_undefined_up_to_restriction sigma evk
         | _ -> 
           (* We make the assumption that there is no way to refine an
@@ -541,7 +540,6 @@ module New = struct
 
   let nthHypId m gl =
     (** We only use [id] *)
-    let gl = Proofview.Goal.assume gl in
     nthDecl m gl |> NamedDecl.get_id
   let nthHyp m gl = 
     mkVar (nthHypId m gl)
@@ -573,7 +571,7 @@ module New = struct
 
   let afterHyp id tac =
     Proofview.Goal.enter begin fun gl ->
-    let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
+    let hyps = Proofview.Goal.hyps gl in
     let rem, _ = List.split_when (NamedDecl.get_id %> Id.equal id) hyps in
     tac rem
     end
@@ -622,8 +620,8 @@ module New = struct
       | _ ->
 	  let name_elim =
 	    match EConstr.kind sigma elim with
-	    | Const (kn, _) -> string_of_con kn
-	    | Var id -> string_of_id id
+	    | Const (kn, _) -> Constant.to_string kn
+	    | Var id -> Id.to_string id
 	    | _ -> "\b"
 	  in
 	  user_err ~hdr:"Tacticals.general_elim_then_using"
@@ -659,12 +657,12 @@ module New = struct
 
   let elimination_sort_of_goal gl =
     (** Retyping will expand evars anyway. *)
-    let c = Proofview.Goal.concl (Goal.assume gl) in
+    let c = Proofview.Goal.concl gl in
     pf_apply Retyping.get_sort_family_of gl c
 
   let elimination_sort_of_hyp id gl =
     (** Retyping will expand evars anyway. *)
-    let c = pf_get_hyp_typ id (Goal.assume gl) in
+    let c = pf_get_hyp_typ id gl in
     pf_apply Retyping.get_sort_family_of gl c
 
   let elimination_sort_of_clause id gl = match id with
diff --git a/tactics/tacticals.mli b/tactics/tacticals.mli
index 2a04c413b..c5d5c8c12 100644
--- a/tactics/tacticals.mli
+++ b/tactics/tacticals.mli
@@ -7,9 +7,9 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open EConstr
-open Tacmach
+open Evd
 open Proof_type
 open Locus
 open Misctypes
@@ -23,6 +23,7 @@ val tclORELSE0       : tactic -> tactic -> tactic
 val tclORELSE        : tactic -> tactic -> tactic
 val tclTHEN          : tactic -> tactic -> tactic
 val tclTHENSEQ       : tactic list -> tactic
+[@@ocaml.deprecated "alias of Tacticals.tclTHENLIST"]
 val tclTHENLIST      : tactic list -> tactic
 val tclTHEN_i        : tactic -> (int -> tactic) -> tactic
 val tclTHENFIRST     : tactic -> tactic -> tactic
@@ -127,9 +128,9 @@ val compute_constructor_signatures : rec_flag -> inductive * 'a -> bool list arr
 val compute_induction_names :
   bool list array -> or_and_intro_pattern option -> intro_patterns array
 
-val elimination_sort_of_goal : goal sigma -> sorts_family
-val elimination_sort_of_hyp  : Id.t -> goal sigma -> sorts_family
-val elimination_sort_of_clause : Id.t option -> goal sigma -> sorts_family
+val elimination_sort_of_goal : goal sigma -> Sorts.family
+val elimination_sort_of_hyp  : Id.t -> goal sigma -> Sorts.family
+val elimination_sort_of_clause : Id.t option -> goal sigma -> Sorts.family
 
 val pf_with_evars :  (goal sigma -> Evd.evar_map * 'a) -> ('a -> tactic) -> tactic
 val pf_constr_of_global : Globnames.global_reference -> (constr -> tactic) -> tactic
@@ -224,28 +225,28 @@ module New : sig
   val tclTIMEOUT : int -> unit tactic -> unit tactic
   val tclTIME : string option -> 'a tactic -> 'a tactic
 
-  val nLastDecls  : 'a Proofview.Goal.t -> int -> named_context
+  val nLastDecls  : Proofview.Goal.t -> int -> named_context
 
-  val ifOnHyp     : (identifier * types -> bool) ->
-    (identifier -> unit Proofview.tactic) -> (identifier -> unit Proofview.tactic) ->
-    identifier -> unit Proofview.tactic
+  val ifOnHyp     : (Id.t * types -> bool) ->
+    (Id.t -> unit Proofview.tactic) -> (Id.t -> unit Proofview.tactic) ->
+    Id.t -> unit Proofview.tactic
 
-  val onNthHypId : int -> (identifier -> unit tactic) -> unit tactic
-  val onLastHypId      : (identifier -> unit tactic) -> unit tactic
+  val onNthHypId : int -> (Id.t -> unit tactic) -> unit tactic
+  val onLastHypId      : (Id.t -> unit tactic) -> unit tactic
   val onLastHyp        : (constr -> unit tactic) -> unit tactic
   val onLastDecl       : (named_declaration -> unit tactic) -> unit tactic
 
-  val onHyps      : ([ `LZ ] Proofview.Goal.t -> named_context) ->
+  val onHyps      : (Proofview.Goal.t -> named_context) ->
                     (named_context -> unit tactic) -> unit tactic
   val afterHyp    : Id.t -> (named_context -> unit tactic) -> unit tactic
 
-  val tryAllHyps          : (identifier -> unit tactic) -> unit tactic
-  val tryAllHypsAndConcl  : (identifier option -> unit tactic) -> unit tactic
-  val onClause   : (identifier option -> unit tactic) -> clause -> unit tactic
+  val tryAllHyps          : (Id.t -> unit tactic) -> unit tactic
+  val tryAllHypsAndConcl  : (Id.t option -> unit tactic) -> unit tactic
+  val onClause   : (Id.t option -> unit tactic) -> clause -> unit tactic
 
-  val elimination_sort_of_goal : 'a Proofview.Goal.t -> sorts_family
-  val elimination_sort_of_hyp  : Id.t -> 'a Proofview.Goal.t -> sorts_family
-  val elimination_sort_of_clause : Id.t option -> 'a Proofview.Goal.t -> sorts_family
+  val elimination_sort_of_goal : Proofview.Goal.t -> Sorts.family
+  val elimination_sort_of_hyp  : Id.t -> Proofview.Goal.t -> Sorts.family
+  val elimination_sort_of_clause : Id.t option -> Proofview.Goal.t -> Sorts.family
 
   val elimination_then :
     (branch_args -> unit Proofview.tactic) ->
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 67bc55d3f..7e281e2fe 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -14,6 +14,7 @@ open Util
 open Names
 open Nameops
 open Term
+open Constr
 open Termops
 open Environ
 open EConstr
@@ -58,28 +59,6 @@ let typ_of env sigma c =
 
 open Goptions
 
-(* Option for 8.2 compatibility *)
-let dependent_propositions_elimination = ref true
-
-let use_dependent_propositions_elimination () =
-  !dependent_propositions_elimination
-
-let _ =
-  declare_bool_option
-    { optdepr  = true; (* remove in 8.8 *)
-      optname  = "dependent-propositions-elimination tactic";
-      optkey   = ["Dependent";"Propositions";"Elimination"];
-      optread  = (fun () -> !dependent_propositions_elimination) ;
-      optwrite = (fun b -> dependent_propositions_elimination := b) }
-
-let _ =
-  declare_bool_option
-    { optdepr  = false;
-      optname  = "trigger bugged context matching compatibility";
-      optkey   = ["Tactic";"Compat";"Context"];
-      optread  = (fun () -> !Flags.tactic_context_compat) ;
-      optwrite = (fun b -> Flags.tactic_context_compat := b) }
-
 let apply_solve_class_goals = ref false
 
 let _ =
@@ -172,7 +151,6 @@ let unsafe_intro env store decl b =
 
 let introduction ?(check=true) id =
   Proofview.Goal.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 = named_context_val (Proofview.Goal.env gl) in
@@ -180,13 +158,13 @@ let introduction ?(check=true) id =
     let env = Proofview.Goal.env gl in
     let () = if check && mem_named_context_val id hyps then
       user_err ~hdr:"Tactics.introduction"
-        (str "Variable " ++ pr_id id ++ str " is already declared.")
+        (str "Variable " ++ Id.print id ++ str " is already declared.")
     in
     let open Context.Named.Declaration in
     match EConstr.kind 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
-    | _ -> raise (RefinerError IntroNeedsProduct)
+    | _ -> raise (RefinerError (env, sigma, IntroNeedsProduct))
   end
 
 let refine          = Tacmach.refine
@@ -243,11 +221,11 @@ let convert_leq x y = convert_gen Reduction.CUMUL x y
 
 let clear_dependency_msg env sigma id = function
   | Evarutil.OccurHypInSimpleClause None ->
-      pr_id id ++ str " is used in conclusion."
+      Id.print id ++ str " is used in conclusion."
   | Evarutil.OccurHypInSimpleClause (Some id') ->
-      pr_id id ++ strbrk " is used in hypothesis " ++ pr_id id' ++ str"."
+      Id.print id ++ strbrk " is used in hypothesis " ++ Id.print id' ++ str"."
   | Evarutil.EvarTypingBreak ev ->
-      str "Cannot remove " ++ pr_id id ++
+      str "Cannot remove " ++ Id.print id ++
       strbrk " without breaking the typing of " ++
       Printer.pr_existential env sigma ev ++ str"."
 
@@ -256,12 +234,12 @@ let error_clear_dependency env sigma id err =
 
 let replacing_dependency_msg env sigma id = function
   | Evarutil.OccurHypInSimpleClause None ->
-      str "Cannot change " ++ pr_id id ++ str ", it is used in conclusion."
+      str "Cannot change " ++ Id.print id ++ str ", it is used in conclusion."
   | Evarutil.OccurHypInSimpleClause (Some id') ->
-      str "Cannot change " ++ pr_id id ++
-      strbrk ", it is used in hypothesis " ++ pr_id id' ++ str"."
+      str "Cannot change " ++ Id.print id ++
+      strbrk ", it is used in hypothesis " ++ Id.print id' ++ str"."
   | Evarutil.EvarTypingBreak ev ->
-      str "Cannot change " ++ pr_id id ++
+      str "Cannot change " ++ Id.print id ++
       strbrk " without breaking the typing of " ++
       Printer.pr_existential env sigma ev ++ str"."
 
@@ -279,7 +257,6 @@ let clear_gen fail = function
   Proofview.Goal.enter begin fun gl ->
     let ids = List.fold_right Id.Set.add ids Id.Set.empty in
     (** clear_hyps_in_evi does not require nf terms *)
-    let gl = Proofview.Goal.assume gl in
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
     let concl = Proofview.Goal.concl gl in
@@ -318,7 +295,7 @@ let move_hyp id dest =
     let ty = Proofview.Goal.concl gl in
     let store = Proofview.Goal.extra gl in
     let sign = named_context_val env in
-    let sign' = move_hyp_in_named_context sigma id dest sign in
+    let sign' = move_hyp_in_named_context env sigma id dest sign in
     let env = reset_with_named_context sign' env in
     Refine.refine ~typecheck:false begin fun sigma ->
       Evarutil.new_evar env sigma ~principal:true ~store ty
@@ -343,23 +320,24 @@ let rename_hyp repl =
   | None -> Tacticals.New.tclZEROMSG (str "Not a one-to-one name mapping")
   | Some (src, dst) ->
     Proofview.Goal.enter begin fun gl ->
-      let gl = Proofview.Goal.assume gl in
       let hyps = Proofview.Goal.hyps gl in
       let concl = Proofview.Goal.concl gl in
       let store = Proofview.Goal.extra gl in
+      let env = Proofview.Goal.env gl in
+      let sigma = Proofview.Goal.sigma gl in
       (** Check that we do not mess variables *)
       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
           let hyp = Id.Set.choose (Id.Set.diff src vars) in
-          raise (RefinerError (NoSuchHyp hyp))
+          raise (RefinerError (env, sigma, NoSuchHyp hyp))
       in
       let mods = Id.Set.diff vars src in
       let () =
         try
           let elt = Id.Set.choose (Id.Set.inter dst mods) in
-          CErrors.user_err  (pr_id elt ++ str " is already used")
+          CErrors.user_err  (Id.print elt ++ str " is already used")
         with Not_found -> ()
       in
       (** All is well *)
@@ -384,7 +362,9 @@ let rename_hyp repl =
 (**************************************************************)
 
 let fresh_id_in_env avoid id env =
-  next_ident_away_in_goal id (avoid@ids_of_named_context (named_context env))
+  let avoid' = ids_of_named_context_val (named_context_val env) in
+  let avoid = if Id.Set.is_empty avoid then avoid' else Id.Set.union avoid' avoid in
+  next_ident_away_in_goal id avoid
 
 let fresh_id avoid id gl =
   fresh_id_in_env avoid id (pf_env gl)
@@ -412,12 +392,12 @@ let default_id env sigma decl =
    possibly a move to do after the introduction *)
 
 type name_flag =
-  | NamingAvoid of Id.t list
-  | NamingBasedOn of Id.t * Id.t list
+  | NamingAvoid of Id.Set.t
+  | NamingBasedOn of Id.t * Id.Set.t
   | NamingMustBe of Id.t Loc.located
 
 let naming_of_name = function
-  | Anonymous -> NamingAvoid []
+  | Anonymous -> NamingAvoid Id.Set.empty
   | Name id -> NamingMustBe (Loc.tag id)
 
 let find_name mayrepl decl naming gl = match naming with
@@ -429,19 +409,19 @@ let find_name mayrepl decl naming gl = match naming with
   | NamingBasedOn (id,idl) ->  new_fresh_id idl id gl
   | NamingMustBe (loc,id) ->
       (* When name is given, we allow to hide a global name *)
-      let ids_of_hyps = Tacmach.New.pf_ids_of_hyps gl in
+      let ids_of_hyps = Tacmach.New.pf_ids_set_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  (pr_id id ++ str" is already used.");
+        user_err ?loc  (Id.print id ++ str" is already used.");
       id
 
 (**************************************************************)
 (*   Computing position of hypotheses for replacing           *)
 (**************************************************************)
 
-let get_next_hyp_position id =
+let get_next_hyp_position env sigma id =
   let rec aux = function
-  | [] -> error_no_such_hypothesis id
+  | [] -> error_no_such_hypothesis env sigma id
   | decl :: right ->
     if Id.equal (NamedDecl.get_id decl) id then
       match right with decl::_ -> MoveBefore (NamedDecl.get_id decl) | [] -> MoveFirst
@@ -450,9 +430,9 @@ let get_next_hyp_position id =
   in
   aux
 
-let get_previous_hyp_position id =
+let get_previous_hyp_position env sigma id =
   let rec aux dest = function
-  | [] -> error_no_such_hypothesis id
+  | [] -> error_no_such_hypothesis env sigma id
   | decl :: right ->
       let hyp = NamedDecl.get_id decl in
       if Id.equal hyp id then dest else aux (MoveAfter hyp) right
@@ -480,15 +460,15 @@ let internal_cut_gen ?(check=true) dir replace id t =
     let sign = named_context_val env in
     let sign',t,concl,sigma =
       if replace then
-        let nexthyp = get_next_hyp_position id (named_context_of_val sign) in
+        let nexthyp = get_next_hyp_position env sigma id (named_context_of_val sign) in
         let sign',t,concl,sigma = clear_hyps2 env sigma (Id.Set.singleton id) sign t concl in
         let sign' = insert_decl_in_named_context sigma (LocalAssum (id,t)) nexthyp sign' in
         sign',t,concl,sigma
       else
         (if check && mem_named_context_val id sign then
-	   user_err (str "Variable " ++ pr_id id ++ str " is already declared.");
+	   user_err (str "Variable " ++ Id.print id ++ str " is already declared.");
          push_named_context_val (LocalAssum (id,t)) sign,t,concl,sigma) in
-    let nf_t = nf_betaiota sigma t in
+    let nf_t = nf_betaiota env sigma t in
     Proofview.tclTHEN
       (Proofview.Unsafe.tclEVARS sigma)
       (Refine.refine ~typecheck:false begin fun sigma ->
@@ -578,11 +558,11 @@ let mutual_fix f n rest j = Proofview.Goal.enter begin fun gl ->
   | (f, n, ar) :: oth ->
     let open Context.Named.Declaration in
     let (sp', u')  = check_mutind env sigma n ar in
-    if not (eq_mind sp sp') then
+    if not (MutInd.equal sp sp') then
       error "Fixpoints should be on the same mutual inductive declaration.";
     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");
+        (str "Name " ++ Id.print f ++ str " already used in the environment");
     mk_sign (push_named_context_val (LocalAssum (f, ar)) sign) oth
   in
   let nenv = reset_with_named_context (mk_sign (named_context_val env) all) env in
@@ -603,7 +583,7 @@ let fix ido n = match ido with
   | None ->
     Proofview.Goal.enter begin fun gl ->
       let name = Proof_global.get_current_proof_name () in
-      let id = new_fresh_id [] name gl in
+      let id = new_fresh_id Id.Set.empty name gl in
       mutual_fix id n [] 0
     end
   | Some id ->
@@ -654,7 +634,7 @@ let cofix ido = match ido with
   | None ->
     Proofview.Goal.enter begin fun gl ->
       let name = Proof_global.get_current_proof_name () in
-      let id = new_fresh_id [] name gl in
+      let id = new_fresh_id Id.Set.empty name gl in
       mutual_cofix id [] 0
     end
   | Some id ->
@@ -672,7 +652,7 @@ let pf_reduce_decl redfun where decl gl =
   match decl with
   | LocalAssum (id,ty) ->
       if where == InHypValueOnly then
-	user_err  (pr_id id ++ str " has no value.");
+	user_err  (Id.print id ++ str " has no value.");
       LocalAssum (id,redfun' ty)
   | LocalDef (id,b,ty) ->
       let b' = if where != InHypTypeOnly then redfun' b else b in
@@ -773,7 +753,7 @@ let pf_e_reduce_decl redfun where decl gl =
   match decl with
   | LocalAssum (id,ty) ->
       if where == InHypValueOnly then
-	user_err  (pr_id id ++ str " has no value.");
+	user_err  (Id.print id ++ str " has no value.");
     let (sigma, ty') = redfun sigma ty in
     (sigma, LocalAssum (id, ty'))
   | LocalDef (id,b,ty) ->
@@ -816,7 +796,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
-	user_err  (pr_id id ++ str " has no value.");
+	user_err  (Id.print id ++ str " has no value.");
     let (sigma, ty') = redfun false env sigma ty in
     (sigma, LocalAssum (id, ty'))
   | LocalDef (id,b,ty) ->
@@ -831,13 +811,13 @@ let e_pf_change_decl (redfun : bool -> e_reduction_function) where decl env sigm
 let e_change_in_hyp redfun (id,where) =
   Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
-    let hyp = Tacmach.New.pf_get_hyp id (Proofview.Goal.assume gl) in
+    let hyp = Tacmach.New.pf_get_hyp id gl in
     let (sigma, c) = e_pf_change_decl redfun where hyp (Proofview.Goal.env gl) sigma in
     Proofview.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
     (convert_hyp c)
   end
 
-type change_arg = Pattern.patvar_map -> evar_map -> evar_map * EConstr.constr
+type change_arg = Ltac_pretype.patvar_map -> evar_map -> evar_map * EConstr.constr
 
 let make_change_arg c pats sigma = (sigma, replace_vars (Id.Map.bindings pats) c)
 
@@ -942,10 +922,14 @@ let reduction_clause redexp cl =
 	(None, bind_red_expr_occurrences occs nbcl redexp)) cl
 
 let reduce redexp cl =
-  let trace () =
+  let trace env sigma =
     let open Printer in
-    let pr = (pr_econstr, pr_leconstr, pr_evaluable_reference, pr_constr_pattern) in
-    Pp.(hov 2 (Pputils.pr_red_expr pr str redexp))
+    let pr = (pr_econstr_env, pr_leconstr_env, pr_evaluable_reference, pr_constr_pattern_env) in
+    Pp.(hov 2 (Pputils.pr_red_expr_env env sigma pr str redexp))
+  in
+  let trace () =
+    let sigma, env = Pfedit.get_current_context () in
+    trace env sigma
   in
   Proofview.Trace.name_tactic trace begin
   Proofview.Goal.enter begin fun gl ->
@@ -975,13 +959,13 @@ let unfold_constr = function
    the type to build hyp names, we maintain an environment to be able
    to type dependent hyps. *)
 let find_intro_names ctxt gl =
-  let _, res = List.fold_right
+  let _, res, _ = List.fold_right
     (fun decl acc ->
-      let env,idl = acc in
-      let name = fresh_id idl (default_id env gl.sigma decl) gl in
+      let env,idl,avoid = acc in
+      let name = fresh_id avoid (default_id env gl.sigma decl) gl in
       let newenv = push_rel decl env in
-      (newenv,(name::idl)))
-    ctxt (pf_env gl , []) in
+      (newenv, name :: idl, Id.Set.add name avoid))
+    ctxt (pf_env gl, [], Id.Set.empty) in
   List.rev res
 
 let build_intro_tac id dest tac = match dest with
@@ -993,7 +977,8 @@ let rec intro_then_gen name_flag move_flag force_flag dep_flag tac =
   let open Context.Rel.Declaration in
   Proofview.Goal.enter begin fun gl ->
     let sigma = Tacmach.New.project gl in
-    let concl = Proofview.Goal.concl (Proofview.Goal.assume gl) in
+    let env = Tacmach.New.pf_env gl in
+    let concl = Proofview.Goal.concl gl in
     match EConstr.kind sigma concl with
     | Prod (name,t,u) when not dep_flag || not (noccurn sigma 1 u) ->
         let name = find_name false (LocalAssum (name,t)) name_flag gl in
@@ -1002,7 +987,7 @@ let rec intro_then_gen name_flag move_flag force_flag dep_flag tac =
         let name = find_name false (LocalDef (name,b,t)) name_flag gl in
 	build_intro_tac name move_flag tac
     | _ ->
-	begin if not force_flag then Proofview.tclZERO (RefinerError IntroNeedsProduct)
+        begin if not force_flag then Proofview.tclZERO (RefinerError (env, sigma, IntroNeedsProduct))
             (* Note: red_in_concl includes betaiotazeta and this was like *)
             (* this since at least V6.3 (a pity *)
             (* that intro do betaiotazeta only when reduction is needed; and *)
@@ -1013,7 +998,7 @@ let rec intro_then_gen name_flag move_flag force_flag dep_flag tac =
 	  (Tacticals.New.tclTHEN hnf_in_concl
 	     (intro_then_gen name_flag move_flag false dep_flag tac))
           begin function (e, info) -> match e with
-            | RefinerError IntroNeedsProduct ->
+            | RefinerError (env, sigma, IntroNeedsProduct) ->
                 Tacticals.New.tclZEROMSG (str "No product even after head-reduction.")
             | e -> Proofview.tclZERO ~info e
           end
@@ -1021,18 +1006,18 @@ let rec intro_then_gen name_flag move_flag force_flag dep_flag tac =
 
 let intro_gen n m f d = intro_then_gen n m f d (fun _ -> Proofview.tclUNIT ())
 let intro_mustbe_force id = intro_gen (NamingMustBe (Loc.tag id)) MoveLast true false
-let intro_using id = intro_gen (NamingBasedOn (id,[])) MoveLast false false
+let intro_using id = intro_gen (NamingBasedOn (id, Id.Set.empty)) MoveLast false false
 
-let intro_then = intro_then_gen (NamingAvoid []) MoveLast false false
-let intro = intro_gen (NamingAvoid []) MoveLast false false
-let introf = intro_gen (NamingAvoid []) MoveLast true false
+let intro_then = intro_then_gen (NamingAvoid Id.Set.empty) MoveLast false false
+let intro = intro_gen (NamingAvoid Id.Set.empty) MoveLast false false
+let introf = intro_gen (NamingAvoid Id.Set.empty) MoveLast true false
 let intro_avoiding l = intro_gen (NamingAvoid l) MoveLast false false
 
 let intro_move_avoid idopt avoid hto = match idopt with
   | None -> intro_gen (NamingAvoid avoid) hto true false
   | Some id -> intro_gen (NamingMustBe (Loc.tag id)) hto true false
 
-let intro_move idopt hto = intro_move_avoid idopt [] hto
+let intro_move idopt hto = intro_move_avoid idopt Id.Set.empty hto
 
 (**** Multiple introduction tactics ****)
 
@@ -1052,7 +1037,7 @@ let intro_forthcoming_then_gen name_flag move_flag dep_flag n bound tac =
          (fun id -> aux (n+1) (id::ids))
       end
       begin function (e, info) -> match e with
-      | RefinerError IntroNeedsProduct ->
+      | RefinerError (env, sigma, IntroNeedsProduct) ->
           tac ids
       | e -> Proofview.tclZERO ~info e
       end
@@ -1063,8 +1048,9 @@ let intro_forthcoming_then_gen name_flag move_flag dep_flag n bound tac =
 
 let intro_replacing id =
   Proofview.Goal.enter begin fun gl ->
-  let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
-  let next_hyp = get_next_hyp_position id hyps in
+  let env, sigma = Proofview.Goal.(env gl, sigma gl) in
+  let hyps = Proofview.Goal.hyps gl in
+  let next_hyp = get_next_hyp_position env sigma id hyps in
   Tacticals.New.tclTHENLIST [
     clear_for_replacing [id];
     introduction id;
@@ -1083,8 +1069,9 @@ let intro_replacing id =
 let intros_possibly_replacing ids =
   let suboptimal = true in
   Proofview.Goal.enter begin fun gl ->
-    let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
-    let posl = List.map (fun id -> (id, get_next_hyp_position id hyps)) ids in
+    let env, sigma = Proofview.Goal.(env gl, sigma gl) in
+    let hyps = Proofview.Goal.hyps gl in
+    let posl = List.map (fun id -> (id, get_next_hyp_position env sigma id hyps)) ids in
     Tacticals.New.tclTHEN
       (Tacticals.New.tclMAP (fun id -> 
 	Tacticals.New.tclTRY (clear_for_replacing [id]))
@@ -1097,8 +1084,9 @@ let intros_possibly_replacing ids =
 (* This version assumes that replacement is actually possible *)
 let intros_replacing ids =
   Proofview.Goal.enter begin fun gl ->
-    let hyps = Proofview.Goal.hyps (Proofview.Goal.assume gl) in
-    let posl = List.map (fun id -> (id, get_next_hyp_position id hyps)) ids in
+    let hyps = Proofview.Goal.hyps gl in
+    let env, sigma = Proofview.Goal.(env gl, sigma gl) in
+    let posl = List.map (fun id -> (id, get_next_hyp_position env sigma id hyps)) ids in
     Tacticals.New.tclTHEN
       (clear_for_replacing ids)
       (Tacticals.New.tclMAP (fun (id,pos) -> intro_move (Some id) pos) posl)
@@ -1130,7 +1118,7 @@ let is_quantified_hypothesis id gl =
 
 let msg_quantified_hypothesis = function
   | NamedHyp id ->
-      str "quantified hypothesis named " ++ pr_id id
+      str "quantified hypothesis named " ++ Id.print id
   | AnonHyp n ->
       pr_nth n ++
       str " non dependent hypothesis"
@@ -1159,7 +1147,7 @@ let intros_until_n = intros_until_n_gen true
 
 let tclCHECKVAR id =
   Proofview.Goal.enter begin fun gl ->
-    let _ = Tacmach.New.pf_get_hyp id (Proofview.Goal.assume gl) in
+    let _ = Tacmach.New.pf_get_hyp id gl in
     Proofview.tclUNIT ()
   end
 
@@ -1202,7 +1190,7 @@ let onOpenInductionArg env sigma tac = function
              let sigma = Tacmach.New.project gl in
              tac clear_flag (sigma,(c,NoBindings))
              end))
-  | clear_flag,ElimOnIdent (_,id) ->
+  | clear_flag,ElimOnIdent {CAst.v=id} ->
       (* A quantified hypothesis *)
       Tacticals.New.tclTHEN
         (try_intros_until_id_check id)
@@ -1218,7 +1206,7 @@ let onInductionArg tac = function
       Tacticals.New.tclTHEN
         (intros_until_n n)
         (Tacticals.New.onLastHyp (fun c -> tac clear_flag (c,NoBindings)))
-  | clear_flag,ElimOnIdent (_,id) ->
+  | clear_flag,ElimOnIdent {CAst.v=id} ->
       (* A quantified hypothesis *)
       Tacticals.New.tclTHEN
         (try_intros_until_id_check id)
@@ -1264,7 +1252,7 @@ let cut c =
       with e when Pretype_errors.precatchable_exception e -> false
     in
     if is_sort then
-      let id = next_name_away_with_default "H" Anonymous (Tacmach.New.pf_ids_of_hyps gl) in
+      let id = next_name_away_with_default "H" Anonymous (Tacmach.New.pf_ids_set_of_hyps gl) in
       (** Backward compat: normalize [c]. *)
       let c = if normalize_cut then local_strong whd_betaiota sigma c else c in
       Refine.refine ~typecheck:false begin fun h ->
@@ -1281,14 +1269,14 @@ let error_uninstantiated_metas t clenv =
   let t = EConstr.Unsafe.to_constr t in
   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 user_err  (str "Cannot find an instance for " ++ pr_id id ++ str".")
+  in user_err  (str "Cannot find an instance for " ++ Id.print id ++ str".")
 
 let check_unresolved_evars_of_metas sigma clenv =
   (* This checks that Metas turned into Evars by *)
   (* Refiner.pose_all_metas_as_evars are resolved *)
   List.iter (fun (mv,b) -> match b with
   | Clval (_,(c,_),_) ->
-    (match kind_of_term c.rebus with
+    (match Constr.kind c.rebus with
     | Evar (evk,_) when Evd.is_undefined clenv.evd evk
                      && not (Evd.mem sigma evk) ->
       error_uninstantiated_metas (mkMeta mv) clenv
@@ -1374,7 +1362,7 @@ let enforce_prop_bound_names rename tac =
                 (* "very_standard" says that we should have "H" names only, but
                    this would break compatibility even more... *)
                 let s = match Namegen.head_name sigma t with
-                  | Some id when not very_standard -> string_of_id id
+                  | Some id when not very_standard -> Id.to_string id
                   | _ -> "" in
                 Name (add_suffix Namegen.default_prop_ident s)
               else
@@ -1473,7 +1461,7 @@ let general_case_analysis_in_context with_evars clear_flag (c,lbindc) =
   let sort = Tacticals.New.elimination_sort_of_goal gl in
   let mind = on_snd (fun u -> EInstance.kind sigma u) mind in
   let (sigma, elim) =
-    if occur_term sigma c concl then
+    if dependent sigma c concl then
       build_case_analysis_scheme env sigma mind true sort
     else
       build_case_analysis_scheme_default env sigma mind sort in
@@ -1501,7 +1489,7 @@ let simplest_ecase c = general_case_analysis true None (c,NoBindings)
 
 exception IsNonrec
 
-let is_nonrec mind = (Global.lookup_mind (fst mind)).mind_finite == Decl_kinds.BiFinite
+let is_nonrec mind = (Global.lookup_mind (fst mind)).mind_finite == Declarations.BiFinite
 
 let find_ind_eliminator ind s gl =
   let gr = lookup_eliminator ind s in
@@ -1577,11 +1565,11 @@ let elimination_in_clause_scheme with_evars ?(flags=elim_flags ())
   let elimclause = make_clenv_binding env sigma (elim, elimty) bindings in
   let indmv = destMeta sigma (nth_arg sigma i elimclause.templval.rebus) in
   let hypmv =
-    try match List.remove Int.equal indmv (clenv_independent elimclause) with
-      | [a] -> a
-      | _ -> failwith ""
-    with Failure _ -> user_err ~hdr:"elimination_clause"
-          (str "The type of elimination clause is not well-formed.") in
+    match List.remove Int.equal indmv (clenv_independent elimclause) with
+    | [a] -> a
+    | _ -> 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
   let hyp_typ = Retyping.get_type_of env sigma hyp in
@@ -1590,7 +1578,7 @@ let elimination_in_clause_scheme with_evars ?(flags=elim_flags ())
   let new_hyp_typ  = clenv_type elimclause'' in
   if EConstr.eq_constr sigma hyp_typ new_hyp_typ then
     user_err ~hdr:"general_rewrite_in"
-      (str "Nothing to rewrite in " ++ pr_id id ++ str".");
+      (str "Nothing to rewrite in " ++ Id.print id ++ str".");
   clenv_refine_in with_evars id id sigma elimclause''
     (fun id -> Proofview.tclUNIT ())
   end
@@ -1605,7 +1593,7 @@ let general_elim_clause with_evars flags id c e =
 (* Apply a tactic below the products of the conclusion of a lemma *)
 
 type conjunction_status =
-  | DefinedRecord of constant option list
+  | DefinedRecord of Constant.t option list
   | NotADefinedRecordUseScheme of constr
 
 let make_projection env sigma params cstr sign elim i n c u =
@@ -1737,11 +1725,11 @@ let general_apply with_delta with_destruct with_evars clear_flag (loc,(c,lbind :
     let env = Proofview.Goal.env gl in
     let sigma = Tacmach.New.project gl in
 
-    let thm_ty0 = nf_betaiota sigma (Retyping.get_type_of env sigma c) in
+    let thm_ty0 = nf_betaiota env sigma (Retyping.get_type_of env sigma c) in
     let try_apply thm_ty nprod =
       try
         let n = nb_prod_modulo_zeta sigma thm_ty - nprod in
-        if n<0 then error "Applied theorem has not enough premisses.";
+        if n<0 then error "Applied theorem does not have enough premises.";
         let clause = make_clenv_binding_apply env sigma (Some n) (c,thm_ty) lbind in
         Clenvtac.res_pf clause ~with_evars ~flags
       with exn when catchable_exception exn ->
@@ -1763,7 +1751,7 @@ let general_apply with_delta with_destruct with_evars clear_flag (loc,(c,lbind :
         let info = Option.cata (fun loc -> Loc.add_loc info loc) info loc in
         let tac =
           if with_destruct then
-            descend_in_conjunctions []
+            descend_in_conjunctions Id.Set.empty
               (fun b id ->
                 Tacticals.New.tclTHEN
                   (try_main_apply b (mkVar id))
@@ -1873,7 +1861,7 @@ let explain_unable_to_apply_lemma ?loc env sigma thm innerclause =
      str "."))
 
 let apply_in_once_main flags innerclause env sigma (loc,d,lbind) =
-  let thm = nf_betaiota sigma (Retyping.get_type_of env sigma d) in
+  let thm = nf_betaiota env sigma (Retyping.get_type_of env sigma d) in
   let rec aux clause =
     try progress_with_clause flags innerclause clause
     with e when CErrors.noncritical e ->
@@ -1912,7 +1900,7 @@ let apply_in_once sidecond_first with_delta with_destruct with_evars naming
           ])
     with e when with_destruct && CErrors.noncritical e ->
       let (e, info) = CErrors.push e in
-        (descend_in_conjunctions [targetid]
+        (descend_in_conjunctions (Id.Set.singleton targetid)
            (fun b id -> aux (id::idstoclear) b (mkVar id))
            (e, info) c)
     end
@@ -1969,11 +1957,11 @@ let cut_and_apply c =
 (*               Exact tactics                                      *)
 (********************************************************************)
 
-(* let convert_leqkey = Profile.declare_profile "convert_leq";; *)
-(* let convert_leq = Profile.profile3 convert_leqkey convert_leq *)
+(* let convert_leqkey = CProfile.declare_profile "convert_leq";; *)
+(* let convert_leq = CProfile.profile3 convert_leqkey convert_leq *)
 
-(* let refine_no_checkkey = Profile.declare_profile "refine_no_check";; *)
-(* let refine_no_check = Profile.profile2 refine_no_checkkey refine_no_check *)
+(* let refine_no_checkkey = CProfile.declare_profile "refine_no_check";; *)
+(* let refine_no_check = CProfile.profile2 refine_no_checkkey refine_no_check *)
 
 let exact_no_check c =
   Refine.refine ~typecheck:false (fun h -> (h,c))
@@ -1982,7 +1970,7 @@ let exact_check c =
   Proofview.Goal.enter begin fun gl ->
   let sigma = Proofview.Goal.sigma gl in
   (** We do not need to normalize the goal because we just check convertibility *)
-  let concl = Proofview.Goal.concl (Proofview.Goal.assume gl) in
+  let concl = Proofview.Goal.concl gl in
   let env = Proofview.Goal.env gl in
   let sigma, ct = Typing.type_of env sigma c in
   Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma)
@@ -1991,7 +1979,7 @@ let exact_check c =
 
 let cast_no_check cast c =
   Proofview.Goal.enter begin fun gl ->
-    let concl = Proofview.Goal.concl (Proofview.Goal.assume gl) in
+    let concl = Proofview.Goal.concl gl in
     exact_no_check (mkCast (c, cast, concl))
   end
 
@@ -2043,8 +2031,8 @@ let assumption =
 
 let on_the_bodies = function
 | [] -> assert false
-| [id] -> str " depends on the body of " ++ pr_id id
-| l -> str " depends on the bodies of " ++ pr_sequence pr_id l
+| [id] -> str " depends on the body of " ++ Id.print id
+| l -> str " depends on the bodies of " ++ pr_sequence Id.print l
 
 exception DependsOnBody of Id.t option
 
@@ -2075,13 +2063,13 @@ let clear_body ids =
   let open Context.Named.Declaration in
   Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
-    let concl = Proofview.Goal.concl (Proofview.Goal.assume gl) in
+    let concl = Proofview.Goal.concl gl in
     let sigma = Tacmach.New.project gl in
     let ctx = named_context env in
     let map = function
     | LocalAssum (id,t) as decl ->
       let () = if List.mem_f Id.equal id ids then
-        user_err  (str "Hypothesis " ++ pr_id id ++ str " is not a local definition")
+        user_err  (str "Hypothesis " ++ Id.print id ++ str " is not a local definition")
       in
       decl
     | LocalDef (id,_,t) as decl ->
@@ -2113,7 +2101,7 @@ let clear_body ids =
       with DependsOnBody where ->
         let msg = match where with
         | None -> str "Conclusion" ++ on_the_bodies ids
-        | Some id -> str "Hypothesis " ++ pr_id id ++ on_the_bodies ids
+        | Some id -> str "Hypothesis " ++ Id.print id ++ on_the_bodies ids
         in
         Tacticals.New.tclZEROMSG msg
     in
@@ -2166,12 +2154,12 @@ let keep hyps =
    and [a1..an:A1..An(a1..an-1)] such that the goal is [G(a1..an)],
    this generalizes [hyps |- goal] into [hyps |- T] *)
 
-let apply_type newcl args =
+let apply_type ~typecheck newcl args =
   Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     let store = Proofview.Goal.extra gl in
-    Refine.refine ~typecheck:false begin fun sigma ->
-      let newcl = nf_betaiota sigma newcl (* As in former Logic.refine *) in
+    Refine.refine ~typecheck begin fun sigma ->
+      let newcl = nf_betaiota env sigma newcl (* As in former Logic.refine *) in
       let (sigma, ev) =
         Evarutil.new_evar env sigma ~principal:true ~store newcl in
       (sigma, applist (ev, args))
@@ -2200,7 +2188,6 @@ let bring_hyps hyps =
 
 let revert hyps = 
   Proofview.Goal.enter begin fun gl ->
-    let gl = Proofview.Goal.assume gl in
     let ctx = List.map (fun id -> Tacmach.New.pf_get_hyp id gl) hyps in
       (bring_hyps ctx) <*> (clear hyps)
   end
@@ -2219,27 +2206,27 @@ let check_number_of_constructors expctdnumopt i nconstr =
   end;
   if i > nconstr then error "Not enough constructors."
 
-let constructor_tac with_evars expctdnumopt i lbind =
+let constructor_core with_evars cstr lbind =
   Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
+    let env = Proofview.Goal.env gl in
+    let (sigma, (cons, u)) = Evd.fresh_constructor_instance env sigma cstr in
+    let cons = mkConstructU (cons, EInstance.make u) in
+    let apply_tac = general_apply true false with_evars None (Loc.tag (cons,lbind)) in
+    Tacticals.New.tclTHEN (Proofview.Unsafe.tclEVARS sigma) apply_tac
+  end
+
+let constructor_tac with_evars expctdnumopt i lbind =
+  Proofview.Goal.enter begin fun gl ->
     let cl = Tacmach.New.pf_concl gl in
-    let reduce_to_quantified_ind =
-      Tacmach.New.pf_apply Tacred.reduce_to_quantified_ind gl
-    in
-    let (mind,redcl) = reduce_to_quantified_ind cl in
-    let nconstr =
-      Array.length (snd (Global.lookup_inductive (fst mind))).mind_consnames in
-      check_number_of_constructors expctdnumopt i nconstr;
-
-      let (sigma, (cons, u)) = Evd.fresh_constructor_instance
-	(Proofview.Goal.env gl) sigma (fst mind, i) in
-      let cons = mkConstructU (cons, EInstance.make u) in
-	
-      let apply_tac = general_apply true false with_evars None (Loc.tag (cons,lbind)) in
-      Tacticals.New.tclTHENLIST
-         [ Proofview.Unsafe.tclEVARS sigma;
-           convert_concl_no_check redcl DEFAULTcast;
-           intros; apply_tac]
+    let ((ind,_),redcl) = Tacmach.New.pf_apply Tacred.reduce_to_quantified_ind gl cl in
+    let nconstr = Array.length (snd (Global.lookup_inductive ind)).mind_consnames in
+    check_number_of_constructors expctdnumopt i nconstr;
+    Tacticals.New.tclTHENLIST [
+      convert_concl_no_check redcl DEFAULTcast;
+      intros;
+      constructor_core with_evars (ind, i) lbind
+    ]
   end
 
 let one_constructor i lbind = constructor_tac false None i lbind
@@ -2249,24 +2236,26 @@ let one_constructor i lbind = constructor_tac false None i lbind
    Should be generalize in Constructor (Fun c : I -> tactic)
  *)
 
-let rec tclANY tac = function
-| [] -> Tacticals.New.tclZEROMSG (str "No applicable tactic.")
-| arg :: l ->
-  Tacticals.New.tclORD (tac arg) (fun () -> tclANY tac l)
-
 let any_constructor with_evars tacopt =
-  let t = match tacopt with None -> Proofview.tclUNIT () | Some t -> t in
-  let tac i = Tacticals.New.tclTHEN (constructor_tac with_evars None i NoBindings) t in
+  let one_constr =
+    let tac cstr = constructor_core with_evars cstr NoBindings in
+    match tacopt with
+    | None -> tac
+    | Some t -> fun cstr -> Tacticals.New.tclTHEN (tac cstr) t in
+  let rec any_constr ind n i () =
+    if Int.equal i n then one_constr (ind,i)
+    else Tacticals.New.tclORD (one_constr (ind,i)) (any_constr ind n (i + 1)) in
   Proofview.Goal.enter begin fun gl ->
     let cl = Tacmach.New.pf_concl gl in
-    let reduce_to_quantified_ind =
-      Tacmach.New.pf_apply Tacred.reduce_to_quantified_ind gl
-    in
-    let mind = fst (reduce_to_quantified_ind cl) in
+    let (ind,_),redcl = Tacmach.New.pf_apply Tacred.reduce_to_quantified_ind gl cl in
     let nconstr =
-      Array.length (snd (Global.lookup_inductive (fst mind))).mind_consnames in
+      Array.length (snd (Global.lookup_inductive ind)).mind_consnames in
     if Int.equal nconstr 0 then error "The type has no constructors.";
-    tclANY tac (List.interval 1 nconstr)
+    Tacticals.New.tclTHENLIST [
+      convert_concl_no_check redcl DEFAULTcast;
+      intros;
+      any_constr ind nconstr 1 ()
+    ]
  end
 
 let left_with_bindings  with_evars = constructor_tac with_evars (Some 2) 1
@@ -2390,15 +2379,16 @@ let rewrite_hyp_then assert_style with_evars thin l2r id tac =
 
 let prepare_naming ?loc = function
   | IntroIdentifier id -> NamingMustBe (Loc.tag ?loc id)
-  | IntroAnonymous -> NamingAvoid []
-  | IntroFresh id -> NamingBasedOn (id,[])
+  | IntroAnonymous -> NamingAvoid Id.Set.empty
+  | IntroFresh id -> NamingBasedOn (id, Id.Set.empty)
 
 let rec explicit_intro_names = function
 | (_, IntroForthcoming _) :: l -> explicit_intro_names l
-| (_, IntroNaming (IntroIdentifier id)) :: l -> id :: explicit_intro_names l
+| (_, IntroNaming (IntroIdentifier id)) :: l -> Id.Set.add id (explicit_intro_names l)
 | (_, IntroAction (IntroOrAndPattern l)) :: l' ->
     let ll = match l with IntroAndPattern l -> [l] | IntroOrPattern ll -> ll in
-    List.flatten (List.map (fun l -> explicit_intro_names (l@l')) ll)
+    let fold accu l = Id.Set.union accu (explicit_intro_names (l@l')) in
+    List.fold_left fold Id.Set.empty ll
 | (_, IntroAction (IntroInjection l)) :: l' ->
     explicit_intro_names (l@l')
 | (_, IntroAction (IntroApplyOn (c,pat))) :: l' ->
@@ -2406,17 +2396,17 @@ let rec explicit_intro_names = function
 | (_, (IntroNaming (IntroAnonymous | IntroFresh _)
      | IntroAction (IntroWildcard | IntroRewrite _))) :: l ->
      explicit_intro_names l
-| [] -> []
+| [] -> Id.Set.empty
 
 let rec check_name_unicity env ok seen = function
 | (_, IntroForthcoming _) :: l -> check_name_unicity env ok seen l
 | (loc, IntroNaming (IntroIdentifier id)) :: l ->
    (try
       ignore (if List.mem_f Id.equal id ok then raise Not_found else lookup_named id env);
-      user_err ?loc (pr_id id ++ str" is already used.")
+      user_err ?loc (Id.print id ++ str" is already used.")
    with Not_found ->
      if List.mem_f Id.equal id seen then
-       user_err ?loc (pr_id id ++ str" is used twice.")
+       user_err ?loc (Id.print id ++ str" is used twice.")
      else
        check_name_unicity env ok (id::seen) l)
 | (_, IntroAction (IntroOrAndPattern l)) :: l' ->
@@ -2453,8 +2443,8 @@ let make_tmp_naming avoid l = function
      IntroAnonymous, but at the cost of a "renaming"; Note that in the
      case of IntroFresh, we should use check_thin_clash_then anyway to
      prevent the case of an IntroFresh precisely using the wild_id *)
-  | IntroWildcard -> NamingBasedOn (wild_id,avoid@explicit_intro_names l)
-  | pat -> NamingAvoid(avoid@explicit_intro_names ((Loc.tag @@ IntroAction pat)::l))
+  | IntroWildcard -> NamingBasedOn (wild_id, Id.Set.union avoid (explicit_intro_names l))
+  | pat -> NamingAvoid(Id.Set.union avoid (explicit_intro_names ((Loc.tag @@ IntroAction pat)::l)))
 
 let fit_bound n = function
   | None -> true
@@ -2466,7 +2456,7 @@ let exceed_bound n = function
 
   (* We delay thinning until the completion of the whole intros tactic
      to ensure that dependent hypotheses are cleared in the right
-     dependency order (see bug #1000); we use fresh names, not used in
+     dependency order (see BZ#1000); we use fresh names, not used in
      the tactic, for the hyps to clear *)
   (* In [intro_patterns_core b avoid ids thin destopt bound n tac patl]:
      [b]: compatibility flag, if false at toplevel, do not complete incomplete
@@ -2495,7 +2485,7 @@ let rec intro_patterns_core with_evars b avoid ids thin destopt bound n tac =
   if exceed_bound n bound then error_unexpected_extra_pattern loc bound pat else
   match pat with
   | IntroForthcoming onlydeps ->
-      intro_forthcoming_then_gen (NamingAvoid (avoid@explicit_intro_names l))
+      intro_forthcoming_then_gen (NamingAvoid (Id.Set.union avoid (explicit_intro_names l)))
 	  destopt onlydeps n bound
         (fun ids -> intro_patterns_core with_evars b avoid ids thin destopt bound
           (n+List.length ids) tac l)
@@ -2518,12 +2508,12 @@ and intro_pattern_naming loc with_evars b avoid ids pat thin destopt bound n tac
         intro_then_gen (NamingMustBe (loc,id)) destopt true false
           (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))
+      intro_then_gen (NamingAvoid (Id.Set.union avoid (explicit_intro_names l)))
 	destopt true false
         (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))
+      intro_then_gen (NamingBasedOn (id, Id.Set.union avoid (explicit_intro_names l)))
 	destopt true false
         (fun id -> intro_patterns_core with_evars b avoid (id::ids) thin destopt bound n tac l)
 
@@ -2557,7 +2547,7 @@ and prepare_intros ?loc with_evars dft destopt = function
   | IntroAction ipat ->
       prepare_naming ?loc dft,
       (let tac thin bound =
-        intro_patterns_core with_evars true [] [] thin destopt bound 0
+        intro_patterns_core with_evars true Id.Set.empty [] thin destopt bound 0
           (fun _ l -> clear_wildcards l) in
       fun id ->
         intro_pattern_action ?loc with_evars true true ipat [] destopt tac id)
@@ -2568,7 +2558,7 @@ let intro_patterns_head_core with_evars b destopt bound pat =
   Proofview.Goal.enter begin fun gl ->
     let env = Proofview.Goal.env gl in
     check_name_unicity env [] [] pat;
-    intro_patterns_core with_evars b [] [] [] destopt
+    intro_patterns_core with_evars b Id.Set.empty [] [] destopt
       bound 0 (fun _ l -> clear_wildcards l) pat
   end
 
@@ -2623,8 +2613,10 @@ let general_apply_in sidecond_first with_delta with_destruct with_evars
   Proofview.Goal.enter begin fun gl ->
   let destopt =
     if with_evars then MoveLast (* evars would depend on the whole context *)
-    else
-      get_previous_hyp_position id (Proofview.Goal.hyps (Proofview.Goal.assume gl)) in
+    else (
+      let env, sigma = Proofview.Goal.(env gl, sigma gl) in
+      get_previous_hyp_position env sigma id (Proofview.Goal.hyps gl)
+    ) in
   let naming,ipat_tac =
     prepare_intros_opt with_evars (IntroIdentifier id) destopt ipat in
   let lemmas_target, last_lemma_target =
@@ -2680,8 +2672,8 @@ let letin_tac_gen with_eq (id,depdecls,lastlhyp,ccl,c) ty =
     let (sigma, (newcl, eq_tac)) = match with_eq with
       | Some (lr,(loc,ido)) ->
           let heq = match ido with
-            | IntroAnonymous -> new_fresh_id [id] (add_prefix "Heq" id) gl
-            | IntroFresh heq_base -> new_fresh_id [id] heq_base gl
+            | IntroAnonymous -> new_fresh_id (Id.Set.singleton id) (add_prefix "Heq" id) gl
+            | IntroFresh heq_base -> new_fresh_id (Id.Set.singleton id) heq_base gl
             | IntroIdentifier id -> id in
           let eqdata = build_coq_eq_data () in
           let args = if lr then [t;mkVar id;c] else [t;c;mkVar id]in
@@ -2733,11 +2725,11 @@ let mkletin_goal env sigma store with_eq dep (id,lastlhyp,ccl,c) ty =
   match with_eq with
   | Some (lr,(loc,ido)) ->
       let heq = match ido with
-      | IntroAnonymous -> fresh_id_in_env [id] (add_prefix "Heq" id) env
-      | IntroFresh heq_base -> fresh_id_in_env [id] heq_base env
+      | IntroAnonymous -> fresh_id_in_env (Id.Set.singleton id) (add_prefix "Heq" id) env
+      | IntroFresh heq_base -> fresh_id_in_env (Id.Set.singleton id) heq_base env
       | IntroIdentifier id ->
           if List.mem id (ids_of_named_context (named_context env)) then
-            user_err ?loc  (pr_id id ++ str" is already used.");
+            user_err ?loc  (Id.print 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
@@ -2820,7 +2812,7 @@ let enough_by na t tac = forward false (Some (Some tac)) (ipat_of_name na) t
 let generalized_name env sigma c t ids cl = function
   | Name id as na ->
       if Id.List.mem id ids then
-	user_err  (pr_id id ++ str " is already used.");
+	user_err  (Id.print id ++ str " is already used.");
       na
   | Anonymous ->
       match EConstr.kind sigma c with
@@ -2897,7 +2889,7 @@ let generalize_dep ?(with_let=false) c =
   let args = Context.Named.to_instance mkVar to_quantify_rev in
   tclTHENLIST
     [ Proofview.Unsafe.tclEVARS evd;
-      apply_type cl'' (if Option.is_empty body then c::args else args);
+      apply_type ~typecheck:false cl'' (if Option.is_empty body then c::args else args);
       clear (List.rev tothin')]
   end
 
@@ -2911,13 +2903,12 @@ let generalize_gen_let lconstr = Proofview.Goal.enter begin fun gl ->
   let (evd, _) = Typing.type_of env evd newcl in
   let map ((_, c, b),_) = if Option.is_empty b then Some c else None in
   Proofview.tclTHEN (Proofview.Unsafe.tclEVARS evd)
-  (apply_type newcl (List.map_filter map lconstr))
+  (apply_type ~typecheck:false newcl (List.map_filter map lconstr))
 end
 
 let new_generalize_gen_let lconstr =
   Proofview.Goal.enter begin fun gl ->
     let sigma = Proofview.Goal.sigma gl in
-    let gl = Proofview.Goal.assume gl in
     let concl = Proofview.Goal.concl gl in
     let env = Proofview.Goal.env gl in
     let ids = Tacmach.New.pf_ids_of_hyps gl in
@@ -3067,10 +3058,10 @@ let unfold_body x =
   let open Context.Named.Declaration in
   Proofview.Goal.enter begin fun gl ->
   (** We normalize the given hypothesis immediately. *)
-  let env = Proofview.Goal.env (Proofview.Goal.assume gl) in
+  let env = Proofview.Goal.env 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.")
+    (Id.print x ++ str" is not a defined hypothesis.")
   | LocalDef (_,xval,_) -> xval
   in
   let xval = EConstr.of_constr xval in
@@ -3122,11 +3113,11 @@ let expand_hyp id = Tacticals.New.tclTRY (unfold_body id) <*> clear [id]
 
 let warn_unused_intro_pattern env sigma =
   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_econstr (snd (c env sigma)))) names)
+    (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_econstr_env env sigma (snd (c env sigma)))) names)
 
 let check_unused_names env sigma names =
   if not (List.is_empty names) then
@@ -3141,13 +3132,13 @@ let rec consume_pattern avoid na isdep gl = function
   | (loc,IntroForthcoming true)::names when not isdep ->
       consume_pattern avoid na isdep gl names
   | (loc,IntroForthcoming _)::names as fullpat ->
-      let avoid = avoid@explicit_intro_names names in
+      let avoid = Id.Set.union avoid (explicit_intro_names names) in
       ((loc,intropattern_of_name gl avoid na), fullpat)
   | (loc,IntroNaming IntroAnonymous)::names ->
-      let avoid = avoid@explicit_intro_names names in
+      let avoid = Id.Set.union avoid (explicit_intro_names names) in
       ((loc,intropattern_of_name gl avoid na), names)
   | (loc,IntroNaming (IntroFresh id'))::names ->
-      let avoid = avoid@explicit_intro_names names in
+      let avoid = Id.Set.union avoid (explicit_intro_names names) in
       ((loc,IntroNaming (IntroIdentifier (new_fresh_id avoid id' gl))), names)
   | pat::names -> (pat,names)
 
@@ -3205,7 +3196,7 @@ let get_recarg_dest (recargdests,tophyp) =
 *)
 
 let induct_discharge with_evars dests avoid' tac (avoid,ra) names =
-  let avoid = avoid @ avoid' in
+  let avoid = Id.Set.union avoid avoid' in
   let rec peel_tac ra dests names thin =
     match ra with
     | (RecArg,_,deprec,recvarname) ::
@@ -3278,7 +3269,7 @@ let atomize_param_of_ind_then (indref,nparams,_) hyp0 tac =
   Proofview.Goal.enter begin fun gl ->
   let env = Proofview.Goal.env gl in
   let sigma = Tacmach.New.project gl in
-  let tmptyp0 = Tacmach.New.pf_get_hyp_typ hyp0 (Proofview.Goal.assume gl) in
+  let tmptyp0 = Tacmach.New.pf_get_hyp_typ hyp0 gl in
   let reduce_to_quantified_ref = Tacmach.New.pf_apply reduce_to_quantified_ref gl in
   let typ0 = reduce_to_quantified_ref indref tmptyp0 in
   let prods, indtyp = decompose_prod_assum sigma typ0 in
@@ -3301,7 +3292,7 @@ let atomize_param_of_ind_then (indref,nparams,_) hyp0 tac =
             (* Based on the knowledge given by the user, all
                constraints on the variable are generalizable in the
                current environment so that it is clearable after destruction *)
-	    atomize_one (i-1) (c::args) (c::args') (id::avoid)
+	    atomize_one (i-1) (c::args) (c::args') (Id.Set.add id avoid)
 	| _ ->
 	   let c' = expand_projections env' sigma c in
             let dependent t = dependent sigma c t in
@@ -3326,9 +3317,9 @@ let atomize_param_of_ind_then (indref,nparams,_) hyp0 tac =
             let x = fresh_id_in_env avoid id env in
 	    Tacticals.New.tclTHEN
 	      (letin_tac None (Name x) c None allHypsAndConcl)
-	      (atomize_one (i-1) (mkVar x::args) (mkVar x::args') (x::avoid))
+	      (atomize_one (i-1) (mkVar x::args) (mkVar x::args') (Id.Set.add x avoid))
   in
-  atomize_one (List.length argl) [] [] []
+  atomize_one (List.length argl) [] [] Id.Set.empty
   end
 
 (* [cook_sign] builds the lists [beforetoclear] (preceding the
@@ -3400,7 +3391,7 @@ let cook_sign hyp0_opt inhyps indvars env sigma =
   (* First phase from L to R: get [toclear], [decldep] and [statuslist]
      for the hypotheses before (= more ancient than) hyp0 (see above) *)
   let toclear = ref [] in
-  let avoid = ref [] in
+  let avoid = ref Id.Set.empty in
   let decldeps = ref [] in
   let ldeps = ref [] in
   let rstatus = ref [] in
@@ -3417,7 +3408,7 @@ let cook_sign hyp0_opt inhyps indvars env sigma =
          is one of indvars too *)
       toclear := hyp::!toclear;
       MoveFirst (* fake value *)
-    end else if Id.List.mem hyp indvars then begin
+    end else if Id.Set.mem hyp indvars then begin
       (* The variables in indvars are such that they don't occur any
          more after generalization, so declare them to clear. *)
       toclear := hyp::!toclear;
@@ -3427,14 +3418,14 @@ let cook_sign hyp0_opt inhyps indvars env sigma =
 	(Option.cata (fun id -> occur_var_in_decl env sigma id decl) false hyp0_opt)
       in
       let depother = List.is_empty inhyps &&
-	(List.exists (fun id -> occur_var_in_decl env sigma id decl) indvars ||
+	(Id.Set.exists (fun id -> occur_var_in_decl env sigma id decl) indvars ||
          List.exists (fun decl' -> occur_var_in_decl env sigma (NamedDecl.get_id decl') decl) !decldeps)
       in
       if not (List.is_empty inhyps) && Id.List.mem hyp inhyps
          || dephyp0 || depother
       then begin
 	decldeps := decl::!decldeps;
-	avoid := hyp::!avoid;
+	avoid := Id.Set.add hyp !avoid;
         maindep := dephyp0 || !maindep;
 	if !before then begin
           toclear := hyp::!toclear;
@@ -3558,15 +3549,15 @@ let make_up_names n ind_opt cname =
     else add_prefix ind_prefix cname in
   let hyprecname = make_base n base_ind in
   let avoid =
-    if Int.equal n 1 (* Only one recursive argument *) || Int.equal n 0 then []
+    if Int.equal n 1 (* Only one recursive argument *) || Int.equal n 0 then Id.Set.empty
     else
       (* Forbid to use cname, cname0, hyprecname and hyprecname0 *)
       (* in order to get names such as f1, f2, ... *)
       let avoid =
-        (make_ident (Id.to_string hyprecname) None) ::
-        (make_ident (Id.to_string hyprecname) (Some 0)) :: [] in
+        Id.Set.add (make_ident (Id.to_string hyprecname) None)
+        (Id.Set.singleton (make_ident (Id.to_string hyprecname) (Some 0))) in
       if not (String.equal (atompart_of_id cname) "H") then
-        (make_ident base (Some 0)) :: (make_ident base None) :: avoid
+        Id.Set.add (make_ident base (Some 0)) (Id.Set.add (make_ident base None) avoid)
       else avoid in
   Id.of_string base, hyprecname, avoid
 
@@ -3725,10 +3716,10 @@ let abstract_args gl generalize_vars dep id defined f args =
   let env = Tacmach.New.pf_env gl in
   let concl = Tacmach.New.pf_concl gl in
   let dep = dep || local_occur_var !sigma id concl in
-  let avoid = ref [] in
+  let avoid = ref Id.Set.empty in
   let get_id name =
     let id = new_fresh_id !avoid (match name with Name n -> n | Anonymous -> Id.of_string "gen_x") gl in
-      avoid := id :: !avoid; id
+      avoid := Id.Set.add id !avoid; id
   in
     (* Build application generalized w.r.t. the argument plus the necessary eqs.
        From env |- c : forall G, T and args : G we build
@@ -3907,7 +3898,7 @@ let specialize_eqs id =
         (internal_cut true id ty')
 	(exact_no_check ((* refresh_universes_strict *) acc'))
     else
-      Tacticals.New.tclFAIL 0 (str "Nothing to do in hypothesis " ++ pr_id id)
+      Tacticals.New.tclFAIL 0 (str "Nothing to do in hypothesis " ++ Id.print id)
   end
 
 let specialize_eqs id = Proofview.Goal.enter begin fun gl ->
@@ -4131,8 +4122,7 @@ let guess_elim isrec dep s hyp0 gl =
       let env = Tacmach.New.pf_env gl in
       let sigma = Tacmach.New.project gl in
       let u = EInstance.kind (Tacmach.New.project gl) u in
-      if use_dependent_propositions_elimination () && dep
-      then
+      if dep then
         let (sigma, ind) = build_case_analysis_scheme env sigma (mind, u) true s in
         let ind = EConstr.of_constr ind in
         (sigma, ind)
@@ -4152,7 +4142,7 @@ let given_elim hyp0 (elimc,lbind as e) gl =
   Tacmach.New.project gl, (e, elimt), ind_type_guess
 
 type scheme_signature =
-    (Id.t list * (elim_arg_kind * bool * bool * Id.t) list) array
+    (Id.Set.t * (elim_arg_kind * bool * bool * Id.t) list) array
 
 type eliminator_source =
   | ElimUsing of (eliminator * EConstr.types) * scheme_signature
@@ -4164,11 +4154,10 @@ let find_induction_type isrec elim hyp0 gl =
     match elim with
     | None ->
        let sort = Tacticals.New.elimination_sort_of_goal gl in
-       let _, (elimc,elimt),_ = 
-	 guess_elim isrec (* dummy: *) true sort hyp0 gl in
-	let scheme = compute_elim_sig sigma ~elimc elimt in
-	(* We drop the scheme waiting to know if it is dependent *)
-	scheme, ElimOver (isrec,hyp0)
+       let _, (elimc,elimt),_ = guess_elim isrec false sort hyp0 gl in
+       let scheme = compute_elim_sig sigma ~elimc elimt in
+       (* We drop the scheme waiting to know if it is dependent *)
+       scheme, ElimOver (isrec,hyp0)
     | Some e ->
 	let evd, (elimc,elimt),ind_guess = given_elim hyp0 e gl in
 	let scheme = compute_elim_sig sigma ~elimc elimt in
@@ -4278,7 +4267,7 @@ let apply_induction_in_context with_evars hyp0 inhyps elim indvars names induct_
     let deps_cstr =
       List.fold_left
         (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 (sigma, isrec, elim, indsign) = get_eliminator elim dep s gl in
     let branchletsigns =
       let f (_,is_not_let,_,_) = is_not_let in
       Array.map (fun (_,l) -> List.map f l) indsign in
@@ -4288,7 +4277,7 @@ let apply_induction_in_context with_evars hyp0 inhyps elim indvars names induct_
     (if isrec then Tacticals.New.tclTHENFIRSTn else Tacticals.New.tclTHENLASTn)
       (Tacticals.New.tclTHENLIST [
         (* Generalize dependent hyps (but not args) *)
-        if deps = [] then Proofview.tclUNIT () else apply_type tmpcl deps_cstr;
+        if deps = [] then Proofview.tclUNIT () else apply_type ~typecheck:false tmpcl deps_cstr;
         (* side-conditions in elim (resp case) schemes come last (resp first) *)
         induct_tac elim;
         Tacticals.New.tclMAP expand_hyp toclear;
@@ -4303,7 +4292,7 @@ let apply_induction_in_context with_evars hyp0 inhyps elim indvars names induct_
 
 let induction_with_atomization_of_ind_arg isrec with_evars elim names hyp0 inhyps =
   Proofview.Goal.enter begin fun gl ->
-  let elim_info = find_induction_type isrec elim hyp0 (Proofview.Goal.assume gl) in
+  let elim_info = find_induction_type isrec elim hyp0 gl in
   atomize_param_of_ind_then elim_info hyp0 (fun indvars ->
     apply_induction_in_context with_evars (Some hyp0) inhyps (pi3 elim_info) indvars names
       (fun elim -> induction_tac with_evars [] [hyp0] elim))
@@ -4343,7 +4332,7 @@ let induction_without_atomization isrec with_evars elim names lid =
        gt_wf_rec was taken as a functional scheme with no parameters,
        but by chance, because of the addition of at least hyp0 for
        cook_sign, it behaved as if there was a real induction arg. *)
-    if indvars = [] then [List.hd lid_params] else indvars in
+    if List.is_empty indvars then Id.Set.singleton (List.hd lid_params) else Id.Set.of_list indvars in
   let induct_tac elim = Tacticals.New.tclTHENLIST [
     (* pattern to make the predicate appear. *)
     reduce (Pattern (List.map inj_with_occurrences lidcstr)) onConcl;
@@ -4363,7 +4352,7 @@ let clear_unselected_context id inhyps cls =
   if occur_var (Tacmach.New.pf_env gl) (Tacmach.New.project gl) id (Tacmach.New.pf_concl gl) &&
     cls.concl_occs == NoOccurrences
   then user_err 
-    (str "Conclusion must be mentioned: it depends on " ++ pr_id id
+    (str "Conclusion must be mentioned: it depends on " ++ Id.print id
      ++ str ".");
   match cls.onhyps with
   | Some hyps ->
@@ -4438,8 +4427,11 @@ let check_enough_applied env sigma elim =
           check_expected_type env sigma elimc elimt
 
 let guard_no_unifiable = Proofview.guard_no_unifiable >>= function
-| None -> Proofview.tclUNIT ()
-| Some l -> Proofview.tclZERO (RefinerError (UnresolvedBindings l))
+  | None -> Proofview.tclUNIT ()
+  | Some l ->
+    Proofview.tclENV     >>= function env ->
+    Proofview.tclEVARMAP >>= function sigma ->
+    Proofview.tclZERO (RefinerError (env, sigma, UnresolvedBindings l))
 
 let pose_induction_arg_then isrec with_evars (is_arg_pure_hyp,from_prefix) elim
      id ((pending,(c0,lbind)),(eqname,names)) t0 inhyps cls tac =
@@ -4539,7 +4531,7 @@ let induction_gen clear_flag isrec with_evars elim
     let id =
     (* Type not the right one if partially applied but anyway for internal use*)
       let x = id_of_name_using_hdchar env evd t Anonymous in
-      new_fresh_id [] x gl in
+      new_fresh_id Id.Set.empty x gl in
     let info_arg = (is_arg_pure_hyp, not enough_applied) in
     pose_induction_arg_then
       isrec with_evars info_arg elim id arg t inhyps cls
@@ -4578,7 +4570,7 @@ let induction_gen_l isrec with_evars elim names lc =
                 let x =
 		  id_of_name_using_hdchar env sigma (type_of c) Anonymous in
 
-                let id = new_fresh_id [] x gl in
+                let id = new_fresh_id Id.Set.empty x gl in
 		let newl' = List.map (fun r -> replace_term sigma c (mkVar id) r) l' in
 		let _ = newlc:=id::!newlc in
 		Tacticals.New.tclTHEN
@@ -4638,7 +4630,7 @@ let induction_destruct isrec with_evars (lc,elim) =
         (Tacticals.New.tclMAP (fun (a,b,cl) ->
           Proofview.Goal.enter begin fun gl ->
           let env = Proofview.Goal.env gl in
-          let sigma = Tacmach.New.project gl in      
+          let sigma = Tacmach.New.project gl in
           onOpenInductionArg env sigma (fun clear_flag a ->
             induction_gen clear_flag false with_evars None (a,b) cl) a
           end) l)
@@ -4663,7 +4655,7 @@ let induction_destruct isrec with_evars (lc,elim) =
     end
 
 let induction ev clr c l e =
-  induction_gen clr true ev e 
+  induction_gen clr true ev e
     ((Evd.empty,(c,NoBindings)),(None,l)) None
 
 let destruct ev clr c l e =
@@ -4953,7 +4945,7 @@ let interpretable_as_section_decl evd d1 d2 =
 let rec decompose len c t accu =
   let open Context.Rel.Declaration in
   if len = 0 then (c, t, accu)
-  else match kind_of_term c, kind_of_term t with 
+  else match Constr.kind c, Constr.kind t with 
   | Lambda (na, u, c), Prod (_, _, t) ->
     decompose (pred len) c t (LocalAssum (na, u) :: accu)
   | LetIn (na, b, u, c), LetIn (_, _, _, t) ->
@@ -4961,7 +4953,7 @@ let rec decompose len c t accu =
   | _ -> assert false
 
 let rec shrink ctx sign c t accu =
-  let open Term in
+  let open Constr in
   let open CVars in
   match ctx, sign with
   | [], [] -> (c, t, accu)
@@ -4971,8 +4963,8 @@ let rec shrink ctx sign c t accu =
         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 c = Term.mkLambda_or_LetIn p c in
+        let t = Term.mkProd_or_LetIn p t in
         let accu = if RelDecl.is_local_assum p
                    then mkVar (NamedDecl.get_id decl) :: accu
                    else accu
@@ -5015,7 +5007,7 @@ let cache_term_by_tactic_then ~opaque ?(goal_type=None) id gk tac tacK =
         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
-  let id = next_global_ident_away id (pf_ids_of_hyps gl) in
+  let id = next_global_ident_away id (pf_ids_set_of_hyps gl) in
   let concl = match goal_type with
               | None ->  Proofview.Goal.concl gl
               | Some ty -> ty in
diff --git a/tactics/tactics.mli b/tactics/tactics.mli
index bca0c4c50..74415f8d0 100644
--- a/tactics/tactics.mli
+++ b/tactics/tactics.mli
@@ -8,7 +8,7 @@
 
 open Loc
 open Names
-open Term
+open Constr
 open EConstr
 open Environ
 open Proof_type
@@ -21,6 +21,7 @@ open Unification
 open Misctypes
 open Tactypes
 open Locus
+open Ltac_pretype
 
 (** 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
@@ -29,7 +30,7 @@ open Locus
 
 (** {6 General functions. } *)
 
-val is_quantified_hypothesis : Id.t -> 'a Proofview.Goal.t -> bool
+val is_quantified_hypothesis : Id.t -> Proofview.Goal.t -> bool
 
 (** {6 Primitive tactics. } *)
 
@@ -49,18 +50,18 @@ val convert_leq     : constr -> constr -> unit Proofview.tactic
 
 (** {6 Introduction tactics. } *)
 
-val fresh_id_in_env : Id.t list -> Id.t -> env -> Id.t
-val fresh_id : Id.t list -> Id.t -> goal sigma -> Id.t
+val fresh_id_in_env : Id.Set.t -> Id.t -> env -> Id.t
+val fresh_id : Id.Set.t -> Id.t -> goal sigma -> Id.t
 val find_intro_names : rel_context -> goal sigma -> Id.t list
 
 val intro                : unit Proofview.tactic
 val introf               : unit Proofview.tactic
 val intro_move        : Id.t option -> Id.t move_location -> unit Proofview.tactic
-val intro_move_avoid  : Id.t option -> Id.t list -> Id.t move_location -> unit Proofview.tactic
+val intro_move_avoid  : Id.t option -> Id.Set.t -> Id.t move_location -> unit Proofview.tactic
 
   (** [intro_avoiding idl] acts as intro but prevents the new Id.t
      to belong to [idl] *)
-val intro_avoiding       : Id.t list -> unit Proofview.tactic
+val intro_avoiding       : Id.Set.t -> unit Proofview.tactic
 
 val intro_replacing      : Id.t -> unit Proofview.tactic
 val intro_using          : Id.t -> unit Proofview.tactic
@@ -75,7 +76,7 @@ val intros               : unit Proofview.tactic
 (** [depth_of_quantified_hypothesis b h g] returns the index of [h] in
    the conclusion of goal [g], up to head-reduction if [b] is [true] *)
 val depth_of_quantified_hypothesis :
-  bool -> quantified_hypothesis -> 'a Proofview.Goal.t -> int
+  bool -> quantified_hypothesis -> Proofview.Goal.t -> int
 
 val intros_until         : quantified_hypothesis -> unit Proofview.tactic
 
@@ -184,7 +185,7 @@ val revert        : Id.t list -> unit Proofview.tactic
 
 (** {6 Resolution tactics. } *)
 
-val apply_type : constr -> constr list -> unit Proofview.tactic
+val apply_type : typecheck:bool -> constr -> constr list -> unit Proofview.tactic
 val bring_hyps : named_context -> unit Proofview.tactic
 
 val apply                 : constr -> unit Proofview.tactic
@@ -270,7 +271,7 @@ type eliminator = {
 val general_elim  : evars_flag -> clear_flag ->
   constr with_bindings -> eliminator -> unit Proofview.tactic
 
-val general_elim_clause : evars_flag -> unify_flags -> identifier option ->
+val general_elim_clause : evars_flag -> unify_flags -> Id.t option ->
   clausenv -> eliminator -> unit Proofview.tactic
 
 val default_elim  : evars_flag -> clear_flag -> constr with_bindings ->
@@ -354,7 +355,7 @@ val assert_before : Name.t -> types -> unit Proofview.tactic
 val assert_after  : Name.t -> types -> unit Proofview.tactic
 
 val assert_as     : (* true = before *) bool ->
-  (* optionally tell if a specialization of some hyp: *) identifier option ->
+  (* optionally tell if a specialization of some hyp: *) Id.t option ->
   intro_pattern option -> constr -> unit Proofview.tactic
 
 (** Implements the tactics assert, enough and pose proof; note that "by"
@@ -427,7 +428,7 @@ module Simple : sig
   val eapply : constr -> unit Proofview.tactic
   val elim   : constr -> unit Proofview.tactic
   val case   : constr -> unit Proofview.tactic
-  val apply_in : identifier -> constr -> unit Proofview.tactic
+  val apply_in : Id.t -> constr -> unit Proofview.tactic
 
 end
 
diff --git a/tactics/term_dnet.ml b/tactics/term_dnet.ml
index 64ba38a51..7567cfa30 100644
--- a/tactics/term_dnet.ml
+++ b/tactics/term_dnet.ml
@@ -8,7 +8,7 @@
 
 (*i*)
 open Util
-open Term
+open Constr
 open Names
 open Globnames
 open Mod_subst
@@ -95,13 +95,20 @@ struct
 
   let compare cmp t1 t2 = match t1, t2 with
   | DRel, DRel -> 0
+  | DRel, _ -> -1 | _, DRel -> 1
   | DSort, DSort -> 0
+  | DSort, _ -> -1 | _, DSort -> 1
   | DRef gr1, DRef gr2 -> RefOrdered.compare gr1 gr2
+  | DRef _, _ -> -1 | _, DRef _ -> 1
+
   | DCtx (tl1, tr1), DCtx (tl2, tr2)
   | DLambda (tl1, tr1), DLambda (tl2, tr2)
   | DApp (tl1, tr1), DApp (tl2, tr2) ->
     let c = cmp tl1 tl2 in
     if c = 0 then cmp tr1 tr2 else c
+  | DCtx _, _ -> -1 | _, DCtx _ -> 1
+  | DLambda _, _ -> -1 | _, DLambda _ -> 1
+  | DApp _, _ -> -1 | _, DApp _ -> 1
 
   | DCase (ci1, c1, t1, p1), DCase (ci2, c2, t2, p2) ->
     let c = cmp c1 c2 in
@@ -113,6 +120,7 @@ struct
         else c
       else c
     else c
+  | DCase _, _ -> -1 | _, DCase _ -> 1
 
   | DFix (i1, j1, tl1, pl1), DFix (i2, j2, tl2, pl2) ->
     let c = Int.compare j1 j2 in
@@ -124,6 +132,8 @@ struct
         else c
       else c
     else c
+  | DFix _, _ -> -1 | _, DFix _ -> 1
+
   | DCoFix (i1, tl1, pl1), DCoFix (i2, tl2, pl2) ->
     let c = Int.compare i1 i2 in
     if c = 0 then
@@ -131,7 +141,18 @@ struct
       if c = 0 then Array.compare cmp pl1 pl2
       else c
     else c
-  | _ -> Pervasives.compare t1 t2 (** OK **)
+  | DCoFix _, _ -> -1 | _, DCoFix _ -> 1
+
+  | DCons ((t1, ot1), u1), DCons ((t2, ot2), u2) ->
+     let c = cmp t1 t2 in
+     if Int.equal c 0 then
+       let c = Option.compare cmp ot1 ot2 in
+       if Int.equal c 0 then cmp u1 u2
+       else c
+     else c
+  | DCons _, _ -> -1 | _, DCons _ -> 1
+
+  | DNil, DNil -> 0
 
   let fold f acc = function
     | (DRel | DNil | DSort | DRef _) -> acc
@@ -174,7 +195,8 @@ struct
 	    Array.fold_left2 f (Array.fold_left2 f acc ta1 ta2) ca1 ca2
 	| DCons ((t1,topt1),u1), DCons ((t2,topt2),u2) ->
 	    f (Option.fold_left2 f (f acc t1 t2) topt1 topt2) u1 u2
-	| _ -> assert false
+        | (DRel | DNil | DSort | DRef _ | DCtx _ | DApp _ | DLambda _ | DCase _
+           | DFix _ | DCoFix _ | DCons _), _ -> assert false
 
   let map2 (f:'a -> 'b -> 'c) (c1:'a t) (c2:'b t) : 'c t =
     let head w = map (fun _ -> ()) w in
@@ -194,11 +216,13 @@ struct
 	    DCoFix (i,Array.map2 f ta1 ta2,Array.map2 f ca1 ca2)
 	| DCons ((t1,topt1),u1), DCons ((t2,topt2),u2) ->
 	    DCons ((f t1 t2,Option.lift2 f topt1 topt2), f u1 u2)
-	| _ -> assert false
+        | (DRel | DNil | DSort | DRef _ | DCtx _ | DApp _ | DLambda _ | DCase _
+           | DFix _ | DCoFix _ | DCons _), _ -> assert false
 
   let terminal = function
     | (DRel | DSort | DNil | DRef _) -> true
-    | _ -> false
+    | DLambda _ | DApp _ | DCase _ | DFix _ | DCoFix _ | DCtx _ | DCons _ ->
+      false
 
   let compare t1 t2 = compare dummy_cmp t1 t2
 
@@ -257,7 +281,7 @@ struct
   let pat_of_constr c : term_pattern =
     (** To each evar we associate a unique identifier. *)
     let metas = ref Evar.Map.empty in
-    let rec pat_of_constr c = match kind_of_term c with
+    let rec pat_of_constr c = match Constr.kind c with
     | Rel _          -> Term DRel
     | Sort _         -> Term DSort
     | Var i          -> Term (DRef (VarRef i))
@@ -290,7 +314,7 @@ struct
     | Proj (p,c) -> 
         Term (DApp (Term (DRef (ConstRef (Projection.constant p))), pat_of_constr c))
 
-    and ctx_of_constr ctx c = match kind_of_term c with
+    and ctx_of_constr ctx c = match Constr.kind c with
     | Prod (_,t,c)   -> ctx_of_constr (Term(DCons((pat_of_constr t,None),ctx))) c
     | LetIn(_,d,t,c) -> ctx_of_constr (Term(DCons((pat_of_constr t, Some (pat_of_constr d)),ctx))) c
     | _ -> ctx,pat_of_constr c
diff --git a/tactics/term_dnet.mli b/tactics/term_dnet.mli
index 16122fa5e..db7da18ba 100644
--- a/tactics/term_dnet.mli
+++ b/tactics/term_dnet.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Term
+open Constr
 open Mod_subst
 
 (** Dnets on constr terms.
diff --git a/test-suite/Makefile b/test-suite/Makefile
index ae426f0da..16a56f440 100644
--- a/test-suite/Makefile
+++ b/test-suite/Makefile
@@ -40,6 +40,7 @@ coqtopload := $(coqtop) -top Top -async-proofs-cache force -load-vernac-source
 coqtopcompile := $(coqtop) -compile
 coqdep := $(BIN)coqdep -coqlib $(LIB)
 
+VERBOSE?=
 SHOW := $(if $(VERBOSE),@true,@echo)
 HIDE := $(if $(VERBOSE),,@)
 REDIR := $(if $(VERBOSE),,> /dev/null 2>&1)
@@ -92,10 +93,11 @@ VSUBSYSTEMS := prerequisite success failure $(BUGS) output \
   coqdoc
 
 # All subsystems
-SUBSYSTEMS := $(VSUBSYSTEMS) misc bugs ide vio coqchk coq-makefile
+SUBSYSTEMS := $(VSUBSYSTEMS) misc bugs ide vio coqchk coqwc coq-makefile
 
 PREREQUISITELOG = prerequisite/admit.v.log			\
-  prerequisite/make_local.v.log prerequisite/make_notation.v.log
+  prerequisite/make_local.v.log prerequisite/make_notation.v.log \
+  prerequisite/bind_univs.v.log
 
 #######################################################################
 # Phony targets
@@ -156,6 +158,7 @@ summary:
 	  $(call summary_dir, "IDE tests", ide); \
 	  $(call summary_dir, "VI tests", vio); \
 	  $(call summary_dir, "Coqchk tests", coqchk); \
+	  $(call summary_dir, "Coqwc tests", coqwc); \
 	  $(call summary_dir, "Coq makefile", coq-makefile); \
 	  $(call summary_dir, "Coqdoc tests", coqdoc); \
 	  nb_success=`find . -name '*.log' -exec tail -n2 '{}' \; | grep -e $(log_success) | wc -l`; \
@@ -172,10 +175,20 @@ summary.log:
 
 # if not on travis we can get the log files (they're just there for a
 # local build, and downloadable on GitLab)
+PRINT_LOGS?=
+TRAVIS?= # special because we want to print travis_fold directives
+ifdef APPVEYOR
+PRINT_LOGS:=APPVEYOR
+else
+ifdef CIRCLECI
+PRINT_LOGS:=CIRCLECI
+endif #CIRCLECI
+endif #APPVEYOR
+
 report: summary.log
-	$(HIDE)./save-logs.sh
+	$(HIDE)bash save-logs.sh
 	$(HIDE)if [ -n "${TRAVIS}" ]; then find logs/ -name '*.log' -not -name 'summary.log' -exec 'bash' '-c' 'echo "travis_fold:start:coq.logs.$$(echo '{}' | sed s,/,.,g)"' ';' -exec cat '{}' ';' -exec 'bash' '-c' 'echo "travis_fold:end:coq.logs.$$(echo '{}' | sed s,/,.,g)"' ';'; fi
-	$(HIDE)if [ -n "${APPVEYOR}" ]; then find logs/ -name '*.log' -not -name 'summary.log' -exec 'bash' '-c' 'echo {}' ';' -exec cat '{}' ';' -exec 'bash' '-c' 'echo' ';'; fi
+	$(HIDE)if [ -n "${PRINT_LOGS}" ]; then find logs/ -name '*.log' -not -name 'summary.log' -exec 'bash' '-c' 'echo {}' ';' -exec cat '{}' ';' -exec 'bash' '-c' 'echo' ';'; fi
 	$(HIDE)if grep -q -F 'Error!' summary.log ; then echo FAILURES; grep -F 'Error!' summary.log; false; else echo NO FAILURES; fi
 
 #######################################################################
@@ -310,6 +323,13 @@ $(addsuffix .log,$(wildcard output/*.v)): %.v.log: %.v %.out $(PREREQUISITELOG)
 	  rm $$tmpoutput; \
 	} > "$@"
 
+# the expected output for the MExtraction test is
+# /plugins/micromega/micromega.ml except with additional newline
+output/MExtraction.out: ../plugins/micromega/micromega.ml
+	$(SHOW) GEN $@
+	$(HIDE) cp $< $@
+	$(HIDE) echo >> $@
+
 $(addsuffix .log,$(wildcard output-modulo-time/*.v)): %.v.log: %.v %.out
 	@echo "TEST      $< $(call get_coq_prog_args_in_parens,"$<")"
 	$(HIDE){ \
@@ -498,6 +518,26 @@ coqchk: $(patsubst %.v,%.chk.log,$(wildcard coqchk/*.v))
 	  fi; \
 	} > "$@"
 
+# coqwc : test output
+
+coqwc : $(patsubst %.v,%.v.log,$(wildcard coqwc/*.v))
+
+coqwc/%.v.log : coqwc/%.v
+	$(HIDE){ \
+	  echo $(call log_intro,$<); \
+	  tmpoutput=`mktemp /tmp/coqwc.XXXXXX`; \
+	  $(BIN)coqwc $< 2>&1 > $$tmpoutput; \
+	  diff -u --strip-trailing-cr coqwc/$*.out $$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; \
+	} > "$@"
+
 # coq_makefile
 
 coq-makefile: $(patsubst %/run.sh,%.log,$(wildcard coq-makefile/*/run.sh))
@@ -507,7 +547,7 @@ coq-makefile/%.log : coq-makefile/%/run.sh
 	$(HIDE)(\
 	  export COQBIN=$(BIN);\
 	  cd coq-makefile/$* && \
-	  ./run.sh 2>&1; \
+	  bash run.sh 2>&1; \
 	if [ $$? = 0 ]; then \
 	    echo $(log_success); \
 	    echo "    $<...Ok"; \
@@ -528,8 +568,8 @@ $(addsuffix .log,$(wildcard coqdoc/*.v)): %.v.log: %.v %.html.out %.tex.out $(PR
 	  $(coqc) -R coqdoc Coqdoc $* 2>&1; \
 	  cd coqdoc; \
 	  f=`basename $*`; \
-	  $(coqdoc) -R . Coqdoc -coqlib http://coq.inria.fr/stdlib --html $$f.v; \
-	  $(coqdoc) -R . Coqdoc -coqlib http://coq.inria.fr/stdlib --latex $$f.v; \
+	  $(coqdoc) -utf8 -R . Coqdoc -coqlib http://coq.inria.fr/stdlib --html $$f.v; \
+	  $(coqdoc) -utf8 -R . Coqdoc -coqlib http://coq.inria.fr/stdlib --latex $$f.v; \
 	  diff -u --strip-trailing-cr $$f.html.out Coqdoc.$$f.html 2>&1; R=$$?; times; \
 	  grep -v "^%%" Coqdoc.$$f.tex | diff -u --strip-trailing-cr $$f.tex.out - 2>&1; S=$$?; times; \
 	  if [ $$R = 0 -a $$S = 0 ]; then \
diff --git a/test-suite/README.md b/test-suite/README.md
new file mode 100644
index 000000000..1d1195646
--- /dev/null
+++ b/test-suite/README.md
@@ -0,0 +1,75 @@
+# Coq Test Suite
+
+The test suite can be run from the Coq root directory by `make test-suite`.
+This does a clean step first, so if you've already run it, then change something,
+you'll have to do a lot of work again.
+
+If you run `make` from the `test-suite` directory, there is no clean step.
+You can also run `make aaa/bbb/ccc.v.log` to build the log for one test,
+or `make ddd` where `ddd` is on of the sub-directories of `test-suite`
+to just build the logs for that directory.
+In these cases, a summary is not printed, but can be generated by `make summary`.
+
+`make -B` can be used to rerun tests ( -B meaning always remake).
+
+From the `test-suite` directory, `make report` (included in `make
+all`) prints a summary of which tests failed using the produced log
+files (this still works when only some tests are built as described
+above). Setting the `PRINT_LOGS` variable will make it print the logs
+of the failing tests.
+
+For instance, running the following in the `test-suite` directory:
+
+```bash
+$ echo Fail. > success/fail.v # make some failing test
+
+$ make
+TEST      prerequisite/make_local.v
+...
+TEST      success/fail.v
+...
+BUILDING SUMMARY FILE
+FAILURES
+    success/fail.v...Error! (should be accepted)
+Makefile:189: recipe for target 'all failed
+make: *** [report] Error 1
+
+$ make report PRINT_LOGS=1
+BUILDING SUMMARY FILE
+logs/success/fail.v.log
+==========> TESTING success/fail.v <==========
+Welcome to Coq (version information)
+Skipping rcfile loading.
+File "/path/to/success/fail.v", line 1, characters 4-5:
+Error:
+Syntax error: [vernac:Vernac.vernac_control] expected after 'Fail' (in [vernac:Vernac.vernac_control]).
+
+0m0.000000s 0m0.000000s
+0m0.040000s 0m0.000000s
+==========> FAILURE <==========
+    success/fail.v...Error! (should be accepted)
+
+FAILURES
+    success/fail.v...Error! (should be accepted)
+Makefile:189: recipe for target 'report' failed
+make: *** [report] Error 1
+
+$ echo 'Comments "foo".' > success/fail.v
+
+$ make
+TEST      success/fail.v
+BUILDING SUMMARY FILE
+NO FAILURES
+```
+
+See [`test-suite/Makefile`](/test-suite/Makefile) for more information.
+
+## Adding a test
+
+Regression tests for closed bugs should be added to `test-suite/bugs/closed`, as `1234.v` where `1234` is the bug number.
+Files in this directory are tested for successful compilation.
+When you fix a bug, you should usually add a regression test here as well.
+
+The error "(bug seems to be opened, please check)" when running `make test-suite` means that a test in `bugs/closed` failed to compile.
+
+There are also output tests in `test-suite/output` which consist of a `.v` file and a `.out` file with the expected output.
diff --git a/test-suite/bugs/4623.v b/test-suite/bugs/4623.v
index 405d09809..7ecfd98b6 100644
--- a/test-suite/bugs/4623.v
+++ b/test-suite/bugs/4623.v
@@ -2,4 +2,4 @@ Goal Type -> Type.
 set (T := Type).
 clearbody T.
 refine (@id _).
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/4624.v b/test-suite/bugs/4624.v
index a737afcda..f5ce981cd 100644
--- a/test-suite/bugs/4624.v
+++ b/test-suite/bugs/4624.v
@@ -4,4 +4,4 @@ Canonical Structure fooA (T : Type) := mkfoo (T -> T).
 
 Definition id (t : foo) (x : type t) := x.
 
-Definition bar := id _ ((fun x : nat => x) : _).
\ No newline at end of file
+Definition bar := id _ ((fun x : nat => x) : _).
diff --git a/test-suite/bugs/5996.v b/test-suite/bugs/5996.v
new file mode 100644
index 000000000..c9e3292b4
--- /dev/null
+++ b/test-suite/bugs/5996.v
@@ -0,0 +1,8 @@
+Goal Type.
+  let c := constr:(prod nat nat) in
+  let c' := (eval pattern nat in c) in
+  let c' := lazymatch c' with ?f _ => f end in
+  let c'' := lazymatch c' with fun x : Set => ?f => constr:(forall x : Type, f) end in
+  let _ := type of c'' in
+  exact c''.
+Defined.
diff --git a/test-suite/bugs/closed/38.v b/test-suite/bugs/closed/1238.v
index 6b6e83779..6b6e83779 100644
--- a/test-suite/bugs/closed/38.v
+++ b/test-suite/bugs/closed/1238.v
diff --git a/test-suite/bugs/closed/1322.v b/test-suite/bugs/closed/1322.v
index 1ec7d452a..6941ade44 100644
--- a/test-suite/bugs/closed/1322.v
+++ b/test-suite/bugs/closed/1322.v
@@ -12,7 +12,11 @@ Variable I_eq_equiv : Setoid_Theory I I_eq.
   transitivity proved by I_eq_equiv.(Seq_trans I I_eq)
 as I_eq_relation. *)
 
-Add Setoid I I_eq I_eq_equiv as I_with_eq.
+Add Parametric Relation : I I_eq
+  reflexivity  proved by I_eq_equiv.(@Equivalence_Reflexive _ _)
+  symmetry     proved by I_eq_equiv.(@Equivalence_Symmetric _ _)
+  transitivity proved by I_eq_equiv.(@Equivalence_Transitive _ _)
+  as I_with_eq.
 
 Variable F : I -> Type.
 Variable F_morphism : forall i j, I_eq i j -> F i = F j.
diff --git a/test-suite/bugs/closed/121.v b/test-suite/bugs/closed/1341.v
index 8c5a38859..8c5a38859 100644
--- a/test-suite/bugs/closed/121.v
+++ b/test-suite/bugs/closed/1341.v
diff --git a/test-suite/bugs/closed/1362.v b/test-suite/bugs/closed/1362.v
new file mode 100644
index 000000000..6cafb9f0c
--- /dev/null
+++ b/test-suite/bugs/closed/1362.v
@@ -0,0 +1,26 @@
+(** Omega is now aware of the bodies of context variables
+    (of type Z or nat). *)
+
+Require Import ZArith Omega.
+Open Scope Z.
+
+Goal let x := 3 in x = 3.
+intros.
+omega.
+Qed.
+
+Open Scope nat.
+
+Goal let x := 2 in x = 2.
+intros.
+omega.
+Qed.
+
+(** NB: this could be disabled for compatibility reasons *)
+
+Unset Omega UseLocalDefs.
+
+Goal let x := 4 in x = 4.
+intros.
+Fail omega.
+Abort.
diff --git a/test-suite/bugs/closed/1425.v b/test-suite/bugs/closed/1425.v
index 6be30174a..775d278e7 100644
--- a/test-suite/bugs/closed/1425.v
+++ b/test-suite/bugs/closed/1425.v
@@ -16,4 +16,4 @@ Goal forall n : nat, recursion nat 0 (fun _ _ => 1) (S n) = 1.
 intro n.
 setoid_rewrite recursion_S.
 reflexivity.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/328.v b/test-suite/bugs/closed/1542.v
index 52cfbbc49..52cfbbc49 100644
--- a/test-suite/bugs/closed/328.v
+++ b/test-suite/bugs/closed/1542.v
diff --git a/test-suite/bugs/closed/329.v b/test-suite/bugs/closed/1543.v
index def6ed98d..def6ed98d 100644
--- a/test-suite/bugs/closed/329.v
+++ b/test-suite/bugs/closed/1543.v
diff --git a/test-suite/bugs/closed/331.v b/test-suite/bugs/closed/1545.v
index 9ef796faf..9ef796faf 100644
--- a/test-suite/bugs/closed/331.v
+++ b/test-suite/bugs/closed/1545.v
diff --git a/test-suite/bugs/closed/335.v b/test-suite/bugs/closed/1547.v
index 166fa7a9f..166fa7a9f 100644
--- a/test-suite/bugs/closed/335.v
+++ b/test-suite/bugs/closed/1547.v
diff --git a/test-suite/bugs/closed/348.v b/test-suite/bugs/closed/1551.v
index 48f0b5512..48f0b5512 100644
--- a/test-suite/bugs/closed/348.v
+++ b/test-suite/bugs/closed/1551.v
diff --git a/test-suite/bugs/closed/545.v b/test-suite/bugs/closed/1584.v
index 926af7dd1..926af7dd1 100644
--- a/test-suite/bugs/closed/545.v
+++ b/test-suite/bugs/closed/1584.v
diff --git a/test-suite/bugs/closed/1738.v b/test-suite/bugs/closed/1738.v
index c2926a2b2..ef52c876c 100644
--- a/test-suite/bugs/closed/1738.v
+++ b/test-suite/bugs/closed/1738.v
@@ -27,4 +27,4 @@ Module Test (Import M:FSetInterface.S).
  rewrite H in H0.
  assumption.
 Qed.
-End Test.
\ No newline at end of file
+End Test.
diff --git a/test-suite/bugs/closed/1900.v b/test-suite/bugs/closed/1900.v
index cf03efda4..6eea5db08 100644
--- a/test-suite/bugs/closed/1900.v
+++ b/test-suite/bugs/closed/1900.v
@@ -5,4 +5,4 @@ Definition eq_A := @eq A.
 Goal forall x, eq_A x x.
 intros.
 reflexivity.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/1901.v b/test-suite/bugs/closed/1901.v
index 7d86adbfb..98e017f9d 100644
--- a/test-suite/bugs/closed/1901.v
+++ b/test-suite/bugs/closed/1901.v
@@ -8,4 +8,4 @@ Record Poset{A:Type}(Le : relation A) : Type :=
     Le_antisym : forall x y : A, Le x y -> Le y x -> x = y }.
 
 Definition nat_Poset : Poset Peano.le.
-Admitted.
\ No newline at end of file
+Admitted.
diff --git a/test-suite/bugs/closed/1905.v b/test-suite/bugs/closed/1905.v
index 8c81d7510..3b8a3d2f6 100644
--- a/test-suite/bugs/closed/1905.v
+++ b/test-suite/bugs/closed/1905.v
@@ -10,4 +10,4 @@ Goal forall a s,
 Proof.
  intros a s Ia.
  rewrite InE in Ia.
-Admitted.
\ No newline at end of file
+Admitted.
diff --git a/test-suite/bugs/closed/1915.v b/test-suite/bugs/closed/1915.v
index 7e62437d7..2b0aed8c7 100644
--- a/test-suite/bugs/closed/1915.v
+++ b/test-suite/bugs/closed/1915.v
@@ -3,4 +3,4 @@ Require Import Setoid.
 
 Fail Goal forall x, impl True (x = 0) -> x = 0 -> False.
 (*intros x H E.
-rewrite H in E.*)
\ No newline at end of file
+rewrite H in E.*)
diff --git a/test-suite/bugs/closed/1939.v b/test-suite/bugs/closed/1939.v
index 5e61529b4..7b430ace5 100644
--- a/test-suite/bugs/closed/1939.v
+++ b/test-suite/bugs/closed/1939.v
@@ -16,4 +16,4 @@ Require Import Setoid Program.Basics.
    intros x y H1 H2.
    rewrite H1.
    auto.
- Qed.
\ No newline at end of file
+ Qed.
diff --git a/test-suite/bugs/closed/1962.v b/test-suite/bugs/closed/1962.v
index a6b0fee58..37b0dde06 100644
--- a/test-suite/bugs/closed/1962.v
+++ b/test-suite/bugs/closed/1962.v
@@ -52,4 +52,4 @@ unfold triple, couple.
 Time fsetdec.
 Qed.
 
-End BuildFSets.
\ No newline at end of file
+End BuildFSets.
diff --git a/test-suite/bugs/closed/2027.v b/test-suite/bugs/closed/2027.v
index fb53c6ef4..ebc2bc070 100644
--- a/test-suite/bugs/closed/2027.v
+++ b/test-suite/bugs/closed/2027.v
@@ -8,4 +8,4 @@ Goal forall A (p : T A), P p.
 Proof.
   intros.
   rewrite <- f_id.
-Admitted.
\ No newline at end of file
+Admitted.
diff --git a/test-suite/bugs/closed/2136.v b/test-suite/bugs/closed/2136.v
index d2b926f37..2fcfbe40d 100644
--- a/test-suite/bugs/closed/2136.v
+++ b/test-suite/bugs/closed/2136.v
@@ -58,4 +58,4 @@ fsetdec.
 (*
 Error: Tactic failure: because the goal is beyond the scope of this tactic.
 *)
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/2137.v b/test-suite/bugs/closed/2137.v
index 6c2023ab7..b1f54b176 100644
--- a/test-suite/bugs/closed/2137.v
+++ b/test-suite/bugs/closed/2137.v
@@ -49,4 +49,4 @@ fsetdec.
 (*
 Error: Tactic failure: because the goal is beyond the scope of this tactic.
 *)
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/2141.v b/test-suite/bugs/closed/2141.v
index c556ff0b2..22e33c8e8 100644
--- a/test-suite/bugs/closed/2141.v
+++ b/test-suite/bugs/closed/2141.v
@@ -13,4 +13,4 @@ Module NatSet' := FSetHide NatSet.
 Recursive Extraction NatSet'.fold.
 Extraction TestCompile NatSet'.fold.
 
-(* Extraction "test2141.ml" NatSet'.fold. *)
\ No newline at end of file
+(* Extraction "test2141.ml" NatSet'.fold. *)
diff --git a/test-suite/bugs/closed/2281.v b/test-suite/bugs/closed/2281.v
index 40948d905..8f549b920 100644
--- a/test-suite/bugs/closed/2281.v
+++ b/test-suite/bugs/closed/2281.v
@@ -47,4 +47,4 @@ intros.
 fsetdec.
 (* Error: Tactic failure: because the goal is beyond the scope of this tactic.
 *)
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/2310.v b/test-suite/bugs/closed/2310.v
index 7fae32871..14a3e5a7b 100644
--- a/test-suite/bugs/closed/2310.v
+++ b/test-suite/bugs/closed/2310.v
@@ -18,4 +18,4 @@ Definition replace a (y:Nest (prod a a)) : a = a -> Nest a.
   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
+  refine (Nest (prod X X)). Qed.
diff --git a/test-suite/bugs/closed/2319.v b/test-suite/bugs/closed/2319.v
index e06fb9759..73d95e91a 100644
--- a/test-suite/bugs/closed/2319.v
+++ b/test-suite/bugs/closed/2319.v
@@ -10,4 +10,4 @@ Section S.
         with t : A unit := mkA unit (mkA unit t).
   Timeout 5 Eval vm_compute in s.
 
-End S.
\ No newline at end of file
+End S.
diff --git a/test-suite/bugs/closed/2464.v b/test-suite/bugs/closed/2464.v
index af7085872..b9db30359 100644
--- a/test-suite/bugs/closed/2464.v
+++ b/test-suite/bugs/closed/2464.v
@@ -36,4 +36,4 @@ Lemma foo : forall (pu_type : Type)
             NameSetMod.Equal ns2 (NameSetMod.add (pu_nameOf p) ns).
 Proof.
 NameSetDec.fsetdec.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/2473.v b/test-suite/bugs/closed/2473.v
index fb676c7e4..0e7c0c25f 100644
--- a/test-suite/bugs/closed/2473.v
+++ b/test-suite/bugs/closed/2473.v
@@ -37,4 +37,4 @@ Section S3.
    rewrite <- H.                (* ok *)
    admit.
   Qed.
-End S3.
\ No newline at end of file
+End S3.
diff --git a/test-suite/bugs/closed/2584.v b/test-suite/bugs/closed/2584.v
index a5f4ae64a..ef2e4e355 100644
--- a/test-suite/bugs/closed/2584.v
+++ b/test-suite/bugs/closed/2584.v
@@ -86,4 +86,4 @@ should be "Prop" or "Set".
 Elimination of an inductive object of sort Set
 is not allowed on a predicate in sort Type
 because strong elimination on non-small inductive types leads to paradoxes.
-*)
\ No newline at end of file
+*)
diff --git a/test-suite/bugs/closed/2586.v b/test-suite/bugs/closed/2586.v
index 7e02e7f11..e57bcc25b 100644
--- a/test-suite/bugs/closed/2586.v
+++ b/test-suite/bugs/closed/2586.v
@@ -3,4 +3,4 @@ Require Import Setoid SetoidClass Program.
 Goal forall `(Setoid nat) x y, x == y -> S x == S y.
   intros.
   Fail clsubst H0.
-  Abort.
\ No newline at end of file
+  Abort.
diff --git a/test-suite/bugs/closed/2602.v b/test-suite/bugs/closed/2602.v
index f07447886..29c8ac16b 100644
--- a/test-suite/bugs/closed/2602.v
+++ b/test-suite/bugs/closed/2602.v
@@ -5,4 +5,4 @@ match goal with
      match goal with
        | |- S a > 0 => idtac
      end
-end.
\ No newline at end of file
+end.
diff --git a/test-suite/bugs/closed/2615.v b/test-suite/bugs/closed/2615.v
index 38c1cfc84..26c0f334d 100644
--- a/test-suite/bugs/closed/2615.v
+++ b/test-suite/bugs/closed/2615.v
@@ -14,4 +14,4 @@ refine (fun p => match p with _ => _ end).
 Undo.
 refine (fun p => match p with foo_intro _ _ => _ end).
 admit.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/2668.v b/test-suite/bugs/closed/2668.v
index 74c8fa347..d5bbfd3f0 100644
--- a/test-suite/bugs/closed/2668.v
+++ b/test-suite/bugs/closed/2668.v
@@ -3,4 +3,4 @@ Require Import MSetProperties.
 
 Module Pos := MSetPositive.PositiveSet.
 Module PPPP := MSetProperties.WPropertiesOn(Pos).
-Print Module PPPP.
\ No newline at end of file
+Print Module PPPP.
diff --git a/test-suite/bugs/closed/2734.v b/test-suite/bugs/closed/2734.v
index 826361be2..3210214ea 100644
--- a/test-suite/bugs/closed/2734.v
+++ b/test-suite/bugs/closed/2734.v
@@ -12,4 +12,4 @@ Inductive control := Go: expr ->  control.
 
 Definition program :=  (Adr.t * (control))%type.
 
-Fail Definition myprog : program := (Adr.nat2t 0,   Go (Adr.nat2t 0) ).
\ No newline at end of file
+Fail Definition myprog : program := (Adr.nat2t 0,   Go (Adr.nat2t 0) ).
diff --git a/test-suite/bugs/closed/2750.v b/test-suite/bugs/closed/2750.v
index fc580f101..9d65e51f6 100644
--- a/test-suite/bugs/closed/2750.v
+++ b/test-suite/bugs/closed/2750.v
@@ -20,4 +20,4 @@ Module Test_ModWithRecord (M : ModWithRecord).
     {| M.A := 0
      ; M.B := 2
      |}.
-End Test_ModWithRecord.
\ No newline at end of file
+End Test_ModWithRecord.
diff --git a/test-suite/bugs/closed/2837.v b/test-suite/bugs/closed/2837.v
index 5d9844639..52a56c2cf 100644
--- a/test-suite/bugs/closed/2837.v
+++ b/test-suite/bugs/closed/2837.v
@@ -12,4 +12,4 @@ Fail rewrite test.
 Fail (intros; rewrite test).
 
 (* III) a working variant: *)
-intros; rewrite (test n m).
\ No newline at end of file
+intros; rewrite (test n m).
diff --git a/test-suite/bugs/closed/2848.v b/test-suite/bugs/closed/2848.v
index 828e3b8c1..e23463033 100644
--- a/test-suite/bugs/closed/2848.v
+++ b/test-suite/bugs/closed/2848.v
@@ -7,4 +7,4 @@ Add Parametric Relation : _ equiv'
   reflexivity proved by (Equivalence.equiv_reflexive cheat)
   transitivity proved by (Equivalence.equiv_transitive cheat)
     as apply_equiv'_rel.
-Check apply_equiv'_rel : PreOrder equiv'.
\ No newline at end of file
+Check apply_equiv'_rel : PreOrder equiv'.
diff --git a/test-suite/bugs/closed/2881.v b/test-suite/bugs/closed/2881.v
new file mode 100644
index 000000000..b4f09305b
--- /dev/null
+++ b/test-suite/bugs/closed/2881.v
@@ -0,0 +1,7 @@
+(* About scoping of pattern variables in strict/non-strict mode *)
+
+Ltac eta_red := change (fun a => ?f0 a) with f0.
+Goal forall T1 T2 (f : T1 -> T2), (fun x => f x) = f.
+intros.
+eta_red.
+Abort.
diff --git a/test-suite/bugs/closed/2955.v b/test-suite/bugs/closed/2955.v
index 45e24b5f5..11fd7bada 100644
--- a/test-suite/bugs/closed/2955.v
+++ b/test-suite/bugs/closed/2955.v
@@ -49,4 +49,4 @@ Module E.
     assumption.
   Qed.
 
-End E.
\ No newline at end of file
+End E.
diff --git a/test-suite/bugs/closed/2983.v b/test-suite/bugs/closed/2983.v
index 15598352b..ad7635094 100644
--- a/test-suite/bugs/closed/2983.v
+++ b/test-suite/bugs/closed/2983.v
@@ -5,4 +5,4 @@ End ModB.
 Module Foo(A : ModA)(B : ModB A).
 End Foo.
 
-Print Module Foo.
\ No newline at end of file
+Print Module Foo.
diff --git a/test-suite/bugs/closed/2995.v b/test-suite/bugs/closed/2995.v
index ba3acd088..b6c5b6df4 100644
--- a/test-suite/bugs/closed/2995.v
+++ b/test-suite/bugs/closed/2995.v
@@ -6,4 +6,4 @@ Module Implementation <: Interface.
   Definition t := bool.
   Definition error: t := false.
 Fail End Implementation.
-(* A UserError here is expected, not an uncaught Not_found *)
\ No newline at end of file
+(* A UserError here is expected, not an uncaught Not_found *)
diff --git a/test-suite/bugs/closed/3008.v b/test-suite/bugs/closed/3008.v
index 3f3a979a3..1979eda82 100644
--- a/test-suite/bugs/closed/3008.v
+++ b/test-suite/bugs/closed/3008.v
@@ -26,4 +26,4 @@ Fail Module Toto
 
 (* NB : the Inductive above and the A=A weren't in the initial test,
    they are here only to force an access to the environment
-   (cf [Printer.qualid_of_global]) and check that this env is ok. *)
\ No newline at end of file
+   (cf [Printer.qualid_of_global]) and check that this env is ok. *)
diff --git a/test-suite/bugs/closed/3125.v b/test-suite/bugs/closed/3125.v
new file mode 100644
index 000000000..797146174
--- /dev/null
+++ b/test-suite/bugs/closed/3125.v
@@ -0,0 +1,27 @@
+(* Not considering singleton template-polymorphic inductive types as
+   propositions for injection/inversion *)
+
+(* This is also #4560 and #6273 *)
+
+Inductive foo := foo_1.
+
+Goal forall (a b : foo), Some a = Some b -> a = b.
+Proof.
+  intros a b H.
+  inversion H.
+  reflexivity.
+Qed.
+
+(* Check that Prop is not concerned *)
+
+Inductive bar : Prop := bar_1.
+
+Goal
+  forall (a b : bar),
+    Some a = Some b ->
+    a = b.
+Proof.
+  intros a b H.
+  inversion H.
+  Fail reflexivity.
+Abort.
diff --git a/test-suite/bugs/closed/3319.v b/test-suite/bugs/closed/3319.v
index 3b37e39e5..fbf5d86dc 100644
--- a/test-suite/bugs/closed/3319.v
+++ b/test-suite/bugs/closed/3319.v
@@ -23,4 +23,4 @@ Section precategory.
     = morphism' xa yb. 
   Proof.
     admit.
-  Defined.
\ No newline at end of file
+  Defined.
diff --git a/test-suite/bugs/closed/3331.v b/test-suite/bugs/closed/3331.v
index 9cd44bd0c..b7dbb290e 100644
--- a/test-suite/bugs/closed/3331.v
+++ b/test-suite/bugs/closed/3331.v
@@ -28,4 +28,4 @@ Section groupoid_category.
     clear H' foo.
     Set Typeclasses Debug.
     pose (_ : Contr (idpath = idpath :> (@paths (@paths X d d) idpath idpath))). 
-Abort. 
\ No newline at end of file
+Abort. 
diff --git a/test-suite/bugs/closed/3352.v b/test-suite/bugs/closed/3352.v
index 555accfd5..bf2f7a9d1 100644
--- a/test-suite/bugs/closed/3352.v
+++ b/test-suite/bugs/closed/3352.v
@@ -32,4 +32,4 @@ simpl.
 Set Printing Universes.
 exact hprop_Empty.
 Defined.
-End B.
\ No newline at end of file
+End B.
diff --git a/test-suite/bugs/closed/3387.v b/test-suite/bugs/closed/3387.v
index cb435e786..1d9e78337 100644
--- a/test-suite/bugs/closed/3387.v
+++ b/test-suite/bugs/closed/3387.v
@@ -19,4 +19,4 @@ Proof.
   first [ unify x y | fail 2 "no unify" ];
     change x with y at -1. (* Error: Not convertible. *)
   reflexivity.
-Defined.
\ No newline at end of file
+Defined.
diff --git a/test-suite/bugs/closed/3392.v b/test-suite/bugs/closed/3392.v
index 3a5986954..a03db7754 100644
--- a/test-suite/bugs/closed/3392.v
+++ b/test-suite/bugs/closed/3392.v
@@ -37,4 +37,4 @@ Proof.
         rewrite eissect;
         apply apD
       ).
-Defined.
\ No newline at end of file
+Defined.
diff --git a/test-suite/bugs/closed/3402.v b/test-suite/bugs/closed/3402.v
index ed47ec825..b4705780d 100644
--- a/test-suite/bugs/closed/3402.v
+++ b/test-suite/bugs/closed/3402.v
@@ -4,4 +4,4 @@ Goal forall A B (p : prod A B), p = let (x, y) := p in pair A B x y.
 Proof.
   intros A B p.
   exact eq_refl.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/3428.v b/test-suite/bugs/closed/3428.v
index 3eb75e43a..16ace90af 100644
--- a/test-suite/bugs/closed/3428.v
+++ b/test-suite/bugs/closed/3428.v
@@ -32,4 +32,4 @@ z' : prod A B
 p : @paths A (foo.fst ?11 ?14 z) (foo.fst ?26 ?29 z')
 q : @paths ?54 (foo.snd ?42 ?45 z) (foo.snd ?57 ?60 z')
 The term "p" has type "@paths A (foo.fst ?11 ?14 z) (foo.fst ?26 ?29 z')"
-while it is expected to have type "@paths A (foo.fst z) (foo.fst z')". *)
\ No newline at end of file
+while it is expected to have type "@paths A (foo.fst z) (foo.fst z')". *)
diff --git a/test-suite/bugs/closed/3439.v b/test-suite/bugs/closed/3439.v
index 1ea24bf1b..e8c2d8b8c 100644
--- a/test-suite/bugs/closed/3439.v
+++ b/test-suite/bugs/closed/3439.v
@@ -41,4 +41,4 @@ Module prim.
     Undo.
     solve [ typeclasses eauto ]. (*  Error: No applicable tactic. *)
   Defined.
-End prim.
\ No newline at end of file
+End prim.
diff --git a/test-suite/bugs/closed/3441.v b/test-suite/bugs/closed/3441.v
index 50d297807..ddfb33944 100644
--- a/test-suite/bugs/closed/3441.v
+++ b/test-suite/bugs/closed/3441.v
@@ -20,4 +20,4 @@ Timeout 1 let H := fresh "H" in
 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
+     assert (H := y). (* Finished transaction in 1.19 secs (1.164u,0.024s) (successful) *)
diff --git a/test-suite/bugs/closed/3446.v b/test-suite/bugs/closed/3446.v
index dce73e1a5..8a0c98c33 100644
--- a/test-suite/bugs/closed/3446.v
+++ b/test-suite/bugs/closed/3446.v
@@ -48,4 +48,4 @@ Instance isequiv_pr1_contr {A} {P : A -> Type} : IsEquiv (@pr1 A P) | 100.
 Admitted.
 
 Definition path_sigma_hprop {A : Type} {P : A -> Type} (u v : sigT P) : u.1 = v.1 -> u = v := 
-  path_sigma_uncurried P u v o pr1^-1.
\ No newline at end of file
+  path_sigma_uncurried P u v o pr1^-1.
diff --git a/test-suite/bugs/closed/3477.v b/test-suite/bugs/closed/3477.v
index e94148647..3ed63604e 100644
--- a/test-suite/bugs/closed/3477.v
+++ b/test-suite/bugs/closed/3477.v
@@ -6,4 +6,4 @@ Proof.
   intros A B.
   evar (a : prod A B); evar (f : (prod A B -> Set)).
   let a' := (eval unfold a in a) in
-  set(foo:=eq_refl : a' = (@pair _ _ (fst a') (snd a'))).
\ No newline at end of file
+  set(foo:=eq_refl : a' = (@pair _ _ (fst a') (snd a'))).
diff --git a/test-suite/bugs/closed/3480.v b/test-suite/bugs/closed/3480.v
index a81837e71..35e0c51a9 100644
--- a/test-suite/bugs/closed/3480.v
+++ b/test-suite/bugs/closed/3480.v
@@ -45,4 +45,4 @@ yb : object StrX
 x : xa <~=~> yb
 The term "morphism_isomorphic:@morphism (precategory_of_structures P) xa yb"
 has type "@morphism (precategory_of_structures P) xa yb"
-while it is expected to have type "morphism ?40 ?41 ?42". *)
\ No newline at end of file
+while it is expected to have type "morphism ?40 ?41 ?42". *)
diff --git a/test-suite/bugs/closed/3482.v b/test-suite/bugs/closed/3482.v
index 34a5e73da..87fd2723c 100644
--- a/test-suite/bugs/closed/3482.v
+++ b/test-suite/bugs/closed/3482.v
@@ -8,4 +8,4 @@ Check foo _. (* Toplevel input, characters 6-11:
 Error: Illegal application (Non-functional construction):
 The expression "foo" of type "True"
 cannot be applied to the term
- "?36" : "?35" *)
\ No newline at end of file
+ "?36" : "?35" *)
diff --git a/test-suite/bugs/closed/3484.v b/test-suite/bugs/closed/3484.v
index dc88a332b..a0e157303 100644
--- a/test-suite/bugs/closed/3484.v
+++ b/test-suite/bugs/closed/3484.v
@@ -28,4 +28,4 @@ T : Type
 H : sigT T (fun g : T => paths g g)
 x : T
 Unable to unify "paths (@projT1 ?24 ?23 ?25) (@projT1 ?24 ?23 ?26)" with
- "paths (projT1 H) (projT1 {| projT1 := x; projT2 := idpath |})". *)
\ No newline at end of file
+ "paths (projT1 H) (projT1 {| projT1 := x; projT2 := idpath |})". *)
diff --git a/test-suite/bugs/closed/3513.v b/test-suite/bugs/closed/3513.v
index 9ed0926a6..5adc48215 100644
--- a/test-suite/bugs/closed/3513.v
+++ b/test-suite/bugs/closed/3513.v
@@ -91,4 +91,4 @@ Debug: 2.2.1.1.1.1: apply ILFun_ILogic on (ILogic OPred)
   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/3531.v b/test-suite/bugs/closed/3531.v
index 764a7334e..3502b4f54 100644
--- a/test-suite/bugs/closed/3531.v
+++ b/test-suite/bugs/closed/3531.v
@@ -51,4 +51,4 @@ Goal forall b, (exists e1 e2 e3,
  admit.
  admit.
  Show Universes.
-Time Qed.
\ No newline at end of file
+Time Qed.
diff --git a/test-suite/bugs/closed/3559.v b/test-suite/bugs/closed/3559.v
index da12b6868..5210b2703 100644
--- a/test-suite/bugs/closed/3559.v
+++ b/test-suite/bugs/closed/3559.v
@@ -65,6 +65,7 @@ Axiom path_iff_hprop_uncurried : forall `{IsHProp A, IsHProp B}, (A <-> B) -> A
 = B.
 Inductive V : Type@{U'} := | set {A : Type@{U}} (f : A -> V) : V.
 Axiom is0trunc_V : IsTrunc (trunc_S (trunc_S minus_two)) V.
+Existing Instance is0trunc_V.
 Axiom bisimulation : V@{U' U} -> V@{U' U} -> hProp@{U'}.
 Axiom bisimulation_refl : forall (v : V), bisimulation v v.
 Axiom bisimulation_eq : forall (u v : V), bisimulation u v -> u = v.
diff --git a/test-suite/bugs/closed/3560.v b/test-suite/bugs/closed/3560.v
index 65ce4fb6b..a740675f3 100644
--- a/test-suite/bugs/closed/3560.v
+++ b/test-suite/bugs/closed/3560.v
@@ -12,4 +12,4 @@ Goal forall (A B : Type) (C : Type), Equiv (A -> B -> C) (A * B -> C).
 Proof.
   intros.
   exists (fun u => fun x => u (fst x) (snd x)).
-Abort.
\ No newline at end of file
+Abort.
diff --git a/test-suite/bugs/closed/3561.v b/test-suite/bugs/closed/3561.v
index f6cbc9299..ef4422eea 100644
--- a/test-suite/bugs/closed/3561.v
+++ b/test-suite/bugs/closed/3561.v
@@ -21,4 +21,4 @@ Goal forall (H0 H2 : Type) x p,
   intros. 
   match goal with
     | [ |- context[x (?f _)] ] => set(foo':=f)
-  end.
\ No newline at end of file
+  end.
diff --git a/test-suite/bugs/closed/3567.v b/test-suite/bugs/closed/3567.v
index cb16b3ae4..00c9c0546 100644
--- a/test-suite/bugs/closed/3567.v
+++ b/test-suite/bugs/closed/3567.v
@@ -65,4 +65,4 @@ ap (path_prod_uncurried z0 z')
 which is ill-typed.
 Reason is: Pattern-matching expression on an object of inductive type prod
 has invalid information.
- *)
\ No newline at end of file
+ *)
diff --git a/test-suite/bugs/closed/3584.v b/test-suite/bugs/closed/3584.v
index 3d4660b48..37fe46376 100644
--- a/test-suite/bugs/closed/3584.v
+++ b/test-suite/bugs/closed/3584.v
@@ -13,4 +13,4 @@ Definition sum_of_sigT A B (x : sigT (fun b : bool => if b then A else B))
        | existT _ false b => inr b
      end. (* Toplevel input, characters 0-182:
 Error: Pattern-matching expression on an object of inductive type sigT
-has invalid information. *)
\ No newline at end of file
+has invalid information. *)
diff --git a/test-suite/bugs/closed/3590.v b/test-suite/bugs/closed/3590.v
index 3ef9270d4..9fded85a8 100644
--- a/test-suite/bugs/closed/3590.v
+++ b/test-suite/bugs/closed/3590.v
@@ -9,4 +9,4 @@ Qed.
   
 (* Toplevel input, characters 20-58:
 Error: Failed to get enough information from the left-hand side to type the
-right-hand side. *)
\ No newline at end of file
+right-hand side. *)
diff --git a/test-suite/bugs/closed/3594.v b/test-suite/bugs/closed/3594.v
index d1aae7b44..1f86f4bd7 100644
--- a/test-suite/bugs/closed/3594.v
+++ b/test-suite/bugs/closed/3594.v
@@ -48,4 +48,4 @@ while it is expected to have type
                object := opposite D;
                morphism := fun s d : opposite D => morphism (opposite D) d s |}"
 and "opposite D").
- *)
\ No newline at end of file
+ *)
diff --git a/test-suite/bugs/closed/3596.v b/test-suite/bugs/closed/3596.v
index 49dd7be5a..1ee9a5d8c 100644
--- a/test-suite/bugs/closed/3596.v
+++ b/test-suite/bugs/closed/3596.v
@@ -16,4 +16,4 @@ Goal forall f b, Bar b = Bar b -> Foo f = Foo f.
   Fail progress unfold Bar. (* success *)
   Fail progress unfold Foo. (* failed to progress *)
   reflexivity.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/3618.v b/test-suite/bugs/closed/3618.v
index dc560ad52..674b4cc2f 100644
--- a/test-suite/bugs/closed/3618.v
+++ b/test-suite/bugs/closed/3618.v
@@ -100,4 +100,4 @@ Hint Mode IsEquiv - - + : typeclass_instances.
 
 Fail Definition equiv_O_rectnd {fs : Funext} {subU : ReflectiveSubuniverse}
            (P Q : Type) {Q_inO : inO_internal Q}
-: IsEquiv (fun f : O P -> P => compose f (O_unit P)) := _.
\ No newline at end of file
+: IsEquiv (fun f : O P -> P => compose f (O_unit P)) := _.
diff --git a/test-suite/bugs/closed/3624.v b/test-suite/bugs/closed/3624.v
index a05d5eb21..024243cfd 100644
--- a/test-suite/bugs/closed/3624.v
+++ b/test-suite/bugs/closed/3624.v
@@ -8,4 +8,4 @@ Module Prim.
   Set Primitive Projections.
   Class foo (m : Set) := { pf : m = m }.
   Notation pf' m := (pf (m:=m)). (* Wrong argument name: m. *)
-End Prim.
\ No newline at end of file
+End Prim.
diff --git a/test-suite/bugs/closed/3633.v b/test-suite/bugs/closed/3633.v
index 6a952377c..52bb30727 100644
--- a/test-suite/bugs/closed/3633.v
+++ b/test-suite/bugs/closed/3633.v
@@ -7,4 +7,4 @@ Proof.
   (* Ensure the constraints are solved independently, otherwise a frozen ?A 
   makes a search for Contr ?A fail when finishing to apply (fun x => x) *)
   apply (fun x => x), center. 
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/3638.v b/test-suite/bugs/closed/3638.v
index 70144174d..5441fbedc 100644
--- a/test-suite/bugs/closed/3638.v
+++ b/test-suite/bugs/closed/3638.v
@@ -22,4 +22,4 @@ Goal forall (A B : Type) (x : O A * O B) (x0 : B),
   
 
 (* Toplevel input, characters 15-114:
-Anomaly: Bad recursive type. Please report. *)
\ No newline at end of file
+Anomaly: Bad recursive type. Please report. *)
diff --git a/test-suite/bugs/closed/3640.v b/test-suite/bugs/closed/3640.v
index bdbfbb152..5dff98ba2 100644
--- a/test-suite/bugs/closed/3640.v
+++ b/test-suite/bugs/closed/3640.v
@@ -28,4 +28,4 @@ Proof.
   simpl in *.
   Fail match type of H with
     | _ = negb ?T => unify T (f.1 true); fail 1 "still has f.1 true"
-  end. (* Error: Tactic failure: still has f.1 true. *)
\ No newline at end of file
+  end. (* Error: Tactic failure: still has f.1 true. *)
diff --git a/test-suite/bugs/closed/3641.v b/test-suite/bugs/closed/3641.v
index f47f64ead..730ab3f43 100644
--- a/test-suite/bugs/closed/3641.v
+++ b/test-suite/bugs/closed/3641.v
@@ -18,4 +18,4 @@ Goal forall (A B : Type) (x : O A * O B) (x0 : B),
   match goal with
     | [ |- context[?e] ] => is_evar e; let e' := fresh "e'" in pose (e' := e)
   end.
-  Fail change ?g with e'. (* Stack overflow *)
\ No newline at end of file
+  Fail change ?g with e'. (* Stack overflow *)
diff --git a/test-suite/bugs/closed/3648.v b/test-suite/bugs/closed/3648.v
index ba6006ed9..58aa16140 100644
--- a/test-suite/bugs/closed/3648.v
+++ b/test-suite/bugs/closed/3648.v
@@ -80,4 +80,4 @@ Error:
 Found no subterm matching "F _1 (identity (fst x))" in the current goal. *)
   rewrite identity_of. (* Toplevel input, characters 15-34:
 Error:
-Found no subterm matching "morphism_of ?202 (identity ?203)" in the current goal. *)
\ No newline at end of file
+Found no subterm matching "morphism_of ?202 (identity ?203)" in the current goal. *)
diff --git a/test-suite/bugs/closed/3658.v b/test-suite/bugs/closed/3658.v
index 622c3c94a..74f4e82db 100644
--- a/test-suite/bugs/closed/3658.v
+++ b/test-suite/bugs/closed/3658.v
@@ -72,4 +72,4 @@ Module Prim.
     end. (* Error: Tactic failure: bad H1. *)
     admit.
   Defined.
-End Prim.
\ No newline at end of file
+End Prim.
diff --git a/test-suite/bugs/closed/3661.v b/test-suite/bugs/closed/3661.v
index fdca49bc4..1f13ffcf3 100644
--- a/test-suite/bugs/closed/3661.v
+++ b/test-suite/bugs/closed/3661.v
@@ -85,4 +85,4 @@ Goal forall (x3 x9 : PreCategory) (x12 f0 : Functor x9 x3)
      (@morphism_inverse _ _ _
         (@morphism_isomorphic (functor_category x9 x3) f0 x12 x35) _) x37)
 
-*)
\ No newline at end of file
+*)
diff --git a/test-suite/bugs/closed/3664.v b/test-suite/bugs/closed/3664.v
index 63a81b6d0..cd1427a14 100644
--- a/test-suite/bugs/closed/3664.v
+++ b/test-suite/bugs/closed/3664.v
@@ -21,4 +21,4 @@ Module Prim.
     Fail progress cbn. (* [cbn] succeeds incorrectly, giving [d x] *)
     admit.
   Defined.
-End Prim.
\ No newline at end of file
+End Prim.
diff --git a/test-suite/bugs/closed/3666.v b/test-suite/bugs/closed/3666.v
index e69ec1097..c7bc2f22a 100644
--- a/test-suite/bugs/closed/3666.v
+++ b/test-suite/bugs/closed/3666.v
@@ -48,4 +48,4 @@ H' : H_f a (h c) = H_g b (h c)
 Unable to unify "hproptype (H_f a (h c))" with "?T (H_f a (h c))".
  *)
   Defined.
-End Prim.
\ No newline at end of file
+End Prim.
diff --git a/test-suite/bugs/closed/3668.v b/test-suite/bugs/closed/3668.v
index da01ed00e..1add3dba1 100644
--- a/test-suite/bugs/closed/3668.v
+++ b/test-suite/bugs/closed/3668.v
@@ -51,4 +51,4 @@ Module Prim.
     end. (* Tactic failure: bad *)
     all:admit.
   Defined.
-End Prim.
\ No newline at end of file
+End Prim.
diff --git a/test-suite/bugs/closed/3672.v b/test-suite/bugs/closed/3672.v
index 283be4958..b355e7e9d 100644
--- a/test-suite/bugs/closed/3672.v
+++ b/test-suite/bugs/closed/3672.v
@@ -24,4 +24,4 @@ Record Ar3 C (A:AT) :=
 ; id3 : forall X, ar3 X X }.
 (* The command has indeed failed with message:
 => Anomaly: Bad recursive type. Please report.
-*)
\ No newline at end of file
+*)
diff --git a/test-suite/bugs/closed/3690.v b/test-suite/bugs/closed/3690.v
index fd9640b89..fa30132ab 100644
--- a/test-suite/bugs/closed/3690.v
+++ b/test-suite/bugs/closed/3690.v
@@ -3,49 +3,44 @@ Set Printing Universes.
 Set Universe Polymorphism.
 Definition foo (a := Type) (b := Type) (c := Type) := Type.
 Print foo.
-(* foo =
-let a := Type@{Top.1} in
-let b := Type@{Top.2} in let c := Type@{Top.3} in Type@{Top.4}
-     : Type@{Top.4+1}
-(* Top.1
-   Top.2
-   Top.3
-   Top.4 |=  *) *)
-Check @foo. (* foo@{Top.5 Top.6 Top.7
-Top.8}
-     : Type@{Top.8+1}
-(* Top.5
-   Top.6
-   Top.7
-   Top.8 |=  *) *)
+(* foo@{Top.2 Top.3 Top.5 Top.6 Top.8 Top.9 Top.10} =
+let a := Type@{Top.2} in let b := Type@{Top.5} in let c := Type@{Top.8} in Type@{Top.10}
+     : Type@{Top.10+1}
+(* Top.2 Top.3 Top.5 Top.6 Top.8 Top.9 Top.10 |= Top.2 < Top.3
+                                                 Top.5 < Top.6
+                                                 Top.8 < Top.9
+                                                  *)
+ *)
+Check @foo. (* foo@{Top.11 Top.12 Top.13 Top.14 Top.15 Top.16
+Top.17}
+     : Type@{Top.17+1}
+(* Top.11 Top.12 Top.13 Top.14 Top.15 Top.16 Top.17 |= Top.11 < Top.12
+                                                       Top.13 < Top.14
+                                                       Top.15 < Top.16
+                                                        *)
+ *)
 Definition bar := ltac:(let t := eval compute in foo in exact t).
-Check @bar. (* bar@{Top.13 Top.14 Top.15
-Top.16}
-     : Type@{Top.16+1}
-(* Top.13
-   Top.14
-   Top.15
-   Top.16 |=  *) *)
-(* The following should fail, since [bar] should only need one universe. *)
-Check @bar@{i j}.
+Check @bar. (* bar@{Top.27}
+     : Type@{Top.27+1}
+(* Top.27 |=  *) *)
+
+Check @bar@{i}.
 Definition baz (a := Type) (b := Type : a) (c := Type : b) := a -> c.
 Definition qux := Eval compute in baz.
-Check @qux. (* qux@{Top.24 Top.25
-Top.26}
-     : Type@{max(Top.24+1, Top.26+1)}
-(* Top.24
-   Top.25
-   Top.26 |= Top.25 < Top.24
-              Top.26 < Top.25
-               *) *)
-Print qux. (* qux =
-Type@{Top.21} -> Type@{Top.23}
-     : Type@{max(Top.21+1, Top.23+1)}
-(* Top.21
-   Top.22
-   Top.23 |= Top.22 < Top.21
-              Top.23 < Top.22
-               *) *)
+Check @qux. (* qux@{Top.38 Top.39 Top.40
+Top.41}
+     : Type@{max(Top.38+1, Top.41+1)}
+(* Top.38 Top.39 Top.40 Top.41 |= Top.38 < Top.39
+                                  Top.40 < Top.38
+                                  Top.41 < Top.40
+                                   *) *)
+Print qux. (* qux@{Top.34 Top.35 Top.36 Top.37} =
+Type@{Top.34} -> Type@{Top.37}
+     : Type@{max(Top.34+1, Top.37+1)}
+(* Top.34 Top.35 Top.36 Top.37 |= Top.34 < Top.35
+                                  Top.36 < Top.34
+                                  Top.37 < Top.36
+                                   *) *)
 Fail Check @qux@{Set Set}.
 Check @qux@{Type Type Type Type}.
 (* [qux] should only need two universes *)
diff --git a/test-suite/bugs/closed/3698.v b/test-suite/bugs/closed/3698.v
index 31de8ec45..3882eee97 100644
--- a/test-suite/bugs/closed/3698.v
+++ b/test-suite/bugs/closed/3698.v
@@ -23,4 +23,4 @@ Proof.
   assert (H'' : forall g : X = Y -> (issig_hSet^-1 X).1 = (issig_hSet^-1 Y).1,
                   g = g -> IsEquiv g) by admit.
   Eval compute in (@projT1 Type IsHSet (@equiv_inv _ _ _ (equiv_isequiv _ _ issig_hSet) X)).
-  Fail apply H''. (* stack overflow *)
\ No newline at end of file
+  Fail apply H''. (* stack overflow *)
diff --git a/test-suite/bugs/closed/3699.v b/test-suite/bugs/closed/3699.v
index efa432526..dbb10f94f 100644
--- a/test-suite/bugs/closed/3699.v
+++ b/test-suite/bugs/closed/3699.v
@@ -156,4 +156,4 @@ Module Prim.
             | fail 1 "destruct should generate unfolded projections, as should [let], goal:" G ].
     admit.
   Defined.
-End Prim.
\ No newline at end of file
+End Prim.
diff --git a/test-suite/bugs/closed/3700.v b/test-suite/bugs/closed/3700.v
index 4e226524c..bac443e33 100644
--- a/test-suite/bugs/closed/3700.v
+++ b/test-suite/bugs/closed/3700.v
@@ -81,4 +81,4 @@ Goal (forall x : NonPrim.prod Set Set, match x with NonPrim.pair a b => a = a /\
       and (@eq Set (@Prim.fst Set Set x) (@Prim.fst Set Set x))
         (@eq Set (@Prim.snd Set Set x) (@Prim.snd Set Set x))) *)
   Unset Printing All.
-Abort.
\ No newline at end of file
+Abort.
diff --git a/test-suite/bugs/closed/3703.v b/test-suite/bugs/closed/3703.v
index 728250076..feeb04d64 100644
--- a/test-suite/bugs/closed/3703.v
+++ b/test-suite/bugs/closed/3703.v
@@ -29,4 +29,4 @@ Module Keyed.
     rewrite <- H'.
     admit.
   Defined.
-End Keyed.
\ No newline at end of file
+End Keyed.
diff --git a/test-suite/bugs/closed/3732.v b/test-suite/bugs/closed/3732.v
index 76beedf68..09f1149c2 100644
--- a/test-suite/bugs/closed/3732.v
+++ b/test-suite/bugs/closed/3732.v
@@ -102,4 +102,4 @@ cannot be applied to the terms
  "G0" : "list Type"
 The 2nd term has type "Type@{Top.53}" which should be coercible to
  "Type@{Top.12}".
- *)
\ No newline at end of file
+ *)
diff --git a/test-suite/bugs/closed/3735.v b/test-suite/bugs/closed/3735.v
index a50572ace..aced9615e 100644
--- a/test-suite/bugs/closed/3735.v
+++ b/test-suite/bugs/closed/3735.v
@@ -1,4 +1,4 @@
 Require Import Coq.Program.Tactics.
 Class Foo := { bar : Type }.
 Fail Lemma foo : Foo -> bar. (* 'Command has indeed failed.' in both 8.4 and trunk *)
-Fail Program Lemma foo : Foo -> bar. 
\ No newline at end of file
+Fail Program Lemma foo : Foo -> bar. 
diff --git a/test-suite/bugs/closed/3743.v b/test-suite/bugs/closed/3743.v
index c799d4393..ca78987bf 100644
--- a/test-suite/bugs/closed/3743.v
+++ b/test-suite/bugs/closed/3743.v
@@ -8,4 +8,4 @@ Add Parametric Relation A
     transitivity proved by transitivity
       as refine_rel.
 (* Toplevel input, characters 20-118:
-Anomaly: index to an anonymous variable. Please report. *)
\ No newline at end of file
+Anomaly: index to an anonymous variable. Please report. *)
diff --git a/test-suite/bugs/closed/3753.v b/test-suite/bugs/closed/3753.v
index 5bfbee949..f586438cd 100644
--- a/test-suite/bugs/closed/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.
-About bar.
\ No newline at end of file
+About bar.
diff --git a/test-suite/bugs/closed/3782.v b/test-suite/bugs/closed/3782.v
index 2dc50c17d..16b0b8b60 100644
--- a/test-suite/bugs/closed/3782.v
+++ b/test-suite/bugs/closed/3782.v
@@ -61,4 +61,4 @@ The term "e'" has type "@IsEquiv md mc e" while it is expected to have type
                   *)
     admit.
   Defined.
-End Prim.
\ No newline at end of file
+End Prim.
diff --git a/test-suite/bugs/closed/3783.v b/test-suite/bugs/closed/3783.v
index e21712968..f7e2b5435 100644
--- a/test-suite/bugs/closed/3783.v
+++ b/test-suite/bugs/closed/3783.v
@@ -30,4 +30,4 @@ Module Prim.
     Timeout 1 cbv beta in y. (* takes around 2s.  Grows with the value passed to [exp] above *)
     admit.
   Defined.
-End Prim.
\ No newline at end of file
+End Prim.
diff --git a/test-suite/bugs/closed/3807.v b/test-suite/bugs/closed/3807.v
index 108ebf592..a6286f037 100644
--- a/test-suite/bugs/closed/3807.v
+++ b/test-suite/bugs/closed/3807.v
@@ -30,4 +30,4 @@ Axiom f@{i} : Type@{i}.
 (*
 *** [ f@{i} : Type@{i} ]
 (* i |=  *)
-*)
\ No newline at end of file
+*)
diff --git a/test-suite/bugs/closed/3808.v b/test-suite/bugs/closed/3808.v
index a5c84e685..ac6a85019 100644
--- a/test-suite/bugs/closed/3808.v
+++ b/test-suite/bugs/closed/3808.v
@@ -1,3 +1,3 @@
 Unset Strict Universe Declaration.
 Inductive Foo : (let enforce := (fun x => x) : Type@{j} -> Type@{i} in Type@{i})
-  := foo : Foo.
\ No newline at end of file
+  := foo : Foo.
diff --git a/test-suite/bugs/closed/3819.v b/test-suite/bugs/closed/3819.v
index 355d23a58..0b9c3183c 100644
--- a/test-suite/bugs/closed/3819.v
+++ b/test-suite/bugs/closed/3819.v
@@ -6,4 +6,4 @@ Lemma test1 (X:Type) : eq (op OpType X)  X.
 Proof eq_refl.
 
 Definition test2 (A:Type) : eq (op _ A)  A.
-Proof eq_refl.
\ No newline at end of file
+Proof eq_refl.
diff --git a/test-suite/bugs/closed/3881.v b/test-suite/bugs/closed/3881.v
index bb6af6a66..7c60ddf34 100644
--- a/test-suite/bugs/closed/3881.v
+++ b/test-suite/bugs/closed/3881.v
@@ -32,4 +32,4 @@ Proof.
   apply (@isequiv_homotopic _ _ ((g o f) o f^-1) g _
                            (fun b => ap g (eisretr f b))).
 Qed.
-  
\ No newline at end of file
+  
diff --git a/test-suite/bugs/closed/3886.v b/test-suite/bugs/closed/3886.v
index 2ac4abe54..b523b117e 100644
--- a/test-suite/bugs/closed/3886.v
+++ b/test-suite/bugs/closed/3886.v
@@ -20,4 +20,4 @@ Obligation 1 of doubleO.
 apply cheat.
 Qed.
 
-Check doubleE.
\ No newline at end of file
+Check doubleE.
diff --git a/test-suite/bugs/closed/3899.v b/test-suite/bugs/closed/3899.v
index e83166aae..7754934c0 100644
--- a/test-suite/bugs/closed/3899.v
+++ b/test-suite/bugs/closed/3899.v
@@ -8,4 +8,4 @@ Fail Check fun x y : unit => eq_refl : x = y.
 Record ok : Set := tt' { a : unit }.
 
 Record nonprim : Prop := { undef : unit }.
-Record prim : Prop := { def : True }.
\ No newline at end of file
+Record prim : Prop := { def : True }.
diff --git a/test-suite/bugs/closed/3943.v b/test-suite/bugs/closed/3943.v
index 5e5ba816f..ac9c50369 100644
--- a/test-suite/bugs/closed/3943.v
+++ b/test-suite/bugs/closed/3943.v
@@ -47,4 +47,4 @@ Definition path_isomorphic (i j : Isomorphic s d)
 Admitted.
 
 Definition ap_morphism_inverse_path_isomorphic (i j : Isomorphic s d) p q
-: ap (fun e : Isomorphic s d => e^-1)%morphism (path_isomorphic i j p) = q.
\ No newline at end of file
+: ap (fun e : Isomorphic s d => e^-1)%morphism (path_isomorphic i j p) = q.
diff --git a/test-suite/bugs/closed/3956.v b/test-suite/bugs/closed/3956.v
index 66dee702a..4957cc740 100644
--- a/test-suite/bugs/closed/3956.v
+++ b/test-suite/bugs/closed/3956.v
@@ -140,4 +140,4 @@ Module Comodality_Theory (F : Comodality).
     End cip_FPHM.
   End isequiv_F_prod_cmp_M.
 
-End Comodality_Theory.
\ No newline at end of file
+End Comodality_Theory.
diff --git a/test-suite/bugs/closed/3960.v b/test-suite/bugs/closed/3960.v
index e56dcef74..352731248 100644
--- a/test-suite/bugs/closed/3960.v
+++ b/test-suite/bugs/closed/3960.v
@@ -23,4 +23,4 @@ Class myClassP (A : Type)  :=
 Instance myInstanceP : myClassP nat :=
   {
     barP := fooP
-  }.
\ No newline at end of file
+  }.
diff --git a/test-suite/bugs/closed/3974.v b/test-suite/bugs/closed/3974.v
index b6be15959..3d9e06b61 100644
--- a/test-suite/bugs/closed/3974.v
+++ b/test-suite/bugs/closed/3974.v
@@ -4,4 +4,4 @@ End S.
 Module Type M (X : S).
   Fail Module P (X : S).
   (* Used to say: Anomaly: X already exists. Please report. *)
-  (* Should rather say now: Error: X already exists. *)
\ No newline at end of file
+  (* Should rather say now: Error: X already exists. *)
diff --git a/test-suite/bugs/closed/3975.v b/test-suite/bugs/closed/3975.v
index 95851c813..c7616b3ab 100644
--- a/test-suite/bugs/closed/3975.v
+++ b/test-suite/bugs/closed/3975.v
@@ -5,4 +5,4 @@ Module M (X:S). End M.
 Module Type P (X : S).
   Print M.
   (* Used to say: Anomaly: X already exists. Please report. *)
-  (* Should rather : print something :-) *)
\ No newline at end of file
+  (* Should rather : print something :-) *)
diff --git a/test-suite/bugs/closed/3998.v b/test-suite/bugs/closed/3998.v
index ced13839d..e17550e90 100644
--- a/test-suite/bugs/closed/3998.v
+++ b/test-suite/bugs/closed/3998.v
@@ -21,4 +21,4 @@ Axiom ex : RecordOf _ I1FieldType.
 
 Definition works := (fun ex' => update ex' C true) (update ex C false).
 Set Typeclasses Debug.
-Definition doesnt := update (update ex C false) C true.
\ No newline at end of file
+Definition doesnt := update (update ex C false) C true.
diff --git a/test-suite/bugs/closed/4031.v b/test-suite/bugs/closed/4031.v
index 2b8641ebb..6c23baffa 100644
--- a/test-suite/bugs/closed/4031.v
+++ b/test-suite/bugs/closed/4031.v
@@ -11,4 +11,4 @@ Proof.
   change mytt with (@something _ mytt) in x.
   subst x. (* Proof works if this line is removed *)
   reflexivity.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/4069.v b/test-suite/bugs/closed/4069.v
index 61527764e..606c6e084 100644
--- a/test-suite/bugs/closed/4069.v
+++ b/test-suite/bugs/closed/4069.v
@@ -101,4 +101,4 @@ Variable T : Type.
 
 Goal @eq Type T T.
 congruence.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/4095.v b/test-suite/bugs/closed/4095.v
index ffd33d381..8d7dfbd49 100644
--- a/test-suite/bugs/closed/4095.v
+++ b/test-suite/bugs/closed/4095.v
@@ -84,4 +84,4 @@ 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
+H : forall x0 : T, catOP (O0 x0) (O1 (tr x0)) |-- O1 x0 *)
diff --git a/test-suite/bugs/closed/4097.v b/test-suite/bugs/closed/4097.v
index 02aa25e09..183b860d1 100644
--- a/test-suite/bugs/closed/4097.v
+++ b/test-suite/bugs/closed/4097.v
@@ -62,4 +62,4 @@ Definition path_path_sigma {A : Type} (P : A -> Type) (u v : sigT P)
            (r : p..1 = q..1)
            (s : transport (fun x => transport P x u.2 = v.2) r p..2 = q..2)
 : p = q
-  := path_path_sigma_uncurried P u v p q (r; s).
\ No newline at end of file
+  := path_path_sigma_uncurried P u v p q (r; s).
diff --git a/test-suite/bugs/closed/4101.v b/test-suite/bugs/closed/4101.v
index a38b05096..75a26a067 100644
--- a/test-suite/bugs/closed/4101.v
+++ b/test-suite/bugs/closed/4101.v
@@ -16,4 +16,4 @@ Lemma sigT_obj_eq
 Proof.
   intros.
   Set Debug Tactic Unification.
-  apply path_forall. 
\ No newline at end of file
+  apply path_forall. 
diff --git a/test-suite/bugs/closed/4120.v b/test-suite/bugs/closed/4120.v
index 00db8f7f3..315dc0d24 100644
--- a/test-suite/bugs/closed/4120.v
+++ b/test-suite/bugs/closed/4120.v
@@ -2,4 +2,4 @@ Definition id {T} (x : T) := x.
 Goal sigT (fun x => id x)%type.
   change (fun x => ?f x) with f.
   exists Type. exact Set.
-Defined. (* Error: Attempt to save a proof with shelved goals (in proof Unnamed_thm) *)
\ No newline at end of file
+Defined. (* Error: Attempt to save a proof with shelved goals (in proof Unnamed_thm) *)
diff --git a/test-suite/bugs/closed/4151.v b/test-suite/bugs/closed/4151.v
index fec64555f..fc0b58cfe 100644
--- a/test-suite/bugs/closed/4151.v
+++ b/test-suite/bugs/closed/4151.v
@@ -400,4 +400,4 @@ Section sound.
     Undo.
     assumption.
     Undo.
-    eassumption. (* no applicable tactic *)
\ No newline at end of file
+    eassumption. (* no applicable tactic *)
diff --git a/test-suite/bugs/closed/4161.v b/test-suite/bugs/closed/4161.v
index aa2b189b6..d2003ab1f 100644
--- a/test-suite/bugs/closed/4161.v
+++ b/test-suite/bugs/closed/4161.v
@@ -24,4 +24,4 @@ Inductive t : Type -> Type :=
 Fixpoint test {A : Type} (x : t A) : t (A + unit) :=
   match x in t A with
   | Just B x => @test B x
-  end.
\ No newline at end of file
+  end.
diff --git a/test-suite/bugs/closed/4203.v b/test-suite/bugs/closed/4203.v
index 076a3c3d6..eb6867a03 100644
--- a/test-suite/bugs/closed/4203.v
+++ b/test-suite/bugs/closed/4203.v
@@ -16,4 +16,4 @@ Definition t' := Eval vm_compute in constant_ok nat_ops nat_ops_ok.
 Definition t'' := Eval native_compute in constant_ok nat_ops nat_ops_ok.
 
 Check (eq_refl t : t = t').
-Check (eq_refl t : t = t'').
\ No newline at end of file
+Check (eq_refl t : t = t'').
diff --git a/test-suite/bugs/closed/4214.v b/test-suite/bugs/closed/4214.v
index d684e8cf4..2e620fce2 100644
--- a/test-suite/bugs/closed/4214.v
+++ b/test-suite/bugs/closed/4214.v
@@ -3,4 +3,4 @@ Goal forall A (a b c : A), b = a -> b = c -> a = c.
 intros.
 subst.
 reflexivity.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/4250.v b/test-suite/bugs/closed/4250.v
index 74cacf559..f5d0d1a52 100644
--- a/test-suite/bugs/closed/4250.v
+++ b/test-suite/bugs/closed/4250.v
@@ -8,4 +8,4 @@ Function f2 {A:Type} {n:nat} {v:Vector.t A n} : nat := n.
 
 (* fails with "The reference A was not found in the current environment." *)
 Function f3 `{n:nat , u:Vector.t A n} := u.
-Check R_f3_complete.
\ No newline at end of file
+Check R_f3_complete.
diff --git a/test-suite/bugs/closed/4251.v b/test-suite/bugs/closed/4251.v
index 66343d667..f112e7b4d 100644
--- a/test-suite/bugs/closed/4251.v
+++ b/test-suite/bugs/closed/4251.v
@@ -14,4 +14,4 @@ Check array Type.
 Check fun A : Type => Ref A.
 
 Definition abs_val (a : Type) :=
-  bind (ref a) (fun r : array Type => array_make tt).
\ No newline at end of file
+  bind (ref a) (fun r : array Type => array_make tt).
diff --git a/test-suite/bugs/closed/4273.v b/test-suite/bugs/closed/4273.v
index 591ea4b5b..401e86649 100644
--- a/test-suite/bugs/closed/4273.v
+++ b/test-suite/bugs/closed/4273.v
@@ -6,4 +6,4 @@ Theorem onefiber' (q : total2 (fun y => y = 0)) : True.
 Proof. assert (foo:=pr2 _ q). simpl in foo.
        destruct foo. (* Error: q is used in conclusion. *) exact I. Qed.
 
-Print onefiber'.
\ No newline at end of file
+Print onefiber'.
diff --git a/test-suite/bugs/closed/4276.v b/test-suite/bugs/closed/4276.v
index ba82e6c37..ea9cbb210 100644
--- a/test-suite/bugs/closed/4276.v
+++ b/test-suite/bugs/closed/4276.v
@@ -8,4 +8,4 @@ Definition bad' : True := mybox.(unwrap _ _).
 
 Fail Definition bad : False := unwrap _ _ mybox.
 
-(* Closed under the global context *)
\ No newline at end of file
+(* Closed under the global context *)
diff --git a/test-suite/bugs/closed/4287.v b/test-suite/bugs/closed/4287.v
index 43c9b5129..757b71b2d 100644
--- a/test-suite/bugs/closed/4287.v
+++ b/test-suite/bugs/closed/4287.v
@@ -120,4 +120,4 @@ Definition setle (B : Type@{i}) :=
 Fail Check @setlt@{j Prop}.
 Fail Definition foo := @setle@{j Prop}.
 Check setlt@{Set i}.
-Check setlt@{Set j}.
\ No newline at end of file
+Check setlt@{Set j}.
diff --git a/test-suite/bugs/closed/4293.v b/test-suite/bugs/closed/4293.v
index 3671c931b..21d333fa6 100644
--- a/test-suite/bugs/closed/4293.v
+++ b/test-suite/bugs/closed/4293.v
@@ -4,4 +4,4 @@ End Foo.
 
 Module M : Foo.
 Definition T := let X := Type in Type.
-End M.
\ No newline at end of file
+End M.
diff --git a/test-suite/bugs/closed/4299.v b/test-suite/bugs/closed/4299.v
index 955c3017d..a1daa193a 100644
--- a/test-suite/bugs/closed/4299.v
+++ b/test-suite/bugs/closed/4299.v
@@ -9,4 +9,4 @@ End Foo.
 Module M : Foo with Definition U := Type : Type.
   Definition U := let X := Type in Type.
   Definition eq : Type = U := eq_refl.
-Fail End M.
\ No newline at end of file
+Fail End M.
diff --git a/test-suite/bugs/closed/4306.v b/test-suite/bugs/closed/4306.v
index 4aef5bb95..28f028ad8 100644
--- a/test-suite/bugs/closed/4306.v
+++ b/test-suite/bugs/closed/4306.v
@@ -29,4 +29,4 @@ Function bar (xys : (list nat * list nat)) {measure (fun xys => length (fst xys)
                                 | Eq => x :: foo (xs', ys')
                                 | Gt => y :: foo (xs, ys')
                               end
-  end.
\ No newline at end of file
+  end.
diff --git a/test-suite/bugs/closed/4328.v b/test-suite/bugs/closed/4328.v
index 8e1bb3100..b40b3a483 100644
--- a/test-suite/bugs/closed/4328.v
+++ b/test-suite/bugs/closed/4328.v
@@ -3,4 +3,4 @@ Axiom pi : forall (P : Prop) (p : P), Prop.
 Definition test1 A (x : _) := pi A x.           (* success     *)
 Fail Definition test2 A (x : A) := pi A x.           (* failure ??? *)
 Fail Definition test3 A (x : A) (_ : M A) := pi A x. (* failure     *)
-Fail Definition test4 A (_ : M A) (x : A) := pi A x. (* success ??? *)
\ No newline at end of file
+Fail Definition test4 A (_ : M A) (x : A) := pi A x. (* success ??? *)
diff --git a/test-suite/bugs/closed/4354.v b/test-suite/bugs/closed/4354.v
index e71ddaf71..c55b4cf02 100644
--- a/test-suite/bugs/closed/4354.v
+++ b/test-suite/bugs/closed/4354.v
@@ -8,4 +8,4 @@ Proof.
   auto using closed_increment. Show Universes.
 Qed.
 (* also fails with -nois, so the content of the hint database does not matter
-*)
\ No newline at end of file
+*)
diff --git a/test-suite/bugs/closed/4375.v b/test-suite/bugs/closed/4375.v
index 71e3a7518..468bade1c 100644
--- a/test-suite/bugs/closed/4375.v
+++ b/test-suite/bugs/closed/4375.v
@@ -104,4 +104,4 @@ with cb@{i} (t : Type@{i}) : foo@{i} t :=
 
 Print ca.
 Print cb.
-  
\ No newline at end of file
+  
diff --git a/test-suite/bugs/closed/4390.v b/test-suite/bugs/closed/4390.v
index a96a13700..c069b2d9d 100644
--- a/test-suite/bugs/closed/4390.v
+++ b/test-suite/bugs/closed/4390.v
@@ -8,16 +8,16 @@ Universe i.
 End foo.
 End M.
 
-Check Type@{i}.
+Check Type@{M.i}.
 (* Succeeds *)
 
 Fail Check Type@{j}.
 (* Error: Undeclared universe: j *)
 
-Definition foo@{j} : Type@{i} := Type@{j}.
+Definition foo@{j} : Type@{M.i} := Type@{j}.
 (* ok *)
 End A.
-
+Import A. Import M.
 Set Universe Polymorphism.
 Fail Universes j.
 Monomorphic Universe j.
diff --git a/test-suite/bugs/closed/4416.v b/test-suite/bugs/closed/4416.v
index 3189685ec..62b90b428 100644
--- a/test-suite/bugs/closed/4416.v
+++ b/test-suite/bugs/closed/4416.v
@@ -1,4 +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
+(* Error: Incorrect number of goals (expected 2 tactics). *)
diff --git a/test-suite/bugs/closed/4433.v b/test-suite/bugs/closed/4433.v
index 9eeb86468..83c0e3f81 100644
--- a/test-suite/bugs/closed/4433.v
+++ b/test-suite/bugs/closed/4433.v
@@ -26,4 +26,4 @@ Proof.
   case proof_admitted.
   Unshelve.
   all:constructor.
-Defined.
\ No newline at end of file
+Defined.
diff --git a/test-suite/bugs/closed/4443.v b/test-suite/bugs/closed/4443.v
index 66dfa0e68..a3a8717d9 100644
--- a/test-suite/bugs/closed/4443.v
+++ b/test-suite/bugs/closed/4443.v
@@ -28,4 +28,4 @@ Defined.
 Set Printing Universes.
 Check PROD@{i i i}.
 Check PRODinj@{i j}.
-Fail Check PRODinj@{j i}.
\ No newline at end of file
+Fail Check PRODinj@{j i}.
diff --git a/test-suite/bugs/closed/4450.v b/test-suite/bugs/closed/4450.v
index ecebaba81..c1fe44315 100644
--- a/test-suite/bugs/closed/4450.v
+++ b/test-suite/bugs/closed/4450.v
@@ -55,4 +55,4 @@ Proof.
   eauto using foo. Show Universes.
   Undo.
   eauto using foop. Show Proof. Show Universes.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/4480.v b/test-suite/bugs/closed/4480.v
index 08a86330f..98c05ee1a 100644
--- a/test-suite/bugs/closed/4480.v
+++ b/test-suite/bugs/closed/4480.v
@@ -9,4 +9,4 @@ Admitted.
 Goal True.
   Fail setoid_rewrite foo.
   Fail setoid_rewrite trueI.
-  
\ No newline at end of file
+  
diff --git a/test-suite/bugs/closed/4498.v b/test-suite/bugs/closed/4498.v
index ccdb2dddd..379e46b3e 100644
--- a/test-suite/bugs/closed/4498.v
+++ b/test-suite/bugs/closed/4498.v
@@ -21,4 +21,4 @@ Require Export Coq.Setoids.Setoid.
 
 Add Parametric Morphism `{C : Category} {A B C} : (@compose _ A B C) with
   signature equiv ==> equiv ==> equiv as compose_mor.
-Proof. apply comp_respects. Qed.
\ No newline at end of file
+Proof. apply comp_respects. Qed.
diff --git a/test-suite/bugs/closed/4503.v b/test-suite/bugs/closed/4503.v
index f54d6433d..5162f352d 100644
--- a/test-suite/bugs/closed/4503.v
+++ b/test-suite/bugs/closed/4503.v
@@ -34,4 +34,4 @@ Section Embed_ILogic_Pre.
   Polymorphic Universes A T.
   Fail Context {A : Type@{A}} {ILA: ILogic.ILogic@{A} A}.
 
-End Embed_ILogic_Pre.
\ No newline at end of file
+End Embed_ILogic_Pre.
diff --git a/test-suite/bugs/closed/4519.v b/test-suite/bugs/closed/4519.v
index ccbc47d20..945183fae 100644
--- a/test-suite/bugs/closed/4519.v
+++ b/test-suite/bugs/closed/4519.v
@@ -18,4 +18,4 @@ Check qux nat nat nat : Set.
 Check qux nat nat Set : Set. (* Error:
 The term "qux@{Top.50 Top.51} ?T ?T0 Set" has type "Type@{Top.50}" while it is 
 expected to have type "Set"
-(universe inconsistency: Cannot enforce Top.50 = Set because Set < Top.50). *)
\ No newline at end of file
+(universe inconsistency: Cannot enforce Top.50 = Set because Set < Top.50). *)
diff --git a/test-suite/bugs/closed/4603.v b/test-suite/bugs/closed/4603.v
index e7567623a..2c90044dc 100644
--- a/test-suite/bugs/closed/4603.v
+++ b/test-suite/bugs/closed/4603.v
@@ -7,4 +7,4 @@ Abort.
 Goal True.
 Definition foo (A : Type) : Prop:= True. 
   set (x:=foo). split.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/4627.v b/test-suite/bugs/closed/4627.v
index e1206bb37..4f56e1958 100644
--- a/test-suite/bugs/closed/4627.v
+++ b/test-suite/bugs/closed/4627.v
@@ -46,4 +46,4 @@ The term "predicate nat (Build_sa nat)" has type
 while it is expected to have type "Type@{Top.208}"
 (universe inconsistency: Cannot enforce Top.205 <=
 Top.208 because Top.208 < Top.205).
-*)
\ No newline at end of file
+*)
diff --git a/test-suite/bugs/closed/4679.v b/test-suite/bugs/closed/4679.v
index c94fa31a9..3f41c5d6b 100644
--- a/test-suite/bugs/closed/4679.v
+++ b/test-suite/bugs/closed/4679.v
@@ -15,4 +15,4 @@ Proof.
   Undo.
   setoid_rewrite H. (* Error: Tactic failure: setoid rewrite failed: Nothing to rewrite. *)
   reflexivity.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/4717.v b/test-suite/bugs/closed/4717.v
new file mode 100644
index 000000000..1507fa4bf
--- /dev/null
+++ b/test-suite/bugs/closed/4717.v
@@ -0,0 +1,37 @@
+(* Omega being smarter on recognizing nat and Z *)
+
+Require Import Omega.
+
+Definition nat' := nat.
+
+Theorem le_not_eq_lt : forall (n m:nat),
+    n <= m ->
+    n <> m :> nat' ->
+    n < m.
+Proof.
+  intros.
+  omega.
+Qed.
+
+Goal forall (x n : nat'), x = x + n - n.
+Proof.
+  intros.
+  omega.
+Qed.
+
+Require Import ZArith ROmega.
+
+Open Scope Z_scope.
+
+Definition Z' := Z.
+
+Theorem Zle_not_eq_lt : forall n m,
+    n <= m ->
+    n <> m :> Z' ->
+    n < m.
+Proof.
+  intros.
+  omega.
+  Undo.
+  romega.
+Qed.
diff --git a/test-suite/bugs/closed/4723.v b/test-suite/bugs/closed/4723.v
index 888481210..5fb9696f3 100644
--- a/test-suite/bugs/closed/4723.v
+++ b/test-suite/bugs/closed/4723.v
@@ -25,4 +25,4 @@ Program Fact kp_assoc
         (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
+Admitted.
diff --git a/test-suite/bugs/closed/4754.v b/test-suite/bugs/closed/4754.v
index 5bb3cd1be..67d645a68 100644
--- a/test-suite/bugs/closed/4754.v
+++ b/test-suite/bugs/closed/4754.v
@@ -32,4 +32,4 @@ Proof.
   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
+  setoid_rewrite (FG _ eq_refl). (* Error: Tactic failure: setoid rewrite failed: Nothing to rewrite. in 8.5 *) Admitted.
diff --git a/test-suite/bugs/closed/4763.v b/test-suite/bugs/closed/4763.v
index ae8ed0e6e..9613b5c24 100644
--- a/test-suite/bugs/closed/4763.v
+++ b/test-suite/bugs/closed/4763.v
@@ -10,4 +10,4 @@ Goal forall x y z, leb x y -> leb y z -> True.
     => pose proof (transitivity H H' : is_true (R x z))
   end.
   exact I.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/4769.v b/test-suite/bugs/closed/4769.v
index 33a1d1a50..f0c91f7b4 100644
--- a/test-suite/bugs/closed/4769.v
+++ b/test-suite/bugs/closed/4769.v
@@ -91,4 +91,4 @@ Section Adjunction.
                              (oppositeC C) D C
                              (identityF (oppositeC C)) G))
     }.
-End Adjunction.
\ No newline at end of file
+End Adjunction.
diff --git a/test-suite/bugs/closed/4852.v b/test-suite/bugs/closed/4852.v
new file mode 100644
index 000000000..5068ed9b9
--- /dev/null
+++ b/test-suite/bugs/closed/4852.v
@@ -0,0 +1,54 @@
+(** BZ 4852 : unsatisfactory Extraction Implicit for a fixpoint defined via wf *)
+
+Require Import Coq.Lists.List.
+Import ListNotations.
+Require Import Omega.
+
+Definition wfi_lt := well_founded_induction_type Wf_nat.lt_wf.
+
+Tactic Notation "wfinduction" constr(term) "on" ne_hyp_list(Hs) "as" ident(H) :=
+  let R := fresh in
+  let E := fresh in
+  remember term as R eqn:E;
+  revert E; revert Hs;
+  induction R as [R H] using wfi_lt;
+  intros; subst R.
+
+Hint Rewrite @app_comm_cons @app_assoc @app_length : app_rws.
+
+Ltac solve_nat := autorewrite with app_rws in *; cbn in *; omega.
+
+Notation "| x |" := (length x) (at level 11, no associativity, format "'|' x '|'").
+
+Definition split_acc (ls : list nat) : forall acc1 acc2,
+    (|acc1| = |acc2| \/ |acc1| = S (|acc2|)) ->
+    { lss : list nat * list nat |
+      let '(ls1, ls2) := lss in |ls1++ls2| = |ls++acc1++acc2| /\ (|ls1| = |ls2| \/ |ls1| = S (|ls2|))}.
+Proof.
+  induction ls as [|a ls IHls]. all:intros acc1 acc2 H.
+  { exists (acc1, acc2). cbn. intuition reflexivity. }
+  destruct (IHls (a::acc2) acc1) as [[ls1 ls2] (H1 & H2)]. 1:solve_nat.
+  exists (ls1, ls2). cbn. intuition solve_nat.
+Defined.
+
+Definition join(ls : list nat) : { rls : list nat | |rls| = |ls| }.
+Proof.
+  wfinduction (|ls|) on ls as IH.
+  case (split_acc ls [] []). 1:solve_nat.
+  intros (ls1 & ls2) (H1 & H2).
+  destruct ls2 as [|a ls2].
+  - exists ls1. solve_nat.
+  - unshelve eelim (IH _ _ ls1 eq_refl). 1:solve_nat. intros rls1 H3.
+    unshelve eelim (IH _ _ ls2 eq_refl). 1:solve_nat. intros rls2 H4.
+    exists (a :: rls1 ++ rls2). solve_nat.
+Defined.
+
+Require Import ExtrOcamlNatInt.
+Extract Inlined Constant length => "List.length".
+Extract Inlined Constant app => "List.append".
+
+Extraction Inline wfi_lt.
+Extraction Implicit wfi_lt [1 3].
+Recursive Extraction join. (* was: Error: An implicit occurs after extraction *)
+Extraction TestCompile join.
+
diff --git a/test-suite/bugs/closed/4869.v b/test-suite/bugs/closed/4869.v
index 6d21b66fe..ac5d7ea28 100644
--- a/test-suite/bugs/closed/4869.v
+++ b/test-suite/bugs/closed/4869.v
@@ -15,4 +15,4 @@ Section Foo.
   Constraint Set < j.
 
   Definition foo := Type@{j}.
-End Foo.
\ No newline at end of file
+End Foo.
diff --git a/test-suite/bugs/closed/4873.v b/test-suite/bugs/closed/4873.v
index f2f917b4e..3be36d847 100644
--- a/test-suite/bugs/closed/4873.v
+++ b/test-suite/bugs/closed/4873.v
@@ -69,4 +69,4 @@ 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
+Qed.
diff --git a/test-suite/bugs/closed/4877.v b/test-suite/bugs/closed/4877.v
index 7e3c78dc2..7d153d982 100644
--- a/test-suite/bugs/closed/4877.v
+++ b/test-suite/bugs/closed/4877.v
@@ -9,4 +9,4 @@ Ltac induction_last :=
 Goal forall n m : nat, True -> n = m -> m = n.
   induction_last.
   reflexivity.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/5036.v b/test-suite/bugs/closed/5036.v
index 12c958be6..83f167745 100644
--- a/test-suite/bugs/closed/5036.v
+++ b/test-suite/bugs/closed/5036.v
@@ -7,4 +7,4 @@ Section foo.
     autorewrite with core.
     constructor.
   Qed.
-End foo. (* Anomaly: Universe Top.16 undefined. Please report. *)
\ No newline at end of file
+End foo. (* Anomaly: Universe Top.16 undefined. Please report. *)
diff --git a/test-suite/bugs/closed/5065.v b/test-suite/bugs/closed/5065.v
index 6bd677ba6..932fee8b3 100644
--- a/test-suite/bugs/closed/5065.v
+++ b/test-suite/bugs/closed/5065.v
@@ -3,4 +3,4 @@ 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
+Qed.
diff --git a/test-suite/bugs/closed/5123.v b/test-suite/bugs/closed/5123.v
index bcde510ee..17231bffc 100644
--- a/test-suite/bugs/closed/5123.v
+++ b/test-suite/bugs/closed/5123.v
@@ -30,4 +30,4 @@ Goal True.
   all:cycle 3.
   eapply existT. (*This does no typeclass resultion, which is correct.*)
   Focus 5.
-Abort.
\ No newline at end of file
+Abort.
diff --git a/test-suite/bugs/closed/5180.v b/test-suite/bugs/closed/5180.v
index 261092ee6..05603a048 100644
--- a/test-suite/bugs/closed/5180.v
+++ b/test-suite/bugs/closed/5180.v
@@ -61,4 +61,4 @@ 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
+  all:exact x.
diff --git a/test-suite/bugs/closed/5203.v b/test-suite/bugs/closed/5203.v
index ed137395f..3428e1a45 100644
--- a/test-suite/bugs/closed/5203.v
+++ b/test-suite/bugs/closed/5203.v
@@ -2,4 +2,4 @@ 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/5215.v b/test-suite/bugs/closed/5215.v
new file mode 100644
index 000000000..ecf529159
--- /dev/null
+++ b/test-suite/bugs/closed/5215.v
@@ -0,0 +1,286 @@
+Require Import Coq.Logic.FunctionalExtensionality.
+Require Import Coq.Program.Tactics.
+
+Global Set Primitive Projections.
+
+Global Set Universe Polymorphism.
+
+Global Unset Universe Minimization ToSet.
+
+Class Category : Type :=
+{
+  Obj : Type;
+  Hom : Obj -> Obj -> Type;
+  compose : forall {a b c : Obj}, (Hom a b) -> (Hom b c) -> (Hom a c);
+  id : forall {a : Obj}, Hom a a;
+}.
+
+Arguments Obj {_}, _.
+Arguments id {_ _}, {_} _, _ _.
+Arguments Hom {_} _ _, _ _ _.
+Arguments compose {_} {_ _ _} _ _, _ {_ _ _} _ _, _ _ _ _ _ _.
+
+Coercion Obj : Category >-> Sortclass.
+
+Definition Opposite (C : Category) : Category :=
+{|
+
+  Obj := Obj C;
+  Hom := fun a b => Hom b a;
+  compose :=
+    fun a b c (f : Hom b a) (g : Hom c b) => compose C c b a g f;
+  id := fun c => id C c;
+|}.
+
+Record Functor (C C' : Category) : Type :=
+{
+  FO : C -> C';
+  FA : forall {a b}, Hom a b -> Hom (FO a) (FO b);
+}.
+
+Arguments FO {_ _} _ _.
+Arguments FA {_ _} _ {_ _} _, {_ _} _ _ _ _.
+
+Section Opposite_Functor.
+  Context {C D : Category} (F : Functor C D).
+
+  Program Definition Opposite_Functor : (Functor (Opposite C) (Opposite D)) :=
+    {|
+      FO := FO F;
+      FA := fun _ _ h => FA F h;
+    |}.
+
+End Opposite_Functor.
+
+Section Functor_Compose.
+  Context {C C' C'' : Category} (F : Functor C C') (F' : Functor C' C'').
+
+  Program Definition Functor_compose : Functor C C'' :=
+    {|
+      FO := fun c => FO F' (FO F c);
+      FA := fun c d f => FA F' (FA F f)
+    |}.
+
+End Functor_Compose.
+
+Section Algebras.
+  Context {C : Category} (T : Functor C C).
+  Record Algebra : Type :=
+    {
+      Alg_Carrier : C;
+      Constructors : Hom (FO T Alg_Carrier) Alg_Carrier
+    }.
+
+  Record Algebra_Hom (alg alg' : Algebra) : Type :=
+    {
+      Alg_map : Hom (Alg_Carrier alg) (Alg_Carrier alg');
+
+      Alg_map_com : compose (FA T Alg_map) (Constructors alg')
+                     = compose (Constructors alg) Alg_map
+    }.
+
+  Arguments Alg_map {_ _} _.
+  Arguments Alg_map_com {_ _} _.
+  Program Definition Algebra_Hom_compose
+          {alg alg' alg'' : Algebra}
+          (h : Algebra_Hom alg alg')
+          (h' : Algebra_Hom alg' alg'')
+    : Algebra_Hom alg alg''
+    :=
+      {|
+        Alg_map := compose (Alg_map h) (Alg_map h')
+      |}.
+
+  Next Obligation. Proof. Admitted.
+
+  Lemma Algebra_Hom_eq_simplify (alg alg' : Algebra)
+        (ah ah' : Algebra_Hom alg alg')
+    : (Alg_map ah) = (Alg_map ah') -> ah = ah'.
+  Proof. Admitted.
+
+  Program Definition Algebra_Hom_id (alg : Algebra) : Algebra_Hom alg alg :=
+    {|
+      Alg_map := id
+    |}.
+
+  Next Obligation. Admitted.
+
+  Definition Algebra_Cat : Category :=
+    {|
+      Obj := Algebra;
+      Hom := Algebra_Hom;
+      compose := @Algebra_Hom_compose;
+      id := Algebra_Hom_id;
+    |}.
+
+End Algebras.
+
+Arguments Alg_Carrier {_ _} _.
+Arguments Constructors {_ _} _.
+Arguments Algebra_Hom {_ _} _ _.
+Arguments Alg_map {_ _ _ _} _.
+Arguments Alg_map_com {_ _ _ _} _.
+Arguments Algebra_Hom_id {_ _} _.
+
+Section CoAlgebras.
+  Context {C : Category}.
+
+  Definition CoAlgebra (T : Functor C C) :=
+    @Algebra (Opposite C) (Opposite_Functor T).
+
+  Definition CoAlgebra_Hom {T : Functor C C} :=
+      @Algebra_Hom (Opposite C) (Opposite_Functor T).
+
+  Definition CoAlgebra_Hom_id {T : Functor C C} :=
+    @Algebra_Hom_id  (Opposite C) (Opposite_Functor T).
+
+  Definition CoAlgebra_Cat (T : Functor C C) :=
+    @Algebra_Cat (Opposite C) (Opposite_Functor T).
+
+End CoAlgebras.
+
+Program Definition Type_Cat : Category :=
+{|
+  Obj := Type;
+  Hom := (fun A B => A -> B);
+  compose := fun A B C (g : A -> B) (h : B -> C) => fun (x : A) => h (g x);
+  id := fun A => fun x => x
+|}.
+
+Local Obligation Tactic := idtac.
+
+Program Definition Prod_Cat (C C' : Category) : Category :=
+{|
+  Obj := C * C';
+  Hom :=
+    fun a b =>
+      ((Hom (fst a) (fst b)) * (Hom (snd a) (snd b)))%type;
+  compose :=
+    fun a b c f g =>
+      ((compose (fst f) (fst g)), (compose (snd f)(snd g)));
+  id := fun c => (id, id)
+|}.
+
+Class Terminal (C : Category) : Type :=
+{
+  terminal : C;
+  t_morph : forall (d : Obj), Hom d terminal;
+  t_morph_unique : forall (d : Obj) (f g : (Hom d terminal)), f = g
+}.
+
+Arguments terminal {_} _.
+Arguments t_morph {_} _ _.
+Arguments t_morph_unique {_} _ _ _ _.
+
+Coercion terminal : Terminal >-> Obj.
+
+Definition Initial (C : Category) := Terminal (Opposite C).
+Existing Class Initial.
+
+Record Product {C : Category} (c d : C) : Type :=
+{
+  product : C;
+  Pi_1 : Hom product c;
+  Pi_2 : Hom product d;
+  Prod_morph_ex : forall (p' : Obj) (r1 : Hom p' c) (r2 : Hom p' d), (Hom p' product);
+}.
+
+Arguments Product _ _ _, {_} _ _.
+
+Arguments Pi_1 {_ _ _ _}, {_ _ _} _.
+Arguments Pi_2 {_ _ _ _}, {_ _ _} _.
+Arguments Prod_morph_ex {_ _ _} _ _ _ _.
+
+Coercion product : Product >-> Obj.
+
+Definition Has_Products (C : Category) : Type := forall a b, Product a b.
+
+Existing Class Has_Products.
+
+Program Definition Prod_Func (C : Category) {HP : Has_Products C}
+  : Functor (Prod_Cat C C) C :=
+{|
+  FO := fun x => HP (fst x) (snd x);
+  FA := fun a b f => Prod_morph_ex _ _ (compose Pi_1 (fst f)) (compose  Pi_2 (snd f))
+|}.
+
+Arguments Prod_Func _ _, _ {_}.
+
+Definition Sum (C : Category) := @Product (Opposite C).
+
+Arguments Sum _ _ _, {_} _ _.
+
+Definition Has_Sums (C : Category) : Type :=  forall (a b : C), (Sum a b).
+
+Existing Class Has_Sums.
+
+Program Definition sum_Sum (A B : Type) : (@Sum Type_Cat A B) :=
+{|
+  product := (A + B)%type;
+  Prod_morph_ex :=
+    fun (p' : Type)
+        (r1 : A -> p')
+        (r2 : B -> p')
+        (X : A + B) =>
+      match X return p' with
+      | inl a => r1 a
+      | inr b => r2 b
+      end
+|}.
+Next Obligation. simpl; auto. Defined.
+Next Obligation. simpl; auto. Defined.
+
+Program Instance Type_Cat_Has_Sums : Has_Sums Type_Cat := sum_Sum.
+
+Definition Sum_Func {C : Category} {HS : Has_Sums C} :
+  Functor (Prod_Cat C C) C := Opposite_Functor (Prod_Func (Opposite C) HS).
+
+Arguments Sum_Func _ _, _ {_}.
+
+Program Instance unit_Type_term : Terminal Type_Cat :=
+{
+  terminal := unit;
+  t_morph := fun _ _=> tt
+}.
+
+Next Obligation. Proof. Admitted.
+
+Program Definition term_id : Functor Type_Cat (Prod_Cat Type_Cat Type_Cat) :=
+{|
+  FO := fun a => (@terminal Type_Cat _, a);
+  FA := fun a b f => (@id _ (@terminal Type_Cat _), f)
+|}.
+
+Definition S_nat_func : Functor Type_Cat Type_Cat :=
+  Functor_compose term_id (Sum_Func Type_Cat _).
+
+Definition S_nat_alg_cat := Algebra_Cat S_nat_func.
+
+CoInductive CoNat : Set :=
+  | CoO : CoNat
+  | CoS : CoNat -> CoNat
+.
+
+Definition S_nat_coalg_cat := @CoAlgebra_Cat Type_Cat S_nat_func.
+
+Set Printing Universes.
+Program Definition CoNat_alg_term : Initial S_nat_coalg_cat :=
+{|
+  terminal := _;
+  t_morph := _
+|}.
+
+Next Obligation. Admitted.
+Next Obligation. Admitted.
+
+Axiom Admit : False.
+
+Next Obligation.
+Proof.
+  intros d f g.
+  assert(H1 := (@Alg_map_com _ _ _ _ f)). clear.
+  assert (inl tt = inr tt) by (exfalso; apply Admit).
+  discriminate.
+  all: exfalso; apply Admit.
+  Show Universes.
+Qed.
diff --git a/test-suite/bugs/closed/5215_2.v b/test-suite/bugs/closed/5215_2.v
new file mode 100644
index 000000000..399947f00
--- /dev/null
+++ b/test-suite/bugs/closed/5215_2.v
@@ -0,0 +1,8 @@
+Require Import Coq.Program.Tactics.
+Set Universe Polymorphism.
+Set Printing Universes.
+Definition typ := Type.
+
+Program Definition foo : typ := _ -> _.
+Next Obligation. Admitted.
+Next Obligation. exact typ. Show Proof. Show Universes. Defined.
diff --git a/test-suite/bugs/closed/5245.v b/test-suite/bugs/closed/5245.v
index 77bf169e1..e5bca5b5e 100644
--- a/test-suite/bugs/closed/5245.v
+++ b/test-suite/bugs/closed/5245.v
@@ -15,4 +15,4 @@ Undo.
 progress hnf; intros; exact eq_refl.
 Undo.
 unfold foo_rel. intros x. exact eq_refl.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/bugs/closed/5281.v b/test-suite/bugs/closed/5281.v
new file mode 100644
index 000000000..03bafdc9a
--- /dev/null
+++ b/test-suite/bugs/closed/5281.v
@@ -0,0 +1,6 @@
+Inductive A (T : Prop) := B (_ : T).
+Scheme Equality for A.
+
+Goal forall (T:Prop), (forall x y : T, {x=y}+{x<>y}) -> forall x y : A T, {x=y}+{x<>y}.
+decide equality.
+Qed.
diff --git a/test-suite/bugs/closed/5286.v b/test-suite/bugs/closed/5286.v
new file mode 100644
index 000000000..98d4e5c96
--- /dev/null
+++ b/test-suite/bugs/closed/5286.v
@@ -0,0 +1,9 @@
+Set Primitive Projections.
+
+CoInductive R := mkR { p : unit }.
+
+CoFixpoint foo := mkR tt.
+
+Check (eq_refl tt : p foo = tt).
+Check (eq_refl tt <: p foo = tt).
+Check (eq_refl tt <<: p foo = tt).
diff --git a/test-suite/bugs/closed/5315.v b/test-suite/bugs/closed/5315.v
index f1f1b8c05..d8824bff8 100644
--- a/test-suite/bugs/closed/5315.v
+++ b/test-suite/bugs/closed/5315.v
@@ -7,4 +7,4 @@ Function dumb_nope (a:nat) {struct a} :=
   match (id (fun x => x)) a with O => O | S n' => dumb_nope n' end.
 
 (* This check is just present to ensure Function worked well *)
-Check R_dumb_nope_complete. 
\ No newline at end of file
+Check R_dumb_nope_complete. 
diff --git a/test-suite/bugs/closed/5347.v b/test-suite/bugs/closed/5347.v
new file mode 100644
index 000000000..9267b3eb6
--- /dev/null
+++ b/test-suite/bugs/closed/5347.v
@@ -0,0 +1,10 @@
+Set Universe Polymorphism.
+
+Axiom X : Type.
+(* Used to declare [x0@{u1 u2} : X@{u1}] and [x1@{} : X@{u2}] leaving
+   the type of x1 with undeclared universes. After PR #891 this should
+   error at declaration time. *)
+Axiom x₀ x� : X.
+Axiom Xáµ¢ : X -> Type.
+
+Check Xᵢ x�. (* conversion test raised anomaly universe undefined *)
diff --git a/test-suite/bugs/closed/5368.v b/test-suite/bugs/closed/5368.v
new file mode 100644
index 000000000..410fe1707
--- /dev/null
+++ b/test-suite/bugs/closed/5368.v
@@ -0,0 +1,6 @@
+Set Universe Polymorphism.
+
+Record cantype := {T:Type; op:T -> unit}.
+Canonical Structure test (P:Type) := {| T := P -> Type; op := fun _ => tt|}.
+
+Check (op _ ((fun (_:unit) => Set):_)).
diff --git a/test-suite/bugs/closed/5401.v b/test-suite/bugs/closed/5401.v
new file mode 100644
index 000000000..95193b993
--- /dev/null
+++ b/test-suite/bugs/closed/5401.v
@@ -0,0 +1,21 @@
+(* Testing printing of bound unnamed variables in pattern printer *)
+
+Module A.
+Parameter P : nat -> Type.
+Parameter v : forall m, P m.
+Parameter f : forall (P : nat -> Type), (forall a, P a) -> P 0.
+Class U (R : P 0) (m : forall x, P x) : Prop.
+Instance w : U (f _ (fun _ => v _)) v.
+Print HintDb typeclass_instances.
+End A.
+
+(* #5731 *)
+
+Module B.
+Axiom rel : Type -> Prop.
+Axiom arrow_rel : forall {A1}, A1 -> rel A1.
+Axiom forall_rel : forall E, (forall v1 : Type, E v1 -> rel v1) -> Prop.
+Axiom inl_rel: forall_rel _ (fun _ => arrow_rel).
+Hint Resolve inl_rel : foo.
+Print HintDb foo.
+End B.
diff --git a/test-suite/bugs/closed/5434.v b/test-suite/bugs/closed/5434.v
new file mode 100644
index 000000000..5d2460fac
--- /dev/null
+++ b/test-suite/bugs/closed/5434.v
@@ -0,0 +1,18 @@
+(* About binders which remain unnamed after typing *)
+
+Global Set Asymmetric Patterns.
+
+Definition proj2_sig_map {A} {P Q : A -> Prop} (f : forall a, P a -> Q a) (x :
+@sig A P) : @sig A Q
+  := let 'exist a p := x in exist Q a (f a p).
+Axioms (feBW' : Type) (g : Prop -> Prop) (f' : feBW' -> Prop).
+Definition foo := @proj2_sig_map feBW' (fun  H  => True = f' _) (fun H =>
+ g True = g (f' H))
+                                 (fun (a : feBW') (p : (fun H : feBW' => True =
+ f' H) a) => @f_equal Prop Prop g True (f' a) p).
+Print foo.
+Goal True.
+  lazymatch type of foo with
+  | sig (fun a : ?A => ?P) -> _
+    => pose (fun a : A => a = a /\ P = P)
+  end.
diff --git a/test-suite/bugs/closed/5532.v b/test-suite/bugs/closed/5532.v
new file mode 100644
index 000000000..ee5446e54
--- /dev/null
+++ b/test-suite/bugs/closed/5532.v
@@ -0,0 +1,15 @@
+(* A wish granted by the new support for patterns in notations *)
+
+Local Notation mkmatch0 e p
+  := match e with
+     | p => true
+     | _ => false
+     end.
+Local Notation "'mkmatch' [[ e ]] [[ p ]]"
+  := match e with
+     | p => true
+     | _ => false
+     end
+       (at level 0, p pattern).
+Check mkmatch0 _ ((0, 0)%core).
+Check mkmatch [[ _ ]] [[ ((0, 0)%core) ]].
diff --git a/test-suite/bugs/closed/5578.v b/test-suite/bugs/closed/5578.v
index 5bcdaa2f1..b9f0bc45c 100644
--- a/test-suite/bugs/closed/5578.v
+++ b/test-suite/bugs/closed/5578.v
@@ -54,4 +54,4 @@ Goal forall (Rat : Set) (PositiveMap_t : Set -> Set)
                      f eta (
                          (Bind (k eta) (fun rands =>
                           ret_bool (interp_term_fixed_t_x eta (adv' eta) rands  ?= interp_term_fixed_t_x eta (adv' eta) rands)))))).
- (* Error: Anomaly "Signature and its instance do not match." Please report at http://coq.inria.fr/bugs/. *)
\ No newline at end of file
+ (* Error: Anomaly "Signature and its instance do not match." Please report at http://coq.inria.fr/bugs/. *)
diff --git a/test-suite/bugs/closed/5618.v b/test-suite/bugs/closed/5618.v
index ab88a88f4..47e0e92d2 100644
--- a/test-suite/bugs/closed/5618.v
+++ b/test-suite/bugs/closed/5618.v
@@ -6,4 +6,4 @@ Function test {T} (v : T) (x : nat) : nat :=
   | S x' => test v x'
   end.
 
-Check R_test_complete.
\ No newline at end of file
+Check R_test_complete.
diff --git a/test-suite/bugs/closed/5666.v b/test-suite/bugs/closed/5666.v
new file mode 100644
index 000000000..d55a6e57b
--- /dev/null
+++ b/test-suite/bugs/closed/5666.v
@@ -0,0 +1,4 @@
+Inductive foo := Foo : False -> foo.
+Goal foo.
+try (constructor ; fail 0).
+Fail try (constructor ; fail 1).
diff --git a/test-suite/bugs/closed/5692.v b/test-suite/bugs/closed/5692.v
new file mode 100644
index 000000000..4c8d464f1
--- /dev/null
+++ b/test-suite/bugs/closed/5692.v
@@ -0,0 +1,88 @@
+Set Primitive Projections.
+Require Import ZArith ssreflect.
+
+Module Test1.
+
+Structure semigroup := SemiGroup {
+  sg_car :> Type;
+  sg_op : sg_car -> sg_car -> sg_car;
+}.
+
+Structure monoid := Monoid {
+  monoid_car :> Type;
+  monoid_op : monoid_car -> monoid_car -> monoid_car;
+  monoid_unit : monoid_car;
+}.
+
+Coercion monoid_sg (X : monoid) : semigroup :=
+  SemiGroup (monoid_car X) (monoid_op X).
+Canonical Structure monoid_sg.
+
+Parameter X : monoid.
+Parameter x y : X.
+
+Check (sg_op _ x y).
+
+End Test1.
+
+Module Test2.
+
+Structure semigroup := SemiGroup {
+  sg_car :> Type;
+  sg_op : sg_car -> sg_car -> sg_car;
+}.
+
+Structure monoid := Monoid {
+  monoid_car :> Type;
+  monoid_op : monoid_car -> monoid_car -> monoid_car;
+  monoid_unit : monoid_car;
+  monoid_left_id x : monoid_op monoid_unit x = x;
+}.
+
+Coercion monoid_sg (X : monoid) : semigroup :=
+  SemiGroup (monoid_car X) (monoid_op X).
+Canonical Structure monoid_sg.
+
+Canonical Structure nat_sg := SemiGroup nat plus.
+Canonical Structure nat_monoid := Monoid nat plus 0 plus_O_n.
+
+Lemma foo (x : nat) : 0 + x = x.
+Proof.
+apply monoid_left_id.
+Qed.
+
+End Test2.
+
+Module Test3.
+
+Structure semigroup := SemiGroup {
+  sg_car :> Type;
+  sg_op : sg_car -> sg_car -> sg_car;
+}.
+
+Structure group := Something {
+  group_car :> Type;
+  group_op : group_car -> group_car -> group_car;
+  group_neg : group_car -> group_car;
+  group_neg_op' x y : group_neg (group_op x y) = group_op (group_neg x) (group_neg y)
+}.
+
+Coercion group_sg (X : group) : semigroup :=
+  SemiGroup (group_car X) (group_op X).
+Canonical Structure group_sg.
+
+Axiom group_neg_op : forall (X : group) (x y : X),
+  group_neg X (sg_op (group_sg X) x y) = sg_op (group_sg X) (group_neg X x) (group_neg X y).
+
+Canonical Structure Z_sg := SemiGroup Z Z.add .
+Canonical Structure Z_group := Something Z Z.add Z.opp Z.opp_add_distr.
+
+Lemma foo (x y : Z) :
+  sg_op Z_sg (group_neg Z_group x) (group_neg Z_group y) =
+  group_neg Z_group (sg_op Z_sg x y).
+Proof.
+  rewrite -group_neg_op.
+  reflexivity.
+Qed.
+
+End Test3.
diff --git a/test-suite/bugs/closed/5707.v b/test-suite/bugs/closed/5707.v
new file mode 100644
index 000000000..785844c66
--- /dev/null
+++ b/test-suite/bugs/closed/5707.v
@@ -0,0 +1,12 @@
+(* Destruct and primitive projections *)
+
+(* Checking the (superficial) part of #5707:
+   "destruct" should be able to use non-dependent case analysis when
+   dependent case analysis is not available and unneeded *)
+
+Set Primitive Projections.
+
+Inductive foo := Foo { proj1 : nat; proj2 : nat }.
+
+Goal forall x : foo, True.
+Proof. intros x. destruct x.
diff --git a/test-suite/bugs/closed/5713.v b/test-suite/bugs/closed/5713.v
new file mode 100644
index 000000000..9daf9647f
--- /dev/null
+++ b/test-suite/bugs/closed/5713.v
@@ -0,0 +1,15 @@
+(* Checking that classical_right/classical_left work in an empty context *)
+
+Require Import Classical.
+
+Parameter A:Prop.
+
+Goal A \/ ~A.
+classical_right.
+assumption.
+Qed.
+
+Goal ~A \/ A.
+classical_left.
+assumption.
+Qed.
diff --git a/test-suite/bugs/closed/5717.v b/test-suite/bugs/closed/5717.v
new file mode 100644
index 000000000..1bfd917d2
--- /dev/null
+++ b/test-suite/bugs/closed/5717.v
@@ -0,0 +1,5 @@
+Definition foo@{i} (A : Type@{i}) (l : list A) :=
+  match l with
+  | nil => nil
+  | cons _ t => t
+  end.
diff --git a/test-suite/bugs/closed/5726.v b/test-suite/bugs/closed/5726.v
new file mode 100644
index 000000000..53ef47357
--- /dev/null
+++ b/test-suite/bugs/closed/5726.v
@@ -0,0 +1,34 @@
+Set Universe Polymorphism.
+Set Printing Universes.
+
+Module GlobalReference.
+
+  Definition type' := Type.
+  Notation type := type'.
+  Check type@{Set}.
+
+End GlobalReference.
+
+Module TypeLiteral.
+
+  Notation type := Type.
+  Check type@{Set}.
+  Check type@{Prop}.
+
+End TypeLiteral.
+
+Module ExplicitSort.
+  Monomorphic Universe u.
+  Notation foo := Type@{u}.
+  Fail Check foo@{Set}.
+  Fail Check foo@{u}.
+
+  Notation bar := Type.
+  Check bar@{u}.
+End ExplicitSort.
+
+Module PropNotationUnsupported.
+  Notation foo := Prop.
+  Fail Check foo@{Set}.
+  Fail Check foo@{Type}.
+End PropNotationUnsupported.
diff --git a/test-suite/bugs/closed/5741.v b/test-suite/bugs/closed/5741.v
new file mode 100644
index 000000000..f6598f192
--- /dev/null
+++ b/test-suite/bugs/closed/5741.v
@@ -0,0 +1,4 @@
+(* Check no anomaly in info_trivial *)
+
+Goal True.
+info_trivial.
diff --git a/test-suite/bugs/closed/5749.v b/test-suite/bugs/closed/5749.v
new file mode 100644
index 000000000..81bfe351c
--- /dev/null
+++ b/test-suite/bugs/closed/5749.v
@@ -0,0 +1,18 @@
+(* Checking computation of free vars of a term for generalization *)
+
+Definition Decision := fun P : Prop => {P} + {~ P}.
+Class SetUnfold (P Q : Prop) : Prop := Build_SetUnfold { set_unfold : P <-> Q
+}.
+
+Section Filter_Help.
+
+  Context {A: Type}.
+  Context (fold_right : forall A B : Type, (B -> A -> A) -> A -> list B -> A).
+  Definition lType2 := (sigT (fun (P : A -> Prop) => forall a, Decision (P
+a))).
+  Definition test (X: lType2) := let (x, _) := X in x.
+
+  Global Instance foo `{fhl1 : list lType2} m Q:
+    SetUnfold (Q)
+              (fold_right _ _ (fun (s : lType2) => let (P, _) := s in and (P
+m)) (Q) (fhl1)).
diff --git a/test-suite/bugs/closed/5750.v b/test-suite/bugs/closed/5750.v
new file mode 100644
index 000000000..6d0e21f5d
--- /dev/null
+++ b/test-suite/bugs/closed/5750.v
@@ -0,0 +1,3 @@
+(* Check printability of the hole of the context *)
+Goal 0 = 0.
+match goal with |- context c [0] => idtac c end.
diff --git a/test-suite/bugs/closed/5755.v b/test-suite/bugs/closed/5755.v
new file mode 100644
index 000000000..e07fdcf83
--- /dev/null
+++ b/test-suite/bugs/closed/5755.v
@@ -0,0 +1,16 @@
+(* Sections taking care of let-ins for inductive types *)
+
+Section Foo.
+
+Inductive foo (A : Type) (x : A) (y := x) (y : A) := Foo.
+
+End Foo.
+
+Section Foo2.
+
+Variable B : Type.
+Variable b : B.
+Let c := b.
+Inductive foo2 (A : Type) (x : A) (y := x) (y : A) := Foo2 : c=c -> foo2 A x y.
+
+End Foo2.
diff --git a/test-suite/bugs/closed/5757.v b/test-suite/bugs/closed/5757.v
new file mode 100644
index 000000000..0d0f2eed4
--- /dev/null
+++ b/test-suite/bugs/closed/5757.v
@@ -0,0 +1,76 @@
+(* Check that resolved status of evars follows "restrict" *)
+
+Axiom H : forall (v : nat), Some 0 = Some v -> True.
+Lemma L : True.
+eapply H with _;
+match goal with
+  | |- Some 0 = Some ?v => change (Some (0+0) = Some v)
+end.
+Abort.
+
+(* The original example *)
+
+Set Default Proof Using "Type".
+
+Module heap_lang.
+
+Inductive expr :=
+  | InjR (e : expr).
+
+Inductive val :=
+  | InjRV (v : val).
+
+Bind Scope val_scope with val.
+
+Fixpoint of_val (v : val) : expr :=
+  match v with
+  | InjRV v => InjR (of_val v)
+  end.
+
+Fixpoint to_val (e : expr) : option val := None.
+
+End heap_lang.
+Export heap_lang.
+
+Module W.
+Inductive expr :=
+  | Val (v : val)
+  (* Sums *)
+  | InjR (e : expr).
+
+Fixpoint to_expr (e : expr) : heap_lang.expr :=
+  match e with
+  | Val v => of_val v
+  | InjR e => heap_lang.InjR (to_expr e)
+  end.
+
+End W.
+
+
+
+Section Tests.
+
+  Context (iProp: Type).
+  Context (WPre: expr -> Prop).
+
+  Context (tac_wp_alloc :
+             forall (e : expr) (v : val),
+               to_val e = Some v -> WPre e).
+
+  Lemma push_atomic_spec (x: val) :
+    WPre (InjR (of_val x)).
+  Proof.
+(* This works. *)
+eapply tac_wp_alloc with _.
+match goal with
+  | |- to_val ?e = Some ?v =>
+    change (to_val (W.to_expr (W.InjR (W.Val x))) = Some v)
+end.
+Undo. Undo.
+(* This is fixed *)
+eapply tac_wp_alloc with _;
+match goal with
+  | |- to_val ?e = Some ?v =>
+    change (to_val (W.to_expr (W.InjR (W.Val x))) = Some v)
+end.
+Abort.
diff --git a/test-suite/bugs/closed/5761.v b/test-suite/bugs/closed/5761.v
new file mode 100644
index 000000000..6f28d1981
--- /dev/null
+++ b/test-suite/bugs/closed/5761.v
@@ -0,0 +1,126 @@
+Set Primitive Projections.
+Record mix := { a : nat ; b : a = a ; c : nat ; d : a = c ; e : nat ; f : nat }.
+Ltac strip_args T ctor :=
+  lazymatch type of ctor with
+  | context[T]
+    => match eval cbv beta in ctor with
+       | ?ctor _ => strip_args T ctor
+       | _ => ctor
+       end
+  end.
+Ltac get_ctor T :=
+  let full_ctor := constr:(ltac:(let x := fresh in intro x; econstructor; apply
+x) : T -> T) in
+  let ctor := constr:(fun x : T => ltac:(let v := strip_args T (full_ctor x) in
+exact v)) in
+  lazymatch ctor with
+  | fun _ => ?ctor => ctor
+  end.
+Ltac uncurry_domain f :=
+  lazymatch type of f with
+  | forall (a : ?A) (b : @ ?B a), _
+    => uncurry_domain (fun ab : { a : A & B a } => f (projT1 ab) (projT2 ab))
+  | _ => eval cbv beta in f
+  end.
+Ltac get_of_sigma T :=
+  let ctor := get_ctor T in
+  uncurry_domain ctor.
+Ltac repeat_existT :=
+  lazymatch goal with
+  | [ |- sigT _ ] => simple refine (existT _ _ _); [ repeat_existT | shelve ]
+  | _ => shelve
+  end.
+ Ltac prove_to_of_sigma_goal of_sigma :=
+  let v := fresh "v" in
+  simple refine (exist _ _ (fun v => _ : id _ (of_sigma v) = v));
+  try unfold of_sigma;
+  [ intro v; destruct v; repeat_existT
+  | cbv beta;
+    repeat match goal with
+           | [ |- context[projT2 ?k] ]
+             => let x := fresh "x" in
+                is_var k;
+                destruct k as [k x]; cbn [projT1 projT2]
+           end;
+    unfold id; reflexivity ].
+Ltac prove_to_of_sigma of_sigma :=
+  constr:(
+    ltac:(prove_to_of_sigma_goal of_sigma)
+    : { to_sigma : _ | forall v, id to_sigma (of_sigma v) = v }).
+Ltac get_to_sigma_gen of_sigma :=
+  let v := prove_to_of_sigma of_sigma in
+  eval hnf in (proj1_sig v).
+Ltac get_to_sigma T :=
+  let of_sigma := get_of_sigma T in
+  get_to_sigma_gen of_sigma.
+Definition to_sigma := ltac:(let v := get_to_sigma mix in exact v).
+(* Error:
+In nested Ltac calls to "get_to_sigma", "get_to_sigma_gen",
+"prove_to_of_sigma",
+"(_ : {to_sigma : _ | forall v, id to_sigma (of_sigma v) = v})" (with
+of_sigma:=fun
+            ab : {_
+                 : {_
+                   : {ab : {_ : {a : nat & a = a} & nat} &
+                     projT1 (projT1 ab) = projT2 ab} & nat} & nat} =>
+          {|
+          a := projT1 (projT1 (projT1 (projT1 (projT1 ab))));
+          b := projT2 (projT1 (projT1 (projT1 (projT1 ab))));
+          c := projT2 (projT1 (projT1 (projT1 ab)));
+          d := projT2 (projT1 (projT1 ab));
+          e := projT2 (projT1 ab);
+          f := projT2 ab |}) and "prove_to_of_sigma_goal", last call failed.
+Anomaly "Uncaught exception Not_found." Please report at
+http://coq.inria.fr/bugs/.
+frame @  file "toplevel/coqtop.ml", line 640, characters 6-22
+frame @  file "list.ml", line 73, characters 12-15
+frame @  file "toplevel/vernac.ml", line 344, characters 2-13
+frame @  file "toplevel/vernac.ml", line 308, characters 14-75
+raise @  file "lib/exninfo.ml", line 63, characters 8-15
+frame @  file "lib/flags.ml", line 141, characters 19-40
+raise @  file "lib/exninfo.ml", line 63, characters 8-15
+frame @  file "lib/flags.ml", line 11, characters 15-18
+raise @  file "lib/exninfo.ml", line 63, characters 8-15
+frame @  file "toplevel/vernac.ml", line 167, characters 6-16
+frame @  file "toplevel/vernac.ml", line 151, characters 26-39
+frame @  file "stm/stm.ml", line 2365, characters 2-35
+raise @  file "lib/exninfo.ml", line 63, characters 8-15
+frame @  file "stm/stm.ml", line 2355, characters 4-48
+frame @  file "stm/stm.ml", line 2321, characters 4-100
+raise @  file "lib/exninfo.ml", line 63, characters 8-15
+frame @  file "stm/stm.ml", line 832, characters 6-10
+frame @  file "stm/stm.ml", line 2206, characters 10-32
+raise @  file "lib/exninfo.ml", line 63, characters 8-15
+frame @  file "stm/stm.ml", line 975, characters 8-81
+raise @  file "lib/exninfo.ml", line 63, characters 8-15
+frame @  file "vernac/vernacentries.ml", line 2216, characters 10-389
+frame @  file "lib/flags.ml", line 141, characters 19-40
+raise @  file "lib/exninfo.ml", line 63, characters 8-15
+frame @  file "lib/flags.ml", line 11, characters 15-18
+frame @  file "vernac/command.ml", line 150, characters 4-56
+frame @  file "interp/constrintern.ml", line 2046, characters 2-73
+frame @  file "pretyping/pretyping.ml", line 1194, characters 19-77
+frame @  file "pretyping/pretyping.ml", line 1155, characters 8-72
+frame @  file "pretyping/pretyping.ml", line 628, characters 23-65
+frame @  file "plugins/ltac/tacinterp.ml", line 2095, characters 21-61
+frame @  file "proofs/pfedit.ml", line 178, characters 6-22
+raise @  file "lib/exninfo.ml", line 63, characters 8-15
+frame @  file "proofs/pfedit.ml", line 174, characters 8-36
+frame @  file "proofs/proof.ml", line 351, characters 4-30
+raise @  file "lib/exninfo.ml", line 63, characters 8-15
+frame @  file "engine/proofview.ml", line 1222, characters 8-12
+frame @  file "plugins/ltac/tacinterp.ml", line 2020, characters 19-36
+frame @  file "plugins/ltac/tacinterp.ml", line 618, characters 4-70
+raise @  file "lib/exninfo.ml", line 63, characters 8-15
+frame @  file "plugins/ltac/tacinterp.ml", line 214, characters 6-9
+frame @  file "pretyping/pretyping.ml", line 1198, characters 19-62
+frame @  file "pretyping/pretyping.ml", line 1155, characters 8-72
+raise @  unknown
+frame @  file "pretyping/pretyping.ml", line 628, characters 23-65
+frame @  file "plugins/ltac/tacinterp.ml", line 2095, characters 21-61
+frame @  file "proofs/pfedit.ml", line 178, characters 6-22
+raise @  file "lib/exninfo.ml", line 63, characters 8-15
+frame @  file "proofs/pfedit.ml", line 174, characters 8-36
+frame @  file "proofs/proof.ml", line 351, characters 4-30
+raise @  file "lib/exninfo.ml", line 63, characters 8-15
+ *)
diff --git a/test-suite/bugs/closed/5762.v b/test-suite/bugs/closed/5762.v
new file mode 100644
index 000000000..55d36bd72
--- /dev/null
+++ b/test-suite/bugs/closed/5762.v
@@ -0,0 +1,34 @@
+(* Supporting imp. params. in inductive or fixpoints mutually defined with a notation *)
+
+Reserved Notation "* a" (at level 70).
+Inductive P {n : nat} : nat -> Prop :=
+| c m : *m
+where "* m" := (P m).
+
+Reserved Notation "##".
+Inductive I {A:Type} := C : ## where "##" := I.
+
+(* The following was working in 8.6 *)
+
+Require Import Vector.
+
+Reserved Notation "# a" (at level 70).
+Fixpoint f {n : nat} (v:Vector.t nat n) : nat :=
+  match v with
+  | nil _ => 0
+  | cons _ _ _ v => S (#v)
+  end
+where "# v" := (f v).
+
+(* The following was working in 8.6 *)
+
+Reserved Notation "%% a" (at level 70).
+Record R :=
+  {g : forall {A} (a:A), a=a where "%% x" := (g x);
+   k : %% 0 = eq_refl}.
+
+(* An extra example *)
+
+Module A.
+Inductive I {A:Type} := C : # 0 -> I where "# I" := (I = I) : I_scope.
+End A.
diff --git a/test-suite/bugs/closed/5765.v b/test-suite/bugs/closed/5765.v
new file mode 100644
index 000000000..343ab4935
--- /dev/null
+++ b/test-suite/bugs/closed/5765.v
@@ -0,0 +1,3 @@
+(* 'pat binder not (yet?) allowed in parameters of inductive types *)
+
+Fail Inductive X '(a,b) := x.
diff --git a/test-suite/bugs/closed/5769.v b/test-suite/bugs/closed/5769.v
new file mode 100644
index 000000000..42573aad8
--- /dev/null
+++ b/test-suite/bugs/closed/5769.v
@@ -0,0 +1,20 @@
+(* Check a few naming heuristics based on types *)
+(* was buggy for types names _something *)
+
+Inductive _foo :=.
+Lemma bob : (sigT (fun x : nat => _foo)) -> _foo.
+destruct 1.
+exact _f.
+Abort.
+
+Inductive _'Foo :=.
+Lemma bob : (sigT (fun x : nat => _'Foo)) -> _'Foo.
+destruct 1.
+exact _'f.
+Abort.
+
+Inductive ____ :=.
+Lemma bob : (sigT (fun x : nat => ____)) -> ____.
+destruct 1.
+exact x0.
+Abort.
diff --git a/test-suite/bugs/closed/5786.v b/test-suite/bugs/closed/5786.v
new file mode 100644
index 000000000..20301ec4f
--- /dev/null
+++ b/test-suite/bugs/closed/5786.v
@@ -0,0 +1,29 @@
+(* Printing all kinds of Ltac generic arguments *)
+
+Tactic Notation "myidtac" string(v) := idtac v.
+Goal True.
+myidtac "foo".
+Abort.
+
+Tactic Notation "myidtac2" ref(c) := idtac c.
+Goal True.
+myidtac2 True.
+Abort.
+
+Tactic Notation "myidtac3" preident(s) := idtac s.
+Goal True.
+myidtac3 foo.
+Abort.
+
+Tactic Notation "myidtac4" int_or_var(n) := idtac n.
+Goal True.
+myidtac4 3.
+Abort.
+
+Tactic Notation "myidtac5" ident(id) := idtac id.
+Goal True.
+myidtac5 foo.
+Abort.
+
+
+
diff --git a/test-suite/bugs/closed/5790.v b/test-suite/bugs/closed/5790.v
new file mode 100644
index 000000000..6c93a3906
--- /dev/null
+++ b/test-suite/bugs/closed/5790.v
@@ -0,0 +1,7 @@
+Set Universe Polymorphism.
+Section foo.
+Context (v : Type).
+Axiom a : True <-> False.
+
+Hint Resolve -> a.
+End foo.
diff --git a/test-suite/bugs/closed/846.v b/test-suite/bugs/closed/5797.v
index ee5ec1fa6..ee5ec1fa6 100644
--- a/test-suite/bugs/closed/846.v
+++ b/test-suite/bugs/closed/5797.v
diff --git a/test-suite/bugs/closed/931.v b/test-suite/bugs/closed/5845.v
index ea3347a85..ea3347a85 100644
--- a/test-suite/bugs/closed/931.v
+++ b/test-suite/bugs/closed/5845.v
diff --git a/test-suite/bugs/closed/1100.v b/test-suite/bugs/closed/5940.v
index 32c78b4b9..32c78b4b9 100644
--- a/test-suite/bugs/closed/1100.v
+++ b/test-suite/bugs/closed/5940.v
diff --git a/test-suite/bugs/closed/6070.v b/test-suite/bugs/closed/6070.v
new file mode 100644
index 000000000..49b16f625
--- /dev/null
+++ b/test-suite/bugs/closed/6070.v
@@ -0,0 +1,32 @@
+(* A slight shortening of bug 6078 *)
+
+(* This bug exposed a different behavior of unshelve_unifiable
+   depending on which projection is found in the unification
+   heuristics *)
+
+Axiom flat_type : Type.
+Axiom interp_flat_type : flat_type -> Type.
+Inductive type := Arrow (_ _ : flat_type).
+Definition interp_type (t : type)
+  := interp_flat_type (match t with Arrow s d => s end)
+     -> interp_flat_type (match t with Arrow s d => d end).
+Axiom Expr : type -> Type.
+Axiom Interp : forall {t : type}, Expr t -> interp_type t.
+Axiom Wf : forall {t}, Expr t -> Prop.
+Axiom a : forall f, interp_flat_type f.
+
+Definition packaged_expr_functionP A :=
+  (fun F : Expr A -> Expr A
+   => forall e' v, Interp (F e') v = a (let (_,f) := A in f)).
+Goal forall (f f0 : flat_type)
+            (e : forall _ : Expr (@Arrow f f0),
+                Expr (@Arrow f f0)),
+    @packaged_expr_functionP (@Arrow f f0) e.
+  intros.
+  refine (fun (e0 : Expr (Arrow f f0))
+   => (fun zHwf':True =>
+   (fun v : interp_flat_type f =>
+      ?[G] : ?[U] = ?[V] :> interp_flat_type ?[v])) ?[H]);
+   [ | ].
+   (* Was: Error: Tactic failure: Incorrect number of goals (expected 3 tactics). *)
+Abort.
diff --git a/test-suite/bugs/closed/6129.v b/test-suite/bugs/closed/6129.v
new file mode 100644
index 000000000..e4a2a2ba9
--- /dev/null
+++ b/test-suite/bugs/closed/6129.v
@@ -0,0 +1,9 @@
+(* Make definition of coercions compatible with local definitions. *)
+
+Record foo (x : Type) (y:=1) := { foo_nat :> nat }.
+Record foo2 (x : Type) (y:=1) (z t: Type) := { foo_nat2 :> nat }.
+Record foo3 (y:=1) (z t: Type) := { foo_nat3 :> nat }.
+
+Check fun x : foo nat => x + 1.
+Check fun x : foo2 nat nat nat => x + 1.
+Check fun x : foo3 nat nat => x + 1.
diff --git a/test-suite/bugs/closed/6191.v b/test-suite/bugs/closed/6191.v
new file mode 100644
index 000000000..e0d912509
--- /dev/null
+++ b/test-suite/bugs/closed/6191.v
@@ -0,0 +1,16 @@
+(* Check a 8.7.1 regression in ring_simplify *)
+
+Require Import ArithRing BinNat.
+Goal forall f x, (2+x+f (N.to_nat 2)+3=4).
+intros.
+ring_simplify (2+x+f (N.to_nat 2)+3).
+match goal with |- x + f (N.to_nat 2) + 5 = 4 => idtac end.
+Abort.
+
+Require Import ZArithRing BinInt.
+Open Scope Z_scope.
+Goal forall x, (2+x+3=4).
+intros.
+ring_simplify (2+x+3).
+match goal with |- x+5 = 4 => idtac end.
+Abort.
diff --git a/test-suite/bugs/closed/6297.v b/test-suite/bugs/closed/6297.v
new file mode 100644
index 000000000..a28607058
--- /dev/null
+++ b/test-suite/bugs/closed/6297.v
@@ -0,0 +1,8 @@
+Set Printing Universes.
+
+(* Error: Anomaly "Uncaught exception "Anomaly: Incorrect universe Set
+   declared for inductive type, inferred level is max(Prop, Set+1)."."
+   Please report at http://coq.inria.fr/bugs/. *)
+Fail Record LTS: Set :=
+  lts { St: Set;
+        init: St }.
diff --git a/test-suite/bugs/closed/6323.v b/test-suite/bugs/closed/6323.v
new file mode 100644
index 000000000..fdc33befc
--- /dev/null
+++ b/test-suite/bugs/closed/6323.v
@@ -0,0 +1,9 @@
+Goal True.
+  simple refine (let X : Type := _ in _);
+    [ abstract exact Set using Set'
+    | let X' := (eval cbv delta [X] in X) in
+      clear X;
+      simple refine (let id' : { x : X' | True } -> X' := _ in _);
+      [ abstract refine (@proj1_sig _ _) | ]
+    ].
+Abort.
diff --git a/test-suite/bugs/closed/6378.v b/test-suite/bugs/closed/6378.v
new file mode 100644
index 000000000..68ae7961d
--- /dev/null
+++ b/test-suite/bugs/closed/6378.v
@@ -0,0 +1,18 @@
+Require Import Coq.ZArith.ZArith.
+Ltac profile_constr tac :=
+  let dummy := match goal with _ => reset ltac profile; start ltac profiling end in
+  let ret := match goal with _ => tac () end in
+  let dummy := match goal with _ => stop ltac profiling; show ltac profile end in
+  pose 1.
+
+Ltac slow _ := eval vm_compute in (Z.div_eucl, Z.div_eucl, Z.div_eucl, Z.div_eucl, Z.div_eucl).
+
+Goal True.
+  start ltac profiling.
+  reset ltac profile.
+  reset ltac profile.
+  stop ltac profiling.
+  time profile_constr slow.
+  show ltac profile cutoff 0.
+  show ltac profile "slow".
+Abort.
diff --git a/test-suite/bugs/closed/6490.v b/test-suite/bugs/closed/6490.v
new file mode 100644
index 000000000..dcf9ff29e
--- /dev/null
+++ b/test-suite/bugs/closed/6490.v
@@ -0,0 +1,4 @@
+Inductive Foo (A' := I) (B : Type) := foo : Foo B.
+
+Goal Foo True. dtauto. Qed.
+Goal Foo True. firstorder. Qed.
diff --git a/test-suite/bugs/closed/6529.v b/test-suite/bugs/closed/6529.v
new file mode 100644
index 000000000..8d9081999
--- /dev/null
+++ b/test-suite/bugs/closed/6529.v
@@ -0,0 +1,16 @@
+Require Import Vector Program.
+
+Program Definition append_nil_def :=
+  forall A n (ls: t A n), append ls (nil A) = ls. (* Works *)
+
+Lemma append_nil : append_nil_def. (* Works *)
+Proof.
+Admitted.
+
+Program Lemma append_nil' :
+  forall A n (ls: t A n), append ls (nil A) = ls.
+Abort.
+
+Fail Program Lemma append_nil'' :
+  forall A B n (ls: t A n), append ls (nil A) = ls.
+(* Error: Anomaly "Evar ?X25 was not declared." Please report at http://coq.inria.fr/bugs/. *)
diff --git a/test-suite/bugs/closed/6534.v b/test-suite/bugs/closed/6534.v
new file mode 100644
index 000000000..f5013994c
--- /dev/null
+++ b/test-suite/bugs/closed/6534.v
@@ -0,0 +1,7 @@
+Goal forall x : nat, x = x.
+Proof.
+intros x.
+refine ((fun x x => _ tt) tt tt).
+let t := match goal with [ |- ?P ] => P end in
+let _ := type of t in
+idtac.
diff --git a/test-suite/bugs/closed/6617.v b/test-suite/bugs/closed/6617.v
new file mode 100644
index 000000000..9cabd62d4
--- /dev/null
+++ b/test-suite/bugs/closed/6617.v
@@ -0,0 +1,34 @@
+Definition MR {T M : Type} :=
+fun (R : M -> M -> Prop) (m : T -> M) (x y : T) => R (m x) (m y).
+
+Set Primitive Projections.
+
+Record sigma {A : Type} {B : A -> Type} : Type := sigmaI
+  { pr1 : A;  pr2 : B pr1 }.
+
+Axiom F : forall {A : Type} {R : A -> A -> Prop},
+  (forall x, (forall y, R y x -> unit) -> unit) -> forall (x : A), unit.
+
+Definition foo (A : Type) (l : list A) :=
+  let y := {| pr1 := A; pr2 := l |} in
+  let bar := MR lt (fun p : sigma =>
+                 (fix Ffix (x : list (pr1 p)) : nat :=
+                    match x with
+                    | nil => 0
+                    | cons _ x1 => S (Ffix x1)
+                    end) (pr2 p)) in
+fun (_ : bar y y) =>
+F (fun (r : sigma)
+       (X : forall q : sigma, bar q r -> unit) => tt).
+
+Definition fooT (A : Type) (l : list A) : Type :=
+  ltac:(let ty := type of (foo A l) in exact ty).
+Parameter P : forall A l, fooT A l -> Prop.
+
+Goal forall A l, P A l (foo A l).
+Proof.
+  intros; unfold foo.
+  Fail match goal with
+    | [ |- context [False]] => idtac
+  end.
+Admitted.
diff --git a/test-suite/bugs/closed/6677.v b/test-suite/bugs/closed/6677.v
new file mode 100644
index 000000000..99e47bb87
--- /dev/null
+++ b/test-suite/bugs/closed/6677.v
@@ -0,0 +1,5 @@
+Set Universe Polymorphism.
+
+Definition T@{i} := Type@{i}.
+Fail Definition U@{i} := (T@{i} <: Type@{i}).
+Fail Definition eqU@{i j} : @eq T@{j} U@{i} T@{i} := eq_refl.
diff --git a/test-suite/bugs/closed/6774.v b/test-suite/bugs/closed/6774.v
new file mode 100644
index 000000000..9625af91f
--- /dev/null
+++ b/test-suite/bugs/closed/6774.v
@@ -0,0 +1,7 @@
+(* Was an anomaly with ill-typed template polymorphism *)
+Definition huh (b:bool) := if b then Set else Prop.
+Definition lol b: huh b :=
+  if b return huh b then nat else True.
+Goal (lol true) * unit.
+Fail generalize true. (* should fail with error, not anomaly *)
+Abort.
diff --git a/test-suite/bugs/closed/808_2411.v b/test-suite/bugs/closed/808_2411.v
index 1c13e7454..1169b2036 100644
--- a/test-suite/bugs/closed/808_2411.v
+++ b/test-suite/bugs/closed/808_2411.v
@@ -24,4 +24,4 @@ rewrite bar'.
 now apply le_S.
 Qed.
 
-End test.
\ No newline at end of file
+End test.
diff --git a/test-suite/bugs/closed/HoTT_coq_014.v b/test-suite/bugs/closed/HoTT_coq_014.v
index 223a98de1..5c4503664 100644
--- a/test-suite/bugs/closed/HoTT_coq_014.v
+++ b/test-suite/bugs/closed/HoTT_coq_014.v
@@ -199,4 +199,4 @@ Fail Admitted.
 Polymorphic Definition UnderlyingGraphFunctor_MorphismOf (C D : SmallCategory) (F : SpecializedFunctor C D) :
   Morphism (FunctorCategory GraphIndexingCategory TypeCat) (UnderlyingGraph C) (UnderlyingGraph D). (* Anomaly: apply_coercion. Please report.*)
 Proof.
-Admitted.
\ No newline at end of file
+Admitted.
diff --git a/test-suite/bugs/closed/HoTT_coq_064.v b/test-suite/bugs/closed/HoTT_coq_064.v
index b4c745375..d02a5f120 100644
--- a/test-suite/bugs/closed/HoTT_coq_064.v
+++ b/test-suite/bugs/closed/HoTT_coq_064.v
@@ -178,6 +178,7 @@ Definition IsColimit `{Funext} C D (F : Functor D C)
 
 Generalizable All Variables.
 Axiom fs : Funext.
+Existing Instance fs.
 
 Section bar.
 
diff --git a/test-suite/bugs/closed/HoTT_coq_080.v b/test-suite/bugs/closed/HoTT_coq_080.v
index 6b07c3040..a9e0bd267 100644
--- a/test-suite/bugs/closed/HoTT_coq_080.v
+++ b/test-suite/bugs/closed/HoTT_coq_080.v
@@ -24,4 +24,4 @@ Goal forall C D (x y : ob (sum_category C D)), Type.
 intros C D x y.
 hnf in x, y.
 exact (hom (sum_category _ _) x y). 
-Defined.
\ No newline at end of file
+Defined.
diff --git a/test-suite/bugs/closed/gh6165.v b/test-suite/bugs/closed/gh6165.v
new file mode 100644
index 000000000..b87a7caaf
--- /dev/null
+++ b/test-suite/bugs/closed/gh6165.v
@@ -0,0 +1,5 @@
+(* -*- mode: coq; coq-prog-args: ("-quick") -*- *)
+
+Goal True.
+  abstract exact I.
+Timeout 1 Defined.
diff --git a/test-suite/bugs/closed/gh6384.v b/test-suite/bugs/closed/gh6384.v
new file mode 100644
index 000000000..cec84642f
--- /dev/null
+++ b/test-suite/bugs/closed/gh6384.v
@@ -0,0 +1,5 @@
+Theorem test (A:Prop) : A \/ A -> A.
+  Fail intro H; destruct H as H.
+  (* Error: Disjunctive/conjunctive introduction pattern expected. *)
+  Fail intros H; destruct H as H.
+Abort.
diff --git a/test-suite/bugs/closed/gh6385.v b/test-suite/bugs/closed/gh6385.v
new file mode 100644
index 000000000..3bbb664f4
--- /dev/null
+++ b/test-suite/bugs/closed/gh6385.v
@@ -0,0 +1,5 @@
+Theorem test (A:Prop) : A \/ A -> A.
+  Fail let H := idtac in intros H; destruct H as H'.
+  (* Disjunctive/conjunctive introduction pattern expected. *)
+  Fail let H' := idtac in intros H; destruct H as H'.
+Abort.
diff --git a/test-suite/bugs/opened/1596.v b/test-suite/bugs/opened/1596.v
index 7c5dc4167..0b576db6b 100644
--- a/test-suite/bugs/opened/1596.v
+++ b/test-suite/bugs/opened/1596.v
@@ -258,4 +258,4 @@ n).
     apply SynInc;apply H.mem_2;trivial.
     rewrite H in H0. discriminate. (* !! impossible here !! *)
   Qed.
-End B.
\ No newline at end of file
+End B.
diff --git a/test-suite/bugs/opened/743.v b/test-suite/bugs/opened/1615.v
index 282570141..282570141 100644
--- a/test-suite/bugs/opened/743.v
+++ b/test-suite/bugs/opened/1615.v
diff --git a/test-suite/bugs/opened/1811.v b/test-suite/bugs/opened/1811.v
index 10c988fc0..57c174431 100644
--- a/test-suite/bugs/opened/1811.v
+++ b/test-suite/bugs/opened/1811.v
@@ -7,4 +7,4 @@ Goal forall b1 b2, (negb b1 = b2)  ->  xorb true b1 = b2.
 Proof.
   intros b1 b2.
   Fail rewrite neg2xor.
-Abort.
\ No newline at end of file
+Abort.
diff --git a/test-suite/bugs/opened/3794.v b/test-suite/bugs/opened/3794.v
index 99ca6cb39..e4711a38c 100644
--- a/test-suite/bugs/opened/3794.v
+++ b/test-suite/bugs/opened/3794.v
@@ -4,4 +4,4 @@ Hint Unfold not : core.
 Goal true<>false.
 Set Typeclasses Debug.
 Fail typeclasses eauto with core.
-Abort.
\ No newline at end of file
+Abort.
diff --git a/test-suite/bugs/opened/3948.v b/test-suite/bugs/opened/3948.v
index 165813084..5c4b4277b 100644
--- a/test-suite/bugs/opened/3948.v
+++ b/test-suite/bugs/opened/3948.v
@@ -22,4 +22,4 @@ Module DepMap : Interface.
     let _ := @Dom.fold in tt.
 End DepMap.
 
-Print Assumptions DepMap.constant.
\ No newline at end of file
+Print Assumptions DepMap.constant.
diff --git a/test-suite/bugs/opened/4717.v b/test-suite/bugs/opened/4717.v
deleted file mode 100644
index 9ad474672..000000000
--- a/test-suite/bugs/opened/4717.v
+++ /dev/null
@@ -1,19 +0,0 @@
-(*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/6393.v b/test-suite/bugs/opened/6393.v
new file mode 100644
index 000000000..8d5d09233
--- /dev/null
+++ b/test-suite/bugs/opened/6393.v
@@ -0,0 +1,11 @@
+(* These always worked. *)
+Goal prod True True. firstorder. Qed.
+Goal True -> @sigT True (fun _ => True). firstorder. Qed.
+Goal prod True True. dtauto. Qed.
+Goal prod True True. tauto. Qed.
+
+(* These should work. *)
+Goal @sigT True (fun _ => True). dtauto. Qed.
+(* These should work, but don't *)
+(* Goal @sigT True (fun _ => True). firstorder. Qed. *)
+(* Goal @sigT True (fun _ => True). tauto. Qed. *)
diff --git a/test-suite/bugs/opened/6602.v b/test-suite/bugs/opened/6602.v
new file mode 100644
index 000000000..3690adf90
--- /dev/null
+++ b/test-suite/bugs/opened/6602.v
@@ -0,0 +1,17 @@
+Require Import Omega.
+
+Lemma test_nat:
+  forall n, (5 + pred n <= 5 + n).
+Proof.
+  intros.
+  zify.
+  omega.
+Qed.
+
+Lemma test_N:
+  forall n, (5 + N.pred n <= 5 + n)%N.
+Proof.
+  intros.
+  zify.
+  omega.
+Qed.
diff --git a/test-suite/complexity/constructor.v b/test-suite/complexity/constructor.v
new file mode 100644
index 000000000..c5e195382
--- /dev/null
+++ b/test-suite/complexity/constructor.v
@@ -0,0 +1,216 @@
+(* Checks that constructor does not repeat the reduction of the conclusion *)
+(* Expected time < 3.00s *)
+
+(* Note: on i7 2.2GZ, time decreases from 85s to 0.1s *)
+
+Inductive T : bool -> Prop :=
+| C000 : T true | C001 : T true | C002 : T true | C003 : T true | C004 : T true
+| C005 : T true | C006 : T true | C007 : T true | C008 : T true | C009 : T true
+| C010 : T true | C011 : T true | C012 : T true | C013 : T true | C014 : T true
+| C015 : T true | C016 : T true | C017 : T true | C018 : T true | C019 : T true
+| C020 : T true | C021 : T true | C022 : T true | C023 : T true | C024 : T true
+| C025 : T true | C026 : T true | C027 : T true | C028 : T true | C029 : T true
+| C030 : T true | C031 : T true | C032 : T true | C033 : T true | C034 : T true
+| C035 : T true | C036 : T true | C037 : T true | C038 : T true | C039 : T true
+| C040 : T true | C041 : T true | C042 : T true | C043 : T true | C044 : T true
+| C045 : T true | C046 : T true | C047 : T true | C048 : T true | C049 : T true
+| C050 : T true | C051 : T true | C052 : T true | C053 : T true | C054 : T true
+| C055 : T true | C056 : T true | C057 : T true | C058 : T true | C059 : T true
+| C060 : T true | C061 : T true | C062 : T true | C063 : T true | C064 : T true
+| C065 : T true | C066 : T true | C067 : T true | C068 : T true | C069 : T true
+| C070 : T true | C071 : T true | C072 : T true | C073 : T true | C074 : T true
+| C075 : T true | C076 : T true | C077 : T true | C078 : T true | C079 : T true
+| C080 : T true | C081 : T true | C082 : T true | C083 : T true | C084 : T true
+| C085 : T true | C086 : T true | C087 : T true | C088 : T true | C089 : T true
+| C090 : T true | C091 : T true | C092 : T true | C093 : T true | C094 : T true
+| C095 : T true | C096 : T true | C097 : T true | C098 : T true | C099 : T true
+| C100 : T true | C101 : T true | C102 : T true | C103 : T true | C104 : T true
+| C105 : T true | C106 : T true | C107 : T true | C108 : T true | C109 : T true
+| C110 : T true | C111 : T true | C112 : T true | C113 : T true | C114 : T true
+| C115 : T true | C116 : T true | C117 : T true | C118 : T true | C119 : T true
+| C120 : T true | C121 : T true | C122 : T true | C123 : T true | C124 : T true
+| C125 : T true | C126 : T true | C127 : T true | C128 : T true | C129 : T true
+| C130 : T true | C131 : T true | C132 : T true | C133 : T true | C134 : T true
+| C135 : T true | C136 : T true | C137 : T true | C138 : T true | C139 : T true
+| C140 : T true | C141 : T true | C142 : T true | C143 : T true | C144 : T true
+| C145 : T true | C146 : T true | C147 : T true | C148 : T true | C149 : T true
+| C150 : T true | C151 : T true | C152 : T true | C153 : T true | C154 : T true
+| C155 : T true | C156 : T true | C157 : T true | C158 : T true | C159 : T true
+| C160 : T true | C161 : T true | C162 : T true | C163 : T true | C164 : T true
+| C165 : T true | C166 : T true | C167 : T true | C168 : T true | C169 : T true
+| C170 : T true | C171 : T true | C172 : T true | C173 : T true | C174 : T true
+| C175 : T true | C176 : T true | C177 : T true | C178 : T true | C179 : T true
+| C180 : T true | C181 : T true | C182 : T true | C183 : T true | C184 : T true
+| C185 : T true | C186 : T true | C187 : T true | C188 : T true | C189 : T true
+| C190 : T true | C191 : T true | C192 : T true | C193 : T true | C194 : T true
+| C195 : T true | C196 : T true | C197 : T true | C198 : T true | C199 : T true
+| C200 : T true | C201 : T true | C202 : T true | C203 : T true | C204 : T true
+| C205 : T true | C206 : T true | C207 : T true | C208 : T true | C209 : T true
+| C210 : T true | C211 : T true | C212 : T true | C213 : T true | C214 : T true
+| C215 : T true | C216 : T true | C217 : T true | C218 : T true | C219 : T true
+| C220 : T true | C221 : T true | C222 : T true | C223 : T true | C224 : T true
+| C225 : T true | C226 : T true | C227 : T true | C228 : T true | C229 : T true
+| C230 : T true | C231 : T true | C232 : T true | C233 : T true | C234 : T true
+| C235 : T true | C236 : T true | C237 : T true | C238 : T true | C239 : T true
+| C240 : T true | C241 : T true | C242 : T true | C243 : T true | C244 : T true
+| C245 : T true | C246 : T true | C247 : T true | C248 : T true | C249 : T true
+| C250 : T true | C251 : T true | C252 : T true | C253 : T true | C254 : T true
+| C255 : T true | C256 : T true | C257 : T true | C258 : T true | C259 : T true
+| C260 : T true | C261 : T true | C262 : T true | C263 : T true | C264 : T true
+| C265 : T true | C266 : T true | C267 : T true | C268 : T true | C269 : T true
+| C270 : T true | C271 : T true | C272 : T true | C273 : T true | C274 : T true
+| C275 : T true | C276 : T true | C277 : T true | C278 : T true | C279 : T true
+| C280 : T true | C281 : T true | C282 : T true | C283 : T true | C284 : T true
+| C285 : T true | C286 : T true | C287 : T true | C288 : T true | C289 : T true
+| C290 : T true | C291 : T true | C292 : T true | C293 : T true | C294 : T true
+| C295 : T true | C296 : T true | C297 : T true | C298 : T true | C299 : T true
+| C300 : T true | C301 : T true | C302 : T true | C303 : T true | C304 : T true
+| C305 : T true | C306 : T true | C307 : T true | C308 : T true | C309 : T true
+| C310 : T true | C311 : T true | C312 : T true | C313 : T true | C314 : T true
+| C315 : T true | C316 : T true | C317 : T true | C318 : T true | C319 : T true
+| C320 : T true | C321 : T true | C322 : T true | C323 : T true | C324 : T true
+| C325 : T true | C326 : T true | C327 : T true | C328 : T true | C329 : T true
+| C330 : T true | C331 : T true | C332 : T true | C333 : T true | C334 : T true
+| C335 : T true | C336 : T true | C337 : T true | C338 : T true | C339 : T true
+| C340 : T true | C341 : T true | C342 : T true | C343 : T true | C344 : T true
+| C345 : T true | C346 : T true | C347 : T true | C348 : T true | C349 : T true
+| C350 : T true | C351 : T true | C352 : T true | C353 : T true | C354 : T true
+| C355 : T true | C356 : T true | C357 : T true | C358 : T true | C359 : T true
+| C360 : T true | C361 : T true | C362 : T true | C363 : T true | C364 : T true
+| C365 : T true | C366 : T true | C367 : T true | C368 : T true | C369 : T true
+| C370 : T true | C371 : T true | C372 : T true | C373 : T true | C374 : T true
+| C375 : T true | C376 : T true | C377 : T true | C378 : T true | C379 : T true
+| C380 : T true | C381 : T true | C382 : T true | C383 : T true | C384 : T true
+| C385 : T true | C386 : T true | C387 : T true | C388 : T true | C389 : T true
+| C390 : T true | C391 : T true | C392 : T true | C393 : T true | C394 : T true
+| C395 : T true | C396 : T true | C397 : T true | C398 : T true | C399 : T true
+| C400 : T true | C401 : T true | C402 : T true | C403 : T true | C404 : T true
+| C405 : T true | C406 : T true | C407 : T true | C408 : T true | C409 : T true
+| C410 : T true | C411 : T true | C412 : T true | C413 : T true | C414 : T true
+| C415 : T true | C416 : T true | C417 : T true | C418 : T true | C419 : T true
+| C420 : T true | C421 : T true | C422 : T true | C423 : T true | C424 : T true
+| C425 : T true | C426 : T true | C427 : T true | C428 : T true | C429 : T true
+| C430 : T true | C431 : T true | C432 : T true | C433 : T true | C434 : T true
+| C435 : T true | C436 : T true | C437 : T true | C438 : T true | C439 : T true
+| C440 : T true | C441 : T true | C442 : T true | C443 : T true | C444 : T true
+| C445 : T true | C446 : T true | C447 : T true | C448 : T true | C449 : T true
+| C450 : T true | C451 : T true | C452 : T true | C453 : T true | C454 : T true
+| C455 : T true | C456 : T true | C457 : T true | C458 : T true | C459 : T true
+| C460 : T true | C461 : T true | C462 : T true | C463 : T true | C464 : T true
+| C465 : T true | C466 : T true | C467 : T true | C468 : T true | C469 : T true
+| C470 : T true | C471 : T true | C472 : T true | C473 : T true | C474 : T true
+| C475 : T true | C476 : T true | C477 : T true | C478 : T true | C479 : T true
+| C480 : T true | C481 : T true | C482 : T true | C483 : T true | C484 : T true
+| C485 : T true | C486 : T true | C487 : T true | C488 : T true | C489 : T true
+| C490 : T true | C491 : T true | C492 : T true | C493 : T true | C494 : T true
+| C495 : T true | C496 : T true | C497 : T true | C498 : T true | C499 : T true
+| C500 : T true | C501 : T true | C502 : T true | C503 : T true | C504 : T true
+| C505 : T true | C506 : T true | C507 : T true | C508 : T true | C509 : T true
+| C510 : T true | C511 : T true | C512 : T true | C513 : T true | C514 : T true
+| C515 : T true | C516 : T true | C517 : T true | C518 : T true | C519 : T true
+| C520 : T true | C521 : T true | C522 : T true | C523 : T true | C524 : T true
+| C525 : T true | C526 : T true | C527 : T true | C528 : T true | C529 : T true
+| C530 : T true | C531 : T true | C532 : T true | C533 : T true | C534 : T true
+| C535 : T true | C536 : T true | C537 : T true | C538 : T true | C539 : T true
+| C540 : T true | C541 : T true | C542 : T true | C543 : T true | C544 : T true
+| C545 : T true | C546 : T true | C547 : T true | C548 : T true | C549 : T true
+| C550 : T true | C551 : T true | C552 : T true | C553 : T true | C554 : T true
+| C555 : T true | C556 : T true | C557 : T true | C558 : T true | C559 : T true
+| C560 : T true | C561 : T true | C562 : T true | C563 : T true | C564 : T true
+| C565 : T true | C566 : T true | C567 : T true | C568 : T true | C569 : T true
+| C570 : T true | C571 : T true | C572 : T true | C573 : T true | C574 : T true
+| C575 : T true | C576 : T true | C577 : T true | C578 : T true | C579 : T true
+| C580 : T true | C581 : T true | C582 : T true | C583 : T true | C584 : T true
+| C585 : T true | C586 : T true | C587 : T true | C588 : T true | C589 : T true
+| C590 : T true | C591 : T true | C592 : T true | C593 : T true | C594 : T true
+| C595 : T true | C596 : T true | C597 : T true | C598 : T true | C599 : T true
+| C600 : T true | C601 : T true | C602 : T true | C603 : T true | C604 : T true
+| C605 : T true | C606 : T true | C607 : T true | C608 : T true | C609 : T true
+| C610 : T true | C611 : T true | C612 : T true | C613 : T true | C614 : T true
+| C615 : T true | C616 : T true | C617 : T true | C618 : T true | C619 : T true
+| C620 : T true | C621 : T true | C622 : T true | C623 : T true | C624 : T true
+| C625 : T true | C626 : T true | C627 : T true | C628 : T true | C629 : T true
+| C630 : T true | C631 : T true | C632 : T true | C633 : T true | C634 : T true
+| C635 : T true | C636 : T true | C637 : T true | C638 : T true | C639 : T true
+| C640 : T true | C641 : T true | C642 : T true | C643 : T true | C644 : T true
+| C645 : T true | C646 : T true | C647 : T true | C648 : T true | C649 : T true
+| C650 : T true | C651 : T true | C652 : T true | C653 : T true | C654 : T true
+| C655 : T true | C656 : T true | C657 : T true | C658 : T true | C659 : T true
+| C660 : T true | C661 : T true | C662 : T true | C663 : T true | C664 : T true
+| C665 : T true | C666 : T true | C667 : T true | C668 : T true | C669 : T true
+| C670 : T true | C671 : T true | C672 : T true | C673 : T true | C674 : T true
+| C675 : T true | C676 : T true | C677 : T true | C678 : T true | C679 : T true
+| C680 : T true | C681 : T true | C682 : T true | C683 : T true | C684 : T true
+| C685 : T true | C686 : T true | C687 : T true | C688 : T true | C689 : T true
+| C690 : T true | C691 : T true | C692 : T true | C693 : T true | C694 : T true
+| C695 : T true | C696 : T true | C697 : T true | C698 : T true | C699 : T true
+| C700 : T true | C701 : T true | C702 : T true | C703 : T true | C704 : T true
+| C705 : T true | C706 : T true | C707 : T true | C708 : T true | C709 : T true
+| C710 : T true | C711 : T true | C712 : T true | C713 : T true | C714 : T true
+| C715 : T true | C716 : T true | C717 : T true | C718 : T true | C719 : T true
+| C720 : T true | C721 : T true | C722 : T true | C723 : T true | C724 : T true
+| C725 : T true | C726 : T true | C727 : T true | C728 : T true | C729 : T true
+| C730 : T true | C731 : T true | C732 : T true | C733 : T true | C734 : T true
+| C735 : T true | C736 : T true | C737 : T true | C738 : T true | C739 : T true
+| C740 : T true | C741 : T true | C742 : T true | C743 : T true | C744 : T true
+| C745 : T true | C746 : T true | C747 : T true | C748 : T true | C749 : T true
+| C750 : T true | C751 : T true | C752 : T true | C753 : T true | C754 : T true
+| C755 : T true | C756 : T true | C757 : T true | C758 : T true | C759 : T true
+| C760 : T true | C761 : T true | C762 : T true | C763 : T true | C764 : T true
+| C765 : T true | C766 : T true | C767 : T true | C768 : T true | C769 : T true
+| C770 : T true | C771 : T true | C772 : T true | C773 : T true | C774 : T true
+| C775 : T true | C776 : T true | C777 : T true | C778 : T true | C779 : T true
+| C780 : T true | C781 : T true | C782 : T true | C783 : T true | C784 : T true
+| C785 : T true | C786 : T true | C787 : T true | C788 : T true | C789 : T true
+| C790 : T true | C791 : T true | C792 : T true | C793 : T true | C794 : T true
+| C795 : T true | C796 : T true | C797 : T true | C798 : T true | C799 : T true
+| C800 : T true | C801 : T true | C802 : T true | C803 : T true | C804 : T true
+| C805 : T true | C806 : T true | C807 : T true | C808 : T true | C809 : T true
+| C810 : T true | C811 : T true | C812 : T true | C813 : T true | C814 : T true
+| C815 : T true | C816 : T true | C817 : T true | C818 : T true | C819 : T true
+| C820 : T true | C821 : T true | C822 : T true | C823 : T true | C824 : T true
+| C825 : T true | C826 : T true | C827 : T true | C828 : T true | C829 : T true
+| C830 : T true | C831 : T true | C832 : T true | C833 : T true | C834 : T true
+| C835 : T true | C836 : T true | C837 : T true | C838 : T true | C839 : T true
+| C840 : T true | C841 : T true | C842 : T true | C843 : T true | C844 : T true
+| C845 : T true | C846 : T true | C847 : T true | C848 : T true | C849 : T true
+| C850 : T true | C851 : T true | C852 : T true | C853 : T true | C854 : T true
+| C855 : T true | C856 : T true | C857 : T true | C858 : T true | C859 : T true
+| C860 : T true | C861 : T true | C862 : T true | C863 : T true | C864 : T true
+| C865 : T true | C866 : T true | C867 : T true | C868 : T true | C869 : T true
+| C870 : T true | C871 : T true | C872 : T true | C873 : T true | C874 : T true
+| C875 : T true | C876 : T true | C877 : T true | C878 : T true | C879 : T true
+| C880 : T true | C881 : T true | C882 : T true | C883 : T true | C884 : T true
+| C885 : T true | C886 : T true | C887 : T true | C888 : T true | C889 : T true
+| C890 : T true | C891 : T true | C892 : T true | C893 : T true | C894 : T true
+| C895 : T true | C896 : T true | C897 : T true | C898 : T true | C899 : T true
+| C900 : T true | C901 : T true | C902 : T true | C903 : T true | C904 : T true
+| C905 : T true | C906 : T true | C907 : T true | C908 : T true | C909 : T true
+| C910 : T true | C911 : T true | C912 : T true | C913 : T true | C914 : T true
+| C915 : T true | C916 : T true | C917 : T true | C918 : T true | C919 : T true
+| C920 : T true | C921 : T true | C922 : T true | C923 : T true | C924 : T true
+| C925 : T true | C926 : T true | C927 : T true | C928 : T true | C929 : T true
+| C930 : T true | C931 : T true | C932 : T true | C933 : T true | C934 : T true
+| C935 : T true | C936 : T true | C937 : T true | C938 : T true | C939 : T true
+| C940 : T true | C941 : T true | C942 : T true | C943 : T true | C944 : T true
+| C945 : T true | C946 : T true | C947 : T true | C948 : T true | C949 : T true
+| C950 : T true | C951 : T true | C952 : T true | C953 : T true | C954 : T true
+| C955 : T true | C956 : T true | C957 : T true | C958 : T true | C959 : T true
+| C960 : T true | C961 : T true | C962 : T true | C963 : T true | C964 : T true
+| C965 : T true | C966 : T true | C967 : T true | C968 : T true | C969 : T true
+| C970 : T true | C971 : T true | C972 : T true | C973 : T true | C974 : T true
+| C975 : T true | C976 : T true | C977 : T true | C978 : T true | C979 : T true
+| C980 : T true | C981 : T true | C982 : T true | C983 : T true | C984 : T true
+| C985 : T true | C986 : T true | C987 : T true | C988 : T true | C989 : T true
+| C990 : T true | C991 : T true | C992 : T true | C993 : T true | C994 : T true
+| C995 : T true | C996 : T true | C997 : T true | C998 : T true | C999 : T true
+| C1000 : T false.
+
+Fixpoint expand (n : nat) : Prop :=
+  match n with
+  | O => T false
+  | S n => expand n
+  end.
+
+Example Expand : expand 2500.
+Time constructor. (* ~0.45 secs *)
diff --git a/test-suite/coq-makefile/.gitignore b/test-suite/coq-makefile/.gitignore
new file mode 100644
index 000000000..e866161ce
--- /dev/null
+++ b/test-suite/coq-makefile/.gitignore
@@ -0,0 +1 @@
+/*/_test
diff --git a/test-suite/coq-makefile/emptyprefix/_CoqProject b/test-suite/coq-makefile/emptyprefix/_CoqProject
new file mode 100644
index 000000000..5678a8edb
--- /dev/null
+++ b/test-suite/coq-makefile/emptyprefix/_CoqProject
@@ -0,0 +1,11 @@
+-R theories ""
+-R src ""
+-I src
+-arg "-w default"
+
+src/test_plugin.mlpack
+src/test.ml4
+src/test.mli
+src/test_aux.ml
+src/test_aux.mli
+theories/test.v
diff --git a/test-suite/coq-makefile/emptyprefix/_CoqProject.sub b/test-suite/coq-makefile/emptyprefix/_CoqProject.sub
new file mode 100644
index 000000000..90ac541e0
--- /dev/null
+++ b/test-suite/coq-makefile/emptyprefix/_CoqProject.sub
@@ -0,0 +1,3 @@
+-R ../theories ""
+-I ../src
+testsub.v
diff --git a/test-suite/coq-makefile/emptyprefix/run.sh b/test-suite/coq-makefile/emptyprefix/run.sh
new file mode 100755
index 000000000..a10e63b42
--- /dev/null
+++ b/test-suite/coq-makefile/emptyprefix/run.sh
@@ -0,0 +1,17 @@
+#!/usr/bin/env bash
+
+set -e
+
+. ../template/init.sh
+
+mv theories/sub theories2
+
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make
+
+cp ../_CoqProject.sub theories2/_CoqProject
+cd theories2
+coq_makefile -f _CoqProject -o Makefile
+cat Makefile.conf
+make
diff --git a/test-suite/coq-makefile/plugin-reach-outside-API-and-fail/run.sh b/test-suite/coq-makefile/plugin-reach-outside-API-and-fail/run.sh
deleted file mode 100755
index 88606cd47..000000000
--- a/test-suite/coq-makefile/plugin-reach-outside-API-and-fail/run.sh
+++ /dev/null
@@ -1,38 +0,0 @@
-#!/usr/bin/env bash
-
-set -e
-
-git clean -dfx
-
-cat > _CoqProject <<EOT
--I src/
-
-./src/test_plugin.mllib
-./src/test.ml4
-./src/test.mli
-EOT
-
-mkdir src
-
-cat > src/test_plugin.mllib <<EOT
-Test
-EOT
-
-touch src/test.mli
-
-cat > src/test.ml4 <<EOT
-DECLARE PLUGIN "test"
-
-let _ = Pre_env.empty_env
-EOT
-
-${COQBIN}coq_makefile -f _CoqProject -o Makefile
-cat Makefile.conf
-
-if make VERBOSE=1; then
-  # make command should have failed (but didn't)
-  exit 1
-else
-  # make command should have failed (and it indeed did)
-  exit 0
-fi
diff --git a/test-suite/coq-makefile/plugin-reach-outside-API-and-succeed-by-bypassing-the-API/run.sh b/test-suite/coq-makefile/plugin-reach-outside-API-and-succeed-by-bypassing-the-API/run.sh
deleted file mode 100755
index 939ef9c7b..000000000
--- a/test-suite/coq-makefile/plugin-reach-outside-API-and-succeed-by-bypassing-the-API/run.sh
+++ /dev/null
@@ -1,33 +0,0 @@
-#!/usr/bin/env bash
-
-set -e
-
-git clean -dfx
-
-cat > _CoqProject <<EOT
--bypass-API
--I src/
-
-./src/test_plugin.mllib
-./src/test.ml4
-./src/test.mli
-EOT
-
-mkdir src
-
-cat > src/test_plugin.mllib <<EOT
-Test
-EOT
-
-touch src/test.mli
-
-cat > src/test.ml4 <<EOT
-DECLARE PLUGIN "test"
-
-let _ = Pre_env.empty_env
-EOT
-
-${COQBIN}coq_makefile -f _CoqProject -o Makefile
-cat Makefile.conf
-
-make VERBOSE=1
diff --git a/test-suite/coq-makefile/quick2vo/_CoqProject b/test-suite/coq-makefile/quick2vo/_CoqProject
new file mode 100644
index 000000000..69f47302e
--- /dev/null
+++ b/test-suite/coq-makefile/quick2vo/_CoqProject
@@ -0,0 +1,10 @@
+-R src test
+-R theories test
+-I src
+
+src/test_plugin.mlpack
+src/test.ml4
+src/test.mli
+src/test_aux.ml
+src/test_aux.mli
+theories/test.v
diff --git a/test-suite/coq-makefile/quick2vo/run.sh b/test-suite/coq-makefile/quick2vo/run.sh
new file mode 100755
index 000000000..9e681223b
--- /dev/null
+++ b/test-suite/coq-makefile/quick2vo/run.sh
@@ -0,0 +1,12 @@
+#!/usr/bin/env bash
+a=`uname`
+
+. ../template/init.sh
+
+coq_makefile -f _CoqProject -o Makefile
+# vio2vo is broken on Windows (#6720)
+if [ "$a" = "Darwin" -o "$a" = "Linux" ]; then
+    make quick2vo J=2
+    test -f theories/test.vo
+    make validate
+fi
diff --git a/test-suite/coq-makefile/template/init.sh b/test-suite/coq-makefile/template/init.sh
index 803fe8029..e19d168cf 100755
--- a/test-suite/coq-makefile/template/init.sh
+++ b/test-suite/coq-makefile/template/init.sh
@@ -1,18 +1,17 @@
-set -e
-set -o pipefail
+. ../template/path-init.sh
 
-export PATH=$COQBIN:$PATH
-
-rm -rf theories src Makefile Makefile.conf tmp
-git clean -dfx || true
+rm -rf _test
+mkdir _test
+find . -maxdepth 1 -not -name . -not -name _test -exec cp -r '{}' -t _test ';'
 
+cd _test
 mkdir -p src
 mkdir -p theories/sub
 
-cp ../template/theories/sub/testsub.v theories/sub
-cp ../template/theories/test.v theories
-cp ../template/src/test.ml4 src
-cp ../template/src/test_aux.mli src
-cp ../template/src/test.mli src
-cp ../template/src/test_plugin.mlpack src
-cp ../template/src/test_aux.ml src
+cp ../../template/theories/sub/testsub.v theories/sub
+cp ../../template/theories/test.v theories
+cp ../../template/src/test.ml4 src
+cp ../../template/src/test_aux.mli src
+cp ../../template/src/test.mli src
+cp ../../template/src/test_plugin.mlpack src
+cp ../../template/src/test_aux.ml src
diff --git a/test-suite/coq-makefile/template/path-init.sh b/test-suite/coq-makefile/template/path-init.sh
new file mode 100755
index 000000000..dd19ab2b1
--- /dev/null
+++ b/test-suite/coq-makefile/template/path-init.sh
@@ -0,0 +1,5 @@
+set -e
+set -o pipefail
+
+export PATH="$COQBIN:$PATH"
+export LC_ALL=C
diff --git a/test-suite/coq-makefile/template/src/test.ml4 b/test-suite/coq-makefile/template/src/test.ml4
index e7d0bfe1f..72765abe0 100644
--- a/test-suite/coq-makefile/template/src/test.ml4
+++ b/test-suite/coq-makefile/template/src/test.ml4
@@ -1,4 +1,3 @@
-open API
 open Ltac_plugin
 DECLARE PLUGIN "test_plugin"
 let () = Mltop.add_known_plugin (fun () -> ()) "test_plugin";;
diff --git a/test-suite/coq-makefile/template/src/test_aux.ml b/test-suite/coq-makefile/template/src/test_aux.ml
index e134abd84..a01d0865a 100644
--- a/test-suite/coq-makefile/template/src/test_aux.ml
+++ b/test-suite/coq-makefile/template/src/test_aux.ml
@@ -1 +1 @@
-let tac = API.Proofview.tclUNIT ()
+let tac = Proofview.tclUNIT ()
diff --git a/test-suite/coq-makefile/template/src/test_aux.mli b/test-suite/coq-makefile/template/src/test_aux.mli
index 2e7ad1529..10020f27d 100644
--- a/test-suite/coq-makefile/template/src/test_aux.mli
+++ b/test-suite/coq-makefile/template/src/test_aux.mli
@@ -1 +1 @@
-val tac : unit API.Proofview.tactic
+val tac : unit Proofview.tactic
diff --git a/test-suite/coq-makefile/timing/after/time-of-build-after.log.desired b/test-suite/coq-makefile/timing/after/time-of-build-after.log.desired
index 729de2f36..7900c034d 100644
--- a/test-suite/coq-makefile/timing/after/time-of-build-after.log.desired
+++ b/test-suite/coq-makefile/timing/after/time-of-build-after.log.desired
@@ -1,7 +1,6 @@
 Makefile:69: warning: undefined variable '*'
 Makefile:204: warning: undefined variable 'DSTROOT'
-COQDEP Fast.v
-COQDEP Slow.v
+COQDEP VFILES
 Makefile:69: warning: undefined variable '*'
 Makefile:204: warning: undefined variable 'DSTROOT'
 Makefile:69: warning: undefined variable '*'
diff --git a/test-suite/coq-makefile/timing/after/time-of-build-before.log.desired b/test-suite/coq-makefile/timing/after/time-of-build-before.log.desired
index b25bc3683..7ab0bc75d 100644
--- a/test-suite/coq-makefile/timing/after/time-of-build-before.log.desired
+++ b/test-suite/coq-makefile/timing/after/time-of-build-before.log.desired
@@ -1,7 +1,6 @@
 Makefile:69: warning: undefined variable '*'
 Makefile:204: warning: undefined variable 'DSTROOT'
-COQDEP Fast.v
-COQDEP Slow.v
+COQDEP VFILES
 Makefile:69: warning: undefined variable '*'
 Makefile:204: warning: undefined variable 'DSTROOT'
 Makefile:69: warning: undefined variable '*'
diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/.gitattributes b/test-suite/coq-makefile/timing/precomputed-time-tests/.gitattributes
new file mode 100644
index 000000000..e0596e614
--- /dev/null
+++ b/test-suite/coq-makefile/timing/precomputed-time-tests/.gitattributes
@@ -0,0 +1,2 @@
+*.log.in -whitespace
+*.log.expected -whitespace
diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/run.sh b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/run.sh
new file mode 100755
index 000000000..4a50759bd
--- /dev/null
+++ b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/run.sh
@@ -0,0 +1,10 @@
+#!/usr/bin/env bash
+
+set -x
+set -e
+
+cd "$(dirname "${BASH_SOURCE[0]}")"
+
+"$COQLIB"/tools/make-both-time-files.py time-of-build-after.log.in time-of-build-before.log.in time-of-build-both.log
+
+diff -u time-of-build-both.log.expected time-of-build-both.log || exit $?
diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-after.log.in b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-after.log.in
new file mode 100644
index 000000000..5757018e9
--- /dev/null
+++ b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-after.log.in
@@ -0,0 +1,1760 @@
+COQDEP src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics.v
+COQDEP src/Compilers/Z/Bounds/Pipeline/Definition.v
+/home/jgross/.local64/coq/coq-master/bin/coq_makefile -f _CoqProject INSTALLDEFAULTROOT = Crypto -o Makefile-old
+COQ_MAKEFILE -f _CoqProject > Makefile.coq
+make --no-print-directory -C coqprime
+make[1]: Nothing to be done for 'all'.
+ECHO > _CoqProject
+COQC src/Compilers/Z/Bounds/Pipeline/Definition.v
+src/Compilers/Z/Bounds/Pipeline/Definition (real: 7.33, user: 7.18, sys: 0.14, mem: 574388 ko)
+COQC src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics.v
+src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics (real: 1.93, user: 1.72, sys: 0.20, mem: 544172 ko)
+COQC src/Compilers/Z/Bounds/Pipeline.v
+src/Compilers/Z/Bounds/Pipeline (real: 1.38, user: 1.19, sys: 0.16, mem: 539808 ko)
+COQC src/Specific/Framework/SynthesisFramework.v
+src/Specific/Framework/SynthesisFramework (real: 1.85, user: 1.67, sys: 0.17, mem: 646300 ko)
+COQC src/Specific/X25519/C64/Synthesis.v
+src/Specific/X25519/C64/Synthesis (real: 11.15, user: 10.37, sys: 0.18, mem: 687760 ko)
+COQC src/Specific/NISTP256/AMD64/Synthesis.v
+src/Specific/NISTP256/AMD64/Synthesis (real: 13.45, user: 12.55, sys: 0.19, mem: 668216 ko)
+COQC src/Specific/X25519/C64/feadd.v
+Finished transaction in 2.814 secs (2.624u,0.s) (successful)
+total time:      2.576s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.2%  97.4%       1    2.508s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  66.9%       1    1.724s
+─ReflectiveTactics.solve_side_conditions   0.0%  65.5%       1    1.688s
+─ReflectiveTactics.solve_post_reified_si   1.2%  37.0%       1    0.952s
+─Glue.refine_to_reflective_glue' -------   0.0%  30.3%       1    0.780s
+─ReflectiveTactics.do_reify ------------   0.0%  28.6%       1    0.736s
+─Reify.Reify_rhs_gen -------------------   2.2%  26.6%       1    0.684s
+─UnifyAbstractReflexivity.unify_transfor  20.3%  24.1%       7    0.164s
+─Glue.zrange_to_reflective -------------   0.0%  20.3%       1    0.524s
+─Glue.zrange_to_reflective_goal --------   9.5%  15.2%       1    0.392s
+─Reify.do_reify_abs_goal ---------------  13.7%  13.8%       2    0.356s
+─Reify.do_reifyf_goal ------------------  12.4%  12.6%      16    0.324s
+─ReflectiveTactics.unify_abstract_cbv_in   8.4%  11.2%       1    0.288s
+─unify (constr) (constr) ---------------   5.7%   5.7%       6    0.072s
+─Glue.pattern_sig_sig_assoc ------------   0.0%   5.4%       1    0.140s
+─assert (H : is_bounded_by' bounds (map'   4.8%   5.1%       2    0.072s
+─Glue.pattern_proj1_sig_in_sig ---------   1.7%   5.1%       1    0.132s
+─pose proof  (pf   :   Interpretation.Bo   3.7%   3.7%       1    0.096s
+─Glue.split_BoundedWordToZ -------------   0.3%   3.7%       1    0.096s
+─destruct_sig --------------------------   0.2%   3.3%       4    0.044s
+─destruct x ----------------------------   3.1%   3.1%       4    0.036s
+─eexact --------------------------------   3.0%   3.0%      18    0.008s
+─clearbody (ne_var_list) ---------------   3.0%   3.0%       4    0.060s
+─prove_interp_compile_correct ----------   0.0%   2.8%       1    0.072s
+─synthesize ----------------------------   0.0%   2.6%       1    0.068s
+─rewrite ?EtaInterp.InterpExprEta ------   2.5%   2.5%       1    0.064s
+─ClearbodyAll.clearbody_all ------------   0.0%   2.3%       2    0.060s
+─rewrite H -----------------------------   2.2%   2.2%       1    0.056s
+─reflexivity ---------------------------   2.2%   2.2%       7    0.032s
+─Reify.transitivity_tt -----------------   0.0%   2.2%       2    0.032s
+─transitivity --------------------------   2.0%   2.0%       5    0.024s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.2%  97.4%       1    2.508s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  66.9%       1    1.724s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  65.5%       1    1.688s
+ │ ├─ReflectiveTactics.solve_post_reifie   1.2%  37.0%       1    0.952s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  20.3%  24.1%       7    0.164s
+ │ │ │└unify (constr) (constr) ---------   3.0%   3.0%       5    0.028s
+ │ │ └─ReflectiveTactics.unify_abstract_   8.4%  11.2%       1    0.288s
+ │ │  └unify (constr) (constr) ---------   2.8%   2.8%       1    0.072s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  28.6%       1    0.736s
+ │  └Reify.Reify_rhs_gen ---------------   2.2%  26.6%       1    0.684s
+ │   ├─Reify.do_reify_abs_goal ---------  13.7%  13.8%       2    0.356s
+ │   │└Reify.do_reifyf_goal ------------  12.4%  12.6%      16    0.324s
+ │   │└eexact --------------------------   2.6%   2.6%      16    0.008s
+ │   ├─prove_interp_compile_correct ----   0.0%   2.8%       1    0.072s
+ │   │└rewrite ?EtaInterp.InterpExprEta    2.5%   2.5%       1    0.064s
+ │   ├─rewrite H -----------------------   2.2%   2.2%       1    0.056s
+ │   └─Reify.transitivity_tt -----------   0.0%   2.2%       2    0.032s
+ └─Glue.refine_to_reflective_glue' -----   0.0%  30.3%       1    0.780s
+   ├─Glue.zrange_to_reflective ---------   0.0%  20.3%       1    0.524s
+   │ ├─Glue.zrange_to_reflective_goal --   9.5%  15.2%       1    0.392s
+   │ │└pose proof  (pf   :   Interpretat   3.7%   3.7%       1    0.096s
+   │ └─assert (H : is_bounded_by' bounds   4.8%   5.1%       2    0.072s
+   ├─Glue.pattern_sig_sig_assoc --------   0.0%   5.4%       1    0.140s
+   │└Glue.pattern_proj1_sig_in_sig -----   1.7%   5.1%       1    0.132s
+   │└ClearbodyAll.clearbody_all --------   0.0%   2.3%       2    0.060s
+   │└clearbody (ne_var_list) -----------   2.3%   2.3%       1    0.060s
+   └─Glue.split_BoundedWordToZ ---------   0.3%   3.7%       1    0.096s
+    â””destruct_sig ----------------------   0.2%   3.3%       4    0.044s
+    â””destruct x ------------------------   2.5%   2.5%       2    0.036s
+─synthesize ----------------------------   0.0%   2.6%       1    0.068s
+
+Finished transaction in 5.021 secs (4.636u,0.s) (successful)
+Closed under the global context
+total time:      2.576s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.2%  97.4%       1    2.508s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  66.9%       1    1.724s
+─ReflectiveTactics.solve_side_conditions   0.0%  65.5%       1    1.688s
+─ReflectiveTactics.solve_post_reified_si   1.2%  37.0%       1    0.952s
+─Glue.refine_to_reflective_glue' -------   0.0%  30.3%       1    0.780s
+─ReflectiveTactics.do_reify ------------   0.0%  28.6%       1    0.736s
+─Reify.Reify_rhs_gen -------------------   2.2%  26.6%       1    0.684s
+─UnifyAbstractReflexivity.unify_transfor  20.3%  24.1%       7    0.164s
+─Glue.zrange_to_reflective -------------   0.0%  20.3%       1    0.524s
+─Glue.zrange_to_reflective_goal --------   9.5%  15.2%       1    0.392s
+─Reify.do_reify_abs_goal ---------------  13.7%  13.8%       2    0.356s
+─Reify.do_reifyf_goal ------------------  12.4%  12.6%      16    0.324s
+─ReflectiveTactics.unify_abstract_cbv_in   8.4%  11.2%       1    0.288s
+─unify (constr) (constr) ---------------   5.7%   5.7%       6    0.072s
+─Glue.pattern_sig_sig_assoc ------------   0.0%   5.4%       1    0.140s
+─assert (H : is_bounded_by' bounds (map'   4.8%   5.1%       2    0.072s
+─Glue.pattern_proj1_sig_in_sig ---------   1.7%   5.1%       1    0.132s
+─pose proof  (pf   :   Interpretation.Bo   3.7%   3.7%       1    0.096s
+─Glue.split_BoundedWordToZ -------------   0.3%   3.7%       1    0.096s
+─destruct_sig --------------------------   0.2%   3.3%       4    0.044s
+─destruct x ----------------------------   3.1%   3.1%       4    0.036s
+─eexact --------------------------------   3.0%   3.0%      18    0.008s
+─clearbody (ne_var_list) ---------------   3.0%   3.0%       4    0.060s
+─prove_interp_compile_correct ----------   0.0%   2.8%       1    0.072s
+─synthesize ----------------------------   0.0%   2.6%       1    0.068s
+─rewrite ?EtaInterp.InterpExprEta ------   2.5%   2.5%       1    0.064s
+─ClearbodyAll.clearbody_all ------------   0.0%   2.3%       2    0.060s
+─rewrite H -----------------------------   2.2%   2.2%       1    0.056s
+─reflexivity ---------------------------   2.2%   2.2%       7    0.032s
+─Reify.transitivity_tt -----------------   0.0%   2.2%       2    0.032s
+─transitivity --------------------------   2.0%   2.0%       5    0.024s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.2%  97.4%       1    2.508s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  66.9%       1    1.724s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  65.5%       1    1.688s
+ │ ├─ReflectiveTactics.solve_post_reifie   1.2%  37.0%       1    0.952s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  20.3%  24.1%       7    0.164s
+ │ │ │└unify (constr) (constr) ---------   3.0%   3.0%       5    0.028s
+ │ │ └─ReflectiveTactics.unify_abstract_   8.4%  11.2%       1    0.288s
+ │ │  └unify (constr) (constr) ---------   2.8%   2.8%       1    0.072s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  28.6%       1    0.736s
+ │  └Reify.Reify_rhs_gen ---------------   2.2%  26.6%       1    0.684s
+ │   ├─Reify.do_reify_abs_goal ---------  13.7%  13.8%       2    0.356s
+ │   │└Reify.do_reifyf_goal ------------  12.4%  12.6%      16    0.324s
+ │   │└eexact --------------------------   2.6%   2.6%      16    0.008s
+ │   ├─prove_interp_compile_correct ----   0.0%   2.8%       1    0.072s
+ │   │└rewrite ?EtaInterp.InterpExprEta    2.5%   2.5%       1    0.064s
+ │   ├─rewrite H -----------------------   2.2%   2.2%       1    0.056s
+ │   └─Reify.transitivity_tt -----------   0.0%   2.2%       2    0.032s
+ └─Glue.refine_to_reflective_glue' -----   0.0%  30.3%       1    0.780s
+   ├─Glue.zrange_to_reflective ---------   0.0%  20.3%       1    0.524s
+   │ ├─Glue.zrange_to_reflective_goal --   9.5%  15.2%       1    0.392s
+   │ │└pose proof  (pf   :   Interpretat   3.7%   3.7%       1    0.096s
+   │ └─assert (H : is_bounded_by' bounds   4.8%   5.1%       2    0.072s
+   ├─Glue.pattern_sig_sig_assoc --------   0.0%   5.4%       1    0.140s
+   │└Glue.pattern_proj1_sig_in_sig -----   1.7%   5.1%       1    0.132s
+   │└ClearbodyAll.clearbody_all --------   0.0%   2.3%       2    0.060s
+   │└clearbody (ne_var_list) -----------   2.3%   2.3%       1    0.060s
+   └─Glue.split_BoundedWordToZ ---------   0.3%   3.7%       1    0.096s
+    â””destruct_sig ----------------------   0.2%   3.3%       4    0.044s
+    â””destruct x ------------------------   2.5%   2.5%       2    0.036s
+─synthesize ----------------------------   0.0%   2.6%       1    0.068s
+
+src/Specific/X25519/C64/feadd (real: 22.81, user: 20.93, sys: 0.25, mem: 766300 ko)
+COQC src/Specific/X25519/C64/fecarry.v
+Finished transaction in 4.343 secs (4.016u,0.004s) (successful)
+total time:      3.976s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  99.0%       1    3.936s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  87.9%       1    3.496s
+─ReflectiveTactics.solve_side_conditions   0.0%  86.9%       1    3.456s
+─ReflectiveTactics.do_reify ------------   0.0%  56.9%       1    2.264s
+─Reify.Reify_rhs_gen -------------------   1.8%  56.2%       1    2.236s
+─Reify.do_reify_abs_goal ---------------  36.1%  36.5%       2    1.452s
+─Reify.do_reifyf_goal ------------------  34.8%  35.1%      29    1.396s
+─ReflectiveTactics.solve_post_reified_si   0.6%  30.0%       1    1.192s
+─UnifyAbstractReflexivity.unify_transfor  17.7%  21.7%       7    0.240s
+─Glue.refine_to_reflective_glue' -------   0.0%  11.1%       1    0.440s
+─eexact --------------------------------  10.9%  10.9%      31    0.024s
+─ReflectiveTactics.unify_abstract_cbv_in   5.2%   7.3%       1    0.292s
+─Glue.zrange_to_reflective -------------   0.0%   7.1%       1    0.284s
+─prove_interp_compile_correct ----------   0.0%   5.7%       1    0.228s
+─Glue.zrange_to_reflective_goal --------   4.3%   5.5%       1    0.220s
+─unify (constr) (constr) ---------------   5.3%   5.3%       6    0.084s
+─rewrite ?EtaInterp.InterpExprEta ------   5.2%   5.2%       1    0.208s
+─rewrite H -----------------------------   3.5%   3.5%       1    0.140s
+─tac -----------------------------------   1.9%   2.6%       2    0.104s
+─reflexivity ---------------------------   2.2%   2.2%       7    0.028s
+─Reify.transitivity_tt -----------------   0.0%   2.2%       2    0.056s
+─transitivity --------------------------   2.0%   2.0%       5    0.048s
+─Glue.split_BoundedWordToZ -------------   0.1%   2.0%       1    0.080s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  99.0%       1    3.936s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  87.9%       1    3.496s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  86.9%       1    3.456s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  56.9%       1    2.264s
+ │ │└Reify.Reify_rhs_gen ---------------   1.8%  56.2%       1    2.236s
+ │ │ ├─Reify.do_reify_abs_goal ---------  36.1%  36.5%       2    1.452s
+ │ │ │└Reify.do_reifyf_goal ------------  34.8%  35.1%      29    1.396s
+ │ │ │└eexact --------------------------  10.1%  10.1%      29    0.024s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   5.7%       1    0.228s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    5.2%   5.2%       1    0.208s
+ │ │ ├─rewrite H -----------------------   3.5%   3.5%       1    0.140s
+ │ │ ├─tac -----------------------------   1.9%   2.6%       1    0.104s
+ │ │ └─Reify.transitivity_tt -----------   0.0%   2.2%       2    0.056s
+ │ │  └transitivity --------------------   2.0%   2.0%       4    0.048s
+ │ └─ReflectiveTactics.solve_post_reifie   0.6%  30.0%       1    1.192s
+ │   ├─UnifyAbstractReflexivity.unify_tr  17.7%  21.7%       7    0.240s
+ │   │└unify (constr) (constr) ---------   3.2%   3.2%       5    0.048s
+ │   └─ReflectiveTactics.unify_abstract_   5.2%   7.3%       1    0.292s
+ │    └unify (constr) (constr) ---------   2.1%   2.1%       1    0.084s
+ └─Glue.refine_to_reflective_glue' -----   0.0%  11.1%       1    0.440s
+   ├─Glue.zrange_to_reflective ---------   0.0%   7.1%       1    0.284s
+   │└Glue.zrange_to_reflective_goal ----   4.3%   5.5%       1    0.220s
+   └─Glue.split_BoundedWordToZ ---------   0.1%   2.0%       1    0.080s
+
+Finished transaction in 7.078 secs (6.728u,0.s) (successful)
+Closed under the global context
+total time:      3.976s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  99.0%       1    3.936s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  87.9%       1    3.496s
+─ReflectiveTactics.solve_side_conditions   0.0%  86.9%       1    3.456s
+─ReflectiveTactics.do_reify ------------   0.0%  56.9%       1    2.264s
+─Reify.Reify_rhs_gen -------------------   1.8%  56.2%       1    2.236s
+─Reify.do_reify_abs_goal ---------------  36.1%  36.5%       2    1.452s
+─Reify.do_reifyf_goal ------------------  34.8%  35.1%      29    1.396s
+─ReflectiveTactics.solve_post_reified_si   0.6%  30.0%       1    1.192s
+─UnifyAbstractReflexivity.unify_transfor  17.7%  21.7%       7    0.240s
+─Glue.refine_to_reflective_glue' -------   0.0%  11.1%       1    0.440s
+─eexact --------------------------------  10.9%  10.9%      31    0.024s
+─ReflectiveTactics.unify_abstract_cbv_in   5.2%   7.3%       1    0.292s
+─Glue.zrange_to_reflective -------------   0.0%   7.1%       1    0.284s
+─prove_interp_compile_correct ----------   0.0%   5.7%       1    0.228s
+─Glue.zrange_to_reflective_goal --------   4.3%   5.5%       1    0.220s
+─unify (constr) (constr) ---------------   5.3%   5.3%       6    0.084s
+─rewrite ?EtaInterp.InterpExprEta ------   5.2%   5.2%       1    0.208s
+─rewrite H -----------------------------   3.5%   3.5%       1    0.140s
+─tac -----------------------------------   1.9%   2.6%       2    0.104s
+─reflexivity ---------------------------   2.2%   2.2%       7    0.028s
+─Reify.transitivity_tt -----------------   0.0%   2.2%       2    0.056s
+─transitivity --------------------------   2.0%   2.0%       5    0.048s
+─Glue.split_BoundedWordToZ -------------   0.1%   2.0%       1    0.080s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  99.0%       1    3.936s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  87.9%       1    3.496s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  86.9%       1    3.456s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  56.9%       1    2.264s
+ │ │└Reify.Reify_rhs_gen ---------------   1.8%  56.2%       1    2.236s
+ │ │ ├─Reify.do_reify_abs_goal ---------  36.1%  36.5%       2    1.452s
+ │ │ │└Reify.do_reifyf_goal ------------  34.8%  35.1%      29    1.396s
+ │ │ │└eexact --------------------------  10.1%  10.1%      29    0.024s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   5.7%       1    0.228s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    5.2%   5.2%       1    0.208s
+ │ │ ├─rewrite H -----------------------   3.5%   3.5%       1    0.140s
+ │ │ ├─tac -----------------------------   1.9%   2.6%       1    0.104s
+ │ │ └─Reify.transitivity_tt -----------   0.0%   2.2%       2    0.056s
+ │ │  └transitivity --------------------   2.0%   2.0%       4    0.048s
+ │ └─ReflectiveTactics.solve_post_reifie   0.6%  30.0%       1    1.192s
+ │   ├─UnifyAbstractReflexivity.unify_tr  17.7%  21.7%       7    0.240s
+ │   │└unify (constr) (constr) ---------   3.2%   3.2%       5    0.048s
+ │   └─ReflectiveTactics.unify_abstract_   5.2%   7.3%       1    0.292s
+ │    └unify (constr) (constr) ---------   2.1%   2.1%       1    0.084s
+ └─Glue.refine_to_reflective_glue' -----   0.0%  11.1%       1    0.440s
+   ├─Glue.zrange_to_reflective ---------   0.0%   7.1%       1    0.284s
+   │└Glue.zrange_to_reflective_goal ----   4.3%   5.5%       1    0.220s
+   └─Glue.split_BoundedWordToZ ---------   0.1%   2.0%       1    0.080s
+
+src/Specific/X25519/C64/fecarry (real: 27.11, user: 24.99, sys: 0.21, mem: 786052 ko)
+COQC src/Specific/solinas32_2e255m765_12limbs/Synthesis.v
+src/Specific/solinas32_2e255m765_12limbs/Synthesis (real: 40.13, user: 36.92, sys: 0.26, mem: 728464 ko)
+COQC src/Specific/solinas32_2e255m765_13limbs/Synthesis.v
+src/Specific/solinas32_2e255m765_13limbs/Synthesis (real: 49.44, user: 45.75, sys: 0.18, mem: 744240 ko)
+COQC src/Specific/X25519/C64/femul.v
+Finished transaction in 8.415 secs (7.664u,0.015s) (successful)
+total time:      7.616s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  94.8%       1    7.220s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  85.0%       1    6.476s
+─ReflectiveTactics.solve_side_conditions   0.0%  84.2%       1    6.416s
+─ReflectiveTactics.do_reify ------------   0.0%  50.3%       1    3.832s
+─Reify.Reify_rhs_gen -------------------   1.8%  49.4%       1    3.760s
+─ReflectiveTactics.solve_post_reified_si   0.5%  33.9%       1    2.584s
+─Reify.do_reify_abs_goal ---------------  31.1%  31.4%       2    2.392s
+─Reify.do_reifyf_goal ------------------  30.0%  30.3%      58    1.528s
+─UnifyAbstractReflexivity.unify_transfor  22.1%  27.3%       7    0.600s
+─Glue.refine_to_reflective_glue' -------   0.0%   9.8%       1    0.744s
+─eexact --------------------------------   8.2%   8.2%      60    0.024s
+─Glue.zrange_to_reflective -------------   0.1%   6.8%       1    0.516s
+─unify (constr) (constr) ---------------   5.9%   5.9%       6    0.124s
+─prove_interp_compile_correct ----------   0.0%   5.8%       1    0.444s
+─ReflectiveTactics.unify_abstract_cbv_in   3.9%   5.7%       1    0.432s
+─rewrite ?EtaInterp.InterpExprEta ------   5.4%   5.4%       1    0.408s
+─synthesize ----------------------------   0.0%   5.2%       1    0.396s
+─Glue.zrange_to_reflective_goal --------   3.0%   5.0%       1    0.384s
+─IntegrationTestTemporaryMiscCommon.do_r   0.1%   4.8%       1    0.364s
+─change G' -----------------------------   3.9%   3.9%       1    0.300s
+─rewrite H -----------------------------   3.0%   3.0%       1    0.232s
+─tac -----------------------------------   1.5%   2.3%       2    0.176s
+─Reify.transitivity_tt -----------------   0.0%   2.1%       2    0.092s
+─reflexivity ---------------------------   2.0%   2.0%       7    0.052s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  94.8%       1    7.220s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  85.0%       1    6.476s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  84.2%       1    6.416s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  50.3%       1    3.832s
+ │ │└Reify.Reify_rhs_gen ---------------   1.8%  49.4%       1    3.760s
+ │ │ ├─Reify.do_reify_abs_goal ---------  31.1%  31.4%       2    2.392s
+ │ │ │└Reify.do_reifyf_goal ------------  30.0%  30.3%      58    1.528s
+ │ │ │└eexact --------------------------   7.6%   7.6%      58    0.020s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   5.8%       1    0.444s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    5.4%   5.4%       1    0.408s
+ │ │ ├─rewrite H -----------------------   3.0%   3.0%       1    0.232s
+ │ │ ├─tac -----------------------------   1.5%   2.3%       1    0.176s
+ │ │ └─Reify.transitivity_tt -----------   0.0%   2.1%       2    0.092s
+ │ └─ReflectiveTactics.solve_post_reifie   0.5%  33.9%       1    2.584s
+ │   ├─UnifyAbstractReflexivity.unify_tr  22.1%  27.3%       7    0.600s
+ │   │└unify (constr) (constr) ---------   4.3%   4.3%       5    0.096s
+ │   └─ReflectiveTactics.unify_abstract_   3.9%   5.7%       1    0.432s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   9.8%       1    0.744s
+  â””Glue.zrange_to_reflective -----------   0.1%   6.8%       1    0.516s
+  â””Glue.zrange_to_reflective_goal ------   3.0%   5.0%       1    0.384s
+─synthesize ----------------------------   0.0%   5.2%       1    0.396s
+â””IntegrationTestTemporaryMiscCommon.do_r   0.1%   4.8%       1    0.364s
+â””change G' -----------------------------   3.9%   3.9%       1    0.300s
+
+Finished transaction in 14.616 secs (13.528u,0.008s) (successful)
+Closed under the global context
+total time:      7.616s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  94.8%       1    7.220s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  85.0%       1    6.476s
+─ReflectiveTactics.solve_side_conditions   0.0%  84.2%       1    6.416s
+─ReflectiveTactics.do_reify ------------   0.0%  50.3%       1    3.832s
+─Reify.Reify_rhs_gen -------------------   1.8%  49.4%       1    3.760s
+─ReflectiveTactics.solve_post_reified_si   0.5%  33.9%       1    2.584s
+─Reify.do_reify_abs_goal ---------------  31.1%  31.4%       2    2.392s
+─Reify.do_reifyf_goal ------------------  30.0%  30.3%      58    1.528s
+─UnifyAbstractReflexivity.unify_transfor  22.1%  27.3%       7    0.600s
+─Glue.refine_to_reflective_glue' -------   0.0%   9.8%       1    0.744s
+─eexact --------------------------------   8.2%   8.2%      60    0.024s
+─Glue.zrange_to_reflective -------------   0.1%   6.8%       1    0.516s
+─unify (constr) (constr) ---------------   5.9%   5.9%       6    0.124s
+─prove_interp_compile_correct ----------   0.0%   5.8%       1    0.444s
+─ReflectiveTactics.unify_abstract_cbv_in   3.9%   5.7%       1    0.432s
+─rewrite ?EtaInterp.InterpExprEta ------   5.4%   5.4%       1    0.408s
+─synthesize ----------------------------   0.0%   5.2%       1    0.396s
+─Glue.zrange_to_reflective_goal --------   3.0%   5.0%       1    0.384s
+─IntegrationTestTemporaryMiscCommon.do_r   0.1%   4.8%       1    0.364s
+─change G' -----------------------------   3.9%   3.9%       1    0.300s
+─rewrite H -----------------------------   3.0%   3.0%       1    0.232s
+─tac -----------------------------------   1.5%   2.3%       2    0.176s
+─Reify.transitivity_tt -----------------   0.0%   2.1%       2    0.092s
+─reflexivity ---------------------------   2.0%   2.0%       7    0.052s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  94.8%       1    7.220s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  85.0%       1    6.476s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  84.2%       1    6.416s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  50.3%       1    3.832s
+ │ │└Reify.Reify_rhs_gen ---------------   1.8%  49.4%       1    3.760s
+ │ │ ├─Reify.do_reify_abs_goal ---------  31.1%  31.4%       2    2.392s
+ │ │ │└Reify.do_reifyf_goal ------------  30.0%  30.3%      58    1.528s
+ │ │ │└eexact --------------------------   7.6%   7.6%      58    0.020s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   5.8%       1    0.444s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    5.4%   5.4%       1    0.408s
+ │ │ ├─rewrite H -----------------------   3.0%   3.0%       1    0.232s
+ │ │ ├─tac -----------------------------   1.5%   2.3%       1    0.176s
+ │ │ └─Reify.transitivity_tt -----------   0.0%   2.1%       2    0.092s
+ │ └─ReflectiveTactics.solve_post_reifie   0.5%  33.9%       1    2.584s
+ │   ├─UnifyAbstractReflexivity.unify_tr  22.1%  27.3%       7    0.600s
+ │   │└unify (constr) (constr) ---------   4.3%   4.3%       5    0.096s
+ │   └─ReflectiveTactics.unify_abstract_   3.9%   5.7%       1    0.432s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   9.8%       1    0.744s
+  â””Glue.zrange_to_reflective -----------   0.1%   6.8%       1    0.516s
+  â””Glue.zrange_to_reflective_goal ------   3.0%   5.0%       1    0.384s
+─synthesize ----------------------------   0.0%   5.2%       1    0.396s
+â””IntegrationTestTemporaryMiscCommon.do_r   0.1%   4.8%       1    0.364s
+â””change G' -----------------------------   3.9%   3.9%       1    0.300s
+
+src/Specific/X25519/C64/femul (real: 39.72, user: 36.32, sys: 0.26, mem: 825448 ko)
+COQC src/Specific/X25519/C64/feaddDisplay > src/Specific/X25519/C64/feaddDisplay.log
+COQC src/Specific/X25519/C64/fecarryDisplay > src/Specific/X25519/C64/fecarryDisplay.log
+COQC src/Specific/X25519/C64/fesub.v
+Finished transaction in 3.513 secs (3.211u,0.s) (successful)
+total time:      3.164s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.6%       1    3.088s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  74.1%       1    2.344s
+─ReflectiveTactics.solve_side_conditions   0.0%  72.9%       1    2.308s
+─ReflectiveTactics.do_reify ------------   0.0%  38.6%       1    1.220s
+─Reify.Reify_rhs_gen -------------------   1.5%  37.2%       1    1.176s
+─ReflectiveTactics.solve_post_reified_si   0.9%  34.4%       1    1.088s
+─UnifyAbstractReflexivity.unify_transfor  19.2%  23.9%       7    0.204s
+─Glue.refine_to_reflective_glue' -------   0.0%  23.5%       1    0.744s
+─Reify.do_reify_abs_goal ---------------  19.2%  19.5%       2    0.616s
+─Reify.do_reifyf_goal ------------------  18.0%  18.3%      16    0.580s
+─Glue.zrange_to_reflective -------------   0.1%  15.4%       1    0.488s
+─Glue.zrange_to_reflective_goal --------   6.8%  11.5%       1    0.364s
+─ReflectiveTactics.unify_abstract_cbv_in   6.2%   9.0%       1    0.284s
+─unify (constr) (constr) ---------------   5.9%   5.9%       6    0.080s
+─Glue.pattern_sig_sig_assoc ------------   0.0%   4.6%       1    0.144s
+─eexact --------------------------------   4.4%   4.4%      18    0.012s
+─Glue.pattern_proj1_sig_in_sig ---------   1.4%   4.3%       1    0.136s
+─prove_interp_compile_correct ----------   0.0%   3.9%       1    0.124s
+─rewrite H -----------------------------   3.8%   3.8%       1    0.120s
+─assert (H : is_bounded_by' bounds (map'   3.8%   3.8%       2    0.064s
+─rewrite ?EtaInterp.InterpExprEta ------   3.5%   3.5%       1    0.112s
+─pose proof  (pf   :   Interpretation.Bo   2.9%   2.9%       1    0.092s
+─Glue.split_BoundedWordToZ -------------   0.1%   2.8%       1    0.088s
+─tac -----------------------------------   1.9%   2.5%       2    0.080s
+─reflexivity ---------------------------   2.4%   2.4%       7    0.028s
+─synthesize ----------------------------   0.0%   2.4%       1    0.076s
+─destruct_sig --------------------------   0.0%   2.4%       4    0.040s
+─destruct x ----------------------------   2.4%   2.4%       4    0.032s
+─clearbody (ne_var_list) ---------------   2.3%   2.3%       4    0.060s
+─Reify.transitivity_tt -----------------   0.1%   2.3%       2    0.036s
+─transitivity --------------------------   2.1%   2.1%       5    0.032s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.6%       1    3.088s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  74.1%       1    2.344s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  72.9%       1    2.308s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  38.6%       1    1.220s
+ │ │└Reify.Reify_rhs_gen ---------------   1.5%  37.2%       1    1.176s
+ │ │ ├─Reify.do_reify_abs_goal ---------  19.2%  19.5%       2    0.616s
+ │ │ │└Reify.do_reifyf_goal ------------  18.0%  18.3%      16    0.580s
+ │ │ │└eexact --------------------------   3.9%   3.9%      16    0.012s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   3.9%       1    0.124s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    3.5%   3.5%       1    0.112s
+ │ │ ├─rewrite H -----------------------   3.8%   3.8%       1    0.120s
+ │ │ ├─tac -----------------------------   1.9%   2.5%       1    0.080s
+ │ │ └─Reify.transitivity_tt -----------   0.1%   2.3%       2    0.036s
+ │ │  └transitivity --------------------   2.0%   2.0%       4    0.032s
+ │ └─ReflectiveTactics.solve_post_reifie   0.9%  34.4%       1    1.088s
+ │   ├─UnifyAbstractReflexivity.unify_tr  19.2%  23.9%       7    0.204s
+ │   │└unify (constr) (constr) ---------   3.4%   3.4%       5    0.036s
+ │   └─ReflectiveTactics.unify_abstract_   6.2%   9.0%       1    0.284s
+ │    └unify (constr) (constr) ---------   2.5%   2.5%       1    0.080s
+ └─Glue.refine_to_reflective_glue' -----   0.0%  23.5%       1    0.744s
+   ├─Glue.zrange_to_reflective ---------   0.1%  15.4%       1    0.488s
+   │ ├─Glue.zrange_to_reflective_goal --   6.8%  11.5%       1    0.364s
+   │ │└pose proof  (pf   :   Interpretat   2.9%   2.9%       1    0.092s
+   │ └─assert (H : is_bounded_by' bounds   3.8%   3.8%       2    0.064s
+   ├─Glue.pattern_sig_sig_assoc --------   0.0%   4.6%       1    0.144s
+   │└Glue.pattern_proj1_sig_in_sig -----   1.4%   4.3%       1    0.136s
+   └─Glue.split_BoundedWordToZ ---------   0.1%   2.8%       1    0.088s
+    â””destruct_sig ----------------------   0.0%   2.4%       4    0.040s
+─synthesize ----------------------------   0.0%   2.4%       1    0.076s
+
+Finished transaction in 6.12 secs (5.64u,0.008s) (successful)
+Closed under the global context
+total time:      3.164s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.6%       1    3.088s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  74.1%       1    2.344s
+─ReflectiveTactics.solve_side_conditions   0.0%  72.9%       1    2.308s
+─ReflectiveTactics.do_reify ------------   0.0%  38.6%       1    1.220s
+─Reify.Reify_rhs_gen -------------------   1.5%  37.2%       1    1.176s
+─ReflectiveTactics.solve_post_reified_si   0.9%  34.4%       1    1.088s
+─UnifyAbstractReflexivity.unify_transfor  19.2%  23.9%       7    0.204s
+─Glue.refine_to_reflective_glue' -------   0.0%  23.5%       1    0.744s
+─Reify.do_reify_abs_goal ---------------  19.2%  19.5%       2    0.616s
+─Reify.do_reifyf_goal ------------------  18.0%  18.3%      16    0.580s
+─Glue.zrange_to_reflective -------------   0.1%  15.4%       1    0.488s
+─Glue.zrange_to_reflective_goal --------   6.8%  11.5%       1    0.364s
+─ReflectiveTactics.unify_abstract_cbv_in   6.2%   9.0%       1    0.284s
+─unify (constr) (constr) ---------------   5.9%   5.9%       6    0.080s
+─Glue.pattern_sig_sig_assoc ------------   0.0%   4.6%       1    0.144s
+─eexact --------------------------------   4.4%   4.4%      18    0.012s
+─Glue.pattern_proj1_sig_in_sig ---------   1.4%   4.3%       1    0.136s
+─prove_interp_compile_correct ----------   0.0%   3.9%       1    0.124s
+─rewrite H -----------------------------   3.8%   3.8%       1    0.120s
+─assert (H : is_bounded_by' bounds (map'   3.8%   3.8%       2    0.064s
+─rewrite ?EtaInterp.InterpExprEta ------   3.5%   3.5%       1    0.112s
+─pose proof  (pf   :   Interpretation.Bo   2.9%   2.9%       1    0.092s
+─Glue.split_BoundedWordToZ -------------   0.1%   2.8%       1    0.088s
+─tac -----------------------------------   1.9%   2.5%       2    0.080s
+─reflexivity ---------------------------   2.4%   2.4%       7    0.028s
+─synthesize ----------------------------   0.0%   2.4%       1    0.076s
+─destruct_sig --------------------------   0.0%   2.4%       4    0.040s
+─destruct x ----------------------------   2.4%   2.4%       4    0.032s
+─clearbody (ne_var_list) ---------------   2.3%   2.3%       4    0.060s
+─Reify.transitivity_tt -----------------   0.1%   2.3%       2    0.036s
+─transitivity --------------------------   2.1%   2.1%       5    0.032s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.6%       1    3.088s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  74.1%       1    2.344s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  72.9%       1    2.308s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  38.6%       1    1.220s
+ │ │└Reify.Reify_rhs_gen ---------------   1.5%  37.2%       1    1.176s
+ │ │ ├─Reify.do_reify_abs_goal ---------  19.2%  19.5%       2    0.616s
+ │ │ │└Reify.do_reifyf_goal ------------  18.0%  18.3%      16    0.580s
+ │ │ │└eexact --------------------------   3.9%   3.9%      16    0.012s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   3.9%       1    0.124s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    3.5%   3.5%       1    0.112s
+ │ │ ├─rewrite H -----------------------   3.8%   3.8%       1    0.120s
+ │ │ ├─tac -----------------------------   1.9%   2.5%       1    0.080s
+ │ │ └─Reify.transitivity_tt -----------   0.1%   2.3%       2    0.036s
+ │ │  └transitivity --------------------   2.0%   2.0%       4    0.032s
+ │ └─ReflectiveTactics.solve_post_reifie   0.9%  34.4%       1    1.088s
+ │   ├─UnifyAbstractReflexivity.unify_tr  19.2%  23.9%       7    0.204s
+ │   │└unify (constr) (constr) ---------   3.4%   3.4%       5    0.036s
+ │   └─ReflectiveTactics.unify_abstract_   6.2%   9.0%       1    0.284s
+ │    └unify (constr) (constr) ---------   2.5%   2.5%       1    0.080s
+ └─Glue.refine_to_reflective_glue' -----   0.0%  23.5%       1    0.744s
+   ├─Glue.zrange_to_reflective ---------   0.1%  15.4%       1    0.488s
+   │ ├─Glue.zrange_to_reflective_goal --   6.8%  11.5%       1    0.364s
+   │ │└pose proof  (pf   :   Interpretat   2.9%   2.9%       1    0.092s
+   │ └─assert (H : is_bounded_by' bounds   3.8%   3.8%       2    0.064s
+   ├─Glue.pattern_sig_sig_assoc --------   0.0%   4.6%       1    0.144s
+   │└Glue.pattern_proj1_sig_in_sig -----   1.4%   4.3%       1    0.136s
+   └─Glue.split_BoundedWordToZ ---------   0.1%   2.8%       1    0.088s
+    â””destruct_sig ----------------------   0.0%   2.4%       4    0.040s
+─synthesize ----------------------------   0.0%   2.4%       1    0.076s
+
+src/Specific/X25519/C64/fesub (real: 24.71, user: 22.65, sys: 0.24, mem: 778792 ko)
+COQC src/Specific/X25519/C64/fesquare.v
+Finished transaction in 6.132 secs (5.516u,0.012s) (successful)
+total time:      5.480s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize ----------------------------  -0.0% 100.0%       1    5.480s
+─Pipeline.refine_reflectively_gen ------   0.0%  95.7%       1    5.244s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  88.6%       1    4.856s
+─ReflectiveTactics.solve_side_conditions   0.0%  87.7%       1    4.804s
+─ReflectiveTactics.do_reify ------------   0.0%  53.3%       1    2.920s
+─Reify.Reify_rhs_gen -------------------   2.0%  52.5%       1    2.876s
+─ReflectiveTactics.solve_post_reified_si   0.6%  34.4%       1    1.884s
+─Reify.do_reify_abs_goal ---------------  33.2%  33.6%       2    1.844s
+─Reify.do_reifyf_goal ------------------  31.5%  32.0%      47    1.392s
+─UnifyAbstractReflexivity.unify_transfor  21.9%  26.6%       7    0.400s
+─eexact --------------------------------  10.0%  10.0%      49    0.028s
+─Glue.refine_to_reflective_glue' -------   0.0%   7.1%       1    0.388s
+─ReflectiveTactics.unify_abstract_cbv_in   5.0%   6.9%       1    0.380s
+─unify (constr) (constr) ---------------   5.8%   5.8%       6    0.104s
+─prove_interp_compile_correct ----------   0.0%   5.8%       1    0.316s
+─rewrite ?EtaInterp.InterpExprEta ------   5.3%   5.3%       1    0.288s
+─Glue.zrange_to_reflective -------------   0.1%   5.1%       1    0.280s
+─IntegrationTestTemporaryMiscCommon.do_r   0.1%   4.0%       1    0.220s
+─Glue.zrange_to_reflective_goal --------   3.1%   3.9%       1    0.212s
+─change G' -----------------------------   3.4%   3.4%       1    0.184s
+─tac -----------------------------------   2.0%   2.8%       2    0.156s
+─rewrite H -----------------------------   2.8%   2.8%       1    0.156s
+─reflexivity ---------------------------   2.8%   2.8%       7    0.064s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize ----------------------------  -0.0% 100.0%       1    5.480s
+ ├─Pipeline.refine_reflectively_gen ----   0.0%  95.7%       1    5.244s
+ │ ├─ReflectiveTactics.do_reflective_pip   0.0%  88.6%       1    4.856s
+ │ │└ReflectiveTactics.solve_side_condit   0.0%  87.7%       1    4.804s
+ │ │ ├─ReflectiveTactics.do_reify ------   0.0%  53.3%       1    2.920s
+ │ │ │└Reify.Reify_rhs_gen -------------   2.0%  52.5%       1    2.876s
+ │ │ │ ├─Reify.do_reify_abs_goal -------  33.2%  33.6%       2    1.844s
+ │ │ │ │└Reify.do_reifyf_goal ----------  31.5%  32.0%      47    1.392s
+ │ │ │ │└eexact ------------------------   9.1%   9.1%      47    0.024s
+ │ │ │ ├─prove_interp_compile_correct --   0.0%   5.8%       1    0.316s
+ │ │ │ │└rewrite ?EtaInterp.InterpExprEt   5.3%   5.3%       1    0.288s
+ │ │ │ ├─tac ---------------------------   2.0%   2.8%       1    0.156s
+ │ │ │ └─rewrite H ---------------------   2.8%   2.8%       1    0.156s
+ │ │ └─ReflectiveTactics.solve_post_reif   0.6%  34.4%       1    1.884s
+ │ │   ├─UnifyAbstractReflexivity.unify_  21.9%  26.6%       7    0.400s
+ │ │   │└unify (constr) (constr) -------   3.9%   3.9%       5    0.072s
+ │ │   └─ReflectiveTactics.unify_abstrac   5.0%   6.9%       1    0.380s
+ │ └─Glue.refine_to_reflective_glue' ---   0.0%   7.1%       1    0.388s
+ │  └Glue.zrange_to_reflective ---------   0.1%   5.1%       1    0.280s
+ │  └Glue.zrange_to_reflective_goal ----   3.1%   3.9%       1    0.212s
+ └─IntegrationTestTemporaryMiscCommon.do   0.1%   4.0%       1    0.220s
+  â””change G' ---------------------------   3.4%   3.4%       1    0.184s
+
+Finished transaction in 10.475 secs (9.728u,0.007s) (successful)
+Closed under the global context
+total time:      5.480s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize ----------------------------  -0.0% 100.0%       1    5.480s
+─Pipeline.refine_reflectively_gen ------   0.0%  95.7%       1    5.244s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  88.6%       1    4.856s
+─ReflectiveTactics.solve_side_conditions   0.0%  87.7%       1    4.804s
+─ReflectiveTactics.do_reify ------------   0.0%  53.3%       1    2.920s
+─Reify.Reify_rhs_gen -------------------   2.0%  52.5%       1    2.876s
+─ReflectiveTactics.solve_post_reified_si   0.6%  34.4%       1    1.884s
+─Reify.do_reify_abs_goal ---------------  33.2%  33.6%       2    1.844s
+─Reify.do_reifyf_goal ------------------  31.5%  32.0%      47    1.392s
+─UnifyAbstractReflexivity.unify_transfor  21.9%  26.6%       7    0.400s
+─eexact --------------------------------  10.0%  10.0%      49    0.028s
+─Glue.refine_to_reflective_glue' -------   0.0%   7.1%       1    0.388s
+─ReflectiveTactics.unify_abstract_cbv_in   5.0%   6.9%       1    0.380s
+─unify (constr) (constr) ---------------   5.8%   5.8%       6    0.104s
+─prove_interp_compile_correct ----------   0.0%   5.8%       1    0.316s
+─rewrite ?EtaInterp.InterpExprEta ------   5.3%   5.3%       1    0.288s
+─Glue.zrange_to_reflective -------------   0.1%   5.1%       1    0.280s
+─IntegrationTestTemporaryMiscCommon.do_r   0.1%   4.0%       1    0.220s
+─Glue.zrange_to_reflective_goal --------   3.1%   3.9%       1    0.212s
+─change G' -----------------------------   3.4%   3.4%       1    0.184s
+─tac -----------------------------------   2.0%   2.8%       2    0.156s
+─rewrite H -----------------------------   2.8%   2.8%       1    0.156s
+─reflexivity ---------------------------   2.8%   2.8%       7    0.064s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize ----------------------------  -0.0% 100.0%       1    5.480s
+ ├─Pipeline.refine_reflectively_gen ----   0.0%  95.7%       1    5.244s
+ │ ├─ReflectiveTactics.do_reflective_pip   0.0%  88.6%       1    4.856s
+ │ │└ReflectiveTactics.solve_side_condit   0.0%  87.7%       1    4.804s
+ │ │ ├─ReflectiveTactics.do_reify ------   0.0%  53.3%       1    2.920s
+ │ │ │└Reify.Reify_rhs_gen -------------   2.0%  52.5%       1    2.876s
+ │ │ │ ├─Reify.do_reify_abs_goal -------  33.2%  33.6%       2    1.844s
+ │ │ │ │└Reify.do_reifyf_goal ----------  31.5%  32.0%      47    1.392s
+ │ │ │ │└eexact ------------------------   9.1%   9.1%      47    0.024s
+ │ │ │ ├─prove_interp_compile_correct --   0.0%   5.8%       1    0.316s
+ │ │ │ │└rewrite ?EtaInterp.InterpExprEt   5.3%   5.3%       1    0.288s
+ │ │ │ ├─tac ---------------------------   2.0%   2.8%       1    0.156s
+ │ │ │ └─rewrite H ---------------------   2.8%   2.8%       1    0.156s
+ │ │ └─ReflectiveTactics.solve_post_reif   0.6%  34.4%       1    1.884s
+ │ │   ├─UnifyAbstractReflexivity.unify_  21.9%  26.6%       7    0.400s
+ │ │   │└unify (constr) (constr) -------   3.9%   3.9%       5    0.072s
+ │ │   └─ReflectiveTactics.unify_abstrac   5.0%   6.9%       1    0.380s
+ │ └─Glue.refine_to_reflective_glue' ---   0.0%   7.1%       1    0.388s
+ │  └Glue.zrange_to_reflective ---------   0.1%   5.1%       1    0.280s
+ │  └Glue.zrange_to_reflective_goal ----   3.1%   3.9%       1    0.212s
+ └─IntegrationTestTemporaryMiscCommon.do   0.1%   4.0%       1    0.220s
+  â””change G' ---------------------------   3.4%   3.4%       1    0.184s
+
+src/Specific/X25519/C64/fesquare (real: 33.08, user: 30.13, sys: 0.24, mem: 799620 ko)
+COQC src/Specific/X25519/C64/femulDisplay > src/Specific/X25519/C64/femulDisplay.log
+COQC src/Specific/X25519/C64/freeze.v
+Finished transaction in 7.307 secs (6.763u,0.011s) (successful)
+total time:      6.732s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_freeze ---------------------   0.0% 100.0%       1    6.732s
+─Pipeline.refine_reflectively_gen ------   0.0%  99.3%       1    6.684s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  92.8%       1    6.248s
+─ReflectiveTactics.solve_side_conditions   0.0%  92.0%       1    6.192s
+─ReflectiveTactics.do_reify ------------  -0.0%  60.3%       1    4.060s
+─Reify.Reify_rhs_gen -------------------   1.5%  59.6%       1    4.012s
+─Reify.do_reify_abs_goal ---------------  42.4%  42.7%       2    2.876s
+─Reify.do_reifyf_goal ------------------  41.3%  41.7%     129    2.804s
+─ReflectiveTactics.solve_post_reified_si   0.6%  31.7%       1    2.132s
+─UnifyAbstractReflexivity.unify_transfor  21.7%  25.8%       7    0.424s
+─eexact --------------------------------  13.7%  13.7%     131    0.036s
+─Glue.refine_to_reflective_glue' -------   0.0%   6.5%       1    0.436s
+─prove_interp_compile_correct ----------   0.0%   5.1%       1    0.344s
+─ReflectiveTactics.unify_abstract_cbv_in   3.4%   5.0%       1    0.336s
+─rewrite ?EtaInterp.InterpExprEta ------   4.7%   4.7%       1    0.316s
+─unify (constr) (constr) ---------------   4.6%   4.6%       6    0.100s
+─Glue.zrange_to_reflective -------------   0.0%   4.2%       1    0.280s
+─Glue.zrange_to_reflective_goal --------   2.4%   3.3%       1    0.220s
+─Reify.transitivity_tt -----------------   0.1%   2.6%       2    0.116s
+─rewrite H -----------------------------   2.6%   2.6%       1    0.172s
+─tac -----------------------------------   1.5%   2.3%       2    0.156s
+─reflexivity ---------------------------   2.3%   2.3%       7    0.052s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_freeze ---------------------   0.0% 100.0%       1    6.732s
+â””Pipeline.refine_reflectively_gen ------   0.0%  99.3%       1    6.684s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  92.8%       1    6.248s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  92.0%       1    6.192s
+ │ ├─ReflectiveTactics.do_reify --------  -0.0%  60.3%       1    4.060s
+ │ │└Reify.Reify_rhs_gen ---------------   1.5%  59.6%       1    4.012s
+ │ │ ├─Reify.do_reify_abs_goal ---------  42.4%  42.7%       2    2.876s
+ │ │ │└Reify.do_reifyf_goal ------------  41.3%  41.7%     129    2.804s
+ │ │ │└eexact --------------------------  13.0%  13.0%     129    0.036s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   5.1%       1    0.344s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    4.7%   4.7%       1    0.316s
+ │ │ ├─Reify.transitivity_tt -----------   0.1%   2.6%       2    0.116s
+ │ │ ├─rewrite H -----------------------   2.6%   2.6%       1    0.172s
+ │ │ └─tac -----------------------------   1.5%   2.3%       1    0.156s
+ │ └─ReflectiveTactics.solve_post_reifie   0.6%  31.7%       1    2.132s
+ │   ├─UnifyAbstractReflexivity.unify_tr  21.7%  25.8%       7    0.424s
+ │   │└unify (constr) (constr) ---------   3.1%   3.1%       5    0.084s
+ │   └─ReflectiveTactics.unify_abstract_   3.4%   5.0%       1    0.336s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   6.5%       1    0.436s
+  â””Glue.zrange_to_reflective -----------   0.0%   4.2%       1    0.280s
+  â””Glue.zrange_to_reflective_goal ------   2.4%   3.3%       1    0.220s
+
+Finished transaction in 10.495 secs (9.756u,0.s) (successful)
+Closed under the global context
+total time:      6.732s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_freeze ---------------------   0.0% 100.0%       1    6.732s
+─Pipeline.refine_reflectively_gen ------   0.0%  99.3%       1    6.684s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  92.8%       1    6.248s
+─ReflectiveTactics.solve_side_conditions   0.0%  92.0%       1    6.192s
+─ReflectiveTactics.do_reify ------------  -0.0%  60.3%       1    4.060s
+─Reify.Reify_rhs_gen -------------------   1.5%  59.6%       1    4.012s
+─Reify.do_reify_abs_goal ---------------  42.4%  42.7%       2    2.876s
+─Reify.do_reifyf_goal ------------------  41.3%  41.7%     129    2.804s
+─ReflectiveTactics.solve_post_reified_si   0.6%  31.7%       1    2.132s
+─UnifyAbstractReflexivity.unify_transfor  21.7%  25.8%       7    0.424s
+─eexact --------------------------------  13.7%  13.7%     131    0.036s
+─Glue.refine_to_reflective_glue' -------   0.0%   6.5%       1    0.436s
+─prove_interp_compile_correct ----------   0.0%   5.1%       1    0.344s
+─ReflectiveTactics.unify_abstract_cbv_in   3.4%   5.0%       1    0.336s
+─rewrite ?EtaInterp.InterpExprEta ------   4.7%   4.7%       1    0.316s
+─unify (constr) (constr) ---------------   4.6%   4.6%       6    0.100s
+─Glue.zrange_to_reflective -------------   0.0%   4.2%       1    0.280s
+─Glue.zrange_to_reflective_goal --------   2.4%   3.3%       1    0.220s
+─Reify.transitivity_tt -----------------   0.1%   2.6%       2    0.116s
+─rewrite H -----------------------------   2.6%   2.6%       1    0.172s
+─tac -----------------------------------   1.5%   2.3%       2    0.156s
+─reflexivity ---------------------------   2.3%   2.3%       7    0.052s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_freeze ---------------------   0.0% 100.0%       1    6.732s
+â””Pipeline.refine_reflectively_gen ------   0.0%  99.3%       1    6.684s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  92.8%       1    6.248s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  92.0%       1    6.192s
+ │ ├─ReflectiveTactics.do_reify --------  -0.0%  60.3%       1    4.060s
+ │ │└Reify.Reify_rhs_gen ---------------   1.5%  59.6%       1    4.012s
+ │ │ ├─Reify.do_reify_abs_goal ---------  42.4%  42.7%       2    2.876s
+ │ │ │└Reify.do_reifyf_goal ------------  41.3%  41.7%     129    2.804s
+ │ │ │└eexact --------------------------  13.0%  13.0%     129    0.036s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   5.1%       1    0.344s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    4.7%   4.7%       1    0.316s
+ │ │ ├─Reify.transitivity_tt -----------   0.1%   2.6%       2    0.116s
+ │ │ ├─rewrite H -----------------------   2.6%   2.6%       1    0.172s
+ │ │ └─tac -----------------------------   1.5%   2.3%       1    0.156s
+ │ └─ReflectiveTactics.solve_post_reifie   0.6%  31.7%       1    2.132s
+ │   ├─UnifyAbstractReflexivity.unify_tr  21.7%  25.8%       7    0.424s
+ │   │└unify (constr) (constr) ---------   3.1%   3.1%       5    0.084s
+ │   └─ReflectiveTactics.unify_abstract_   3.4%   5.0%       1    0.336s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   6.5%       1    0.436s
+  â””Glue.zrange_to_reflective -----------   0.0%   4.2%       1    0.280s
+  â””Glue.zrange_to_reflective_goal ------   2.4%   3.3%       1    0.220s
+
+src/Specific/X25519/C64/freeze (real: 34.35, user: 31.50, sys: 0.24, mem: 828104 ko)
+COQC src/Specific/NISTP256/AMD64/feadd.v
+Finished transaction in 8.784 secs (8.176u,0.011s) (successful)
+total time:      8.140s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  52.4%       1    4.268s
+─synthesize_montgomery -----------------   0.0%  47.6%       1    3.872s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  43.8%       1    3.568s
+─ReflectiveTactics.solve_side_conditions   0.0%  43.2%       1    3.520s
+─IntegrationTestTemporaryMiscCommon.fact   1.4%  23.6%       1    1.924s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  22.1%       1    1.796s
+─ReflectiveTactics.do_reify ------------   0.1%  21.7%       1    1.768s
+─ReflectiveTactics.solve_post_reified_si   0.6%  21.5%       1    1.752s
+─Reify.Reify_rhs_gen -------------------   1.0%  20.9%       1    1.704s
+─op_sig_side_conditions_t --------------   0.0%  20.0%       1    1.624s
+─DestructHyps.do_all_matches_then ------   0.0%  20.0%       8    0.244s
+─DestructHyps.do_one_match_then --------   0.7%  19.9%      44    0.052s
+─do_tac --------------------------------   0.0%  19.2%      36    0.052s
+─destruct H ----------------------------  19.2%  19.2%      36    0.052s
+─rewrite <- (lem : lemT) by by_tac ltac:   0.2%  17.3%       1    1.408s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  17.3%       1    1.408s
+─by_tac --------------------------------   0.0%  17.1%       4    0.504s
+─rewrite <- (ZRange.is_bounded_by_None_r  16.7%  16.7%       8    0.344s
+─UnifyAbstractReflexivity.unify_transfor  13.3%  16.1%       7    0.360s
+─Reify.do_reify_abs_goal ---------------   9.9%  10.1%       2    0.820s
+─Reify.do_reifyf_goal ------------------   9.1%   9.3%      93    0.748s
+─Glue.refine_to_reflective_glue' -------   0.0%   8.6%       1    0.700s
+─Glue.zrange_to_reflective -------------   0.0%   5.3%       1    0.432s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   4.8%       1    0.388s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.9%   4.6%       3    0.368s
+─ReflectiveTactics.unify_abstract_cbv_in   3.3%   4.5%       1    0.368s
+─Glue.zrange_to_reflective_goal --------   2.6%   4.0%       1    0.324s
+─k -------------------------------------   3.5%   3.6%       1    0.296s
+─unify (constr) (constr) ---------------   3.3%   3.3%       8    0.092s
+─rewrite H -----------------------------   2.6%   2.6%       2    0.196s
+─eexact --------------------------------   2.6%   2.6%      95    0.024s
+─prove_interp_compile_correct ----------   0.0%   2.5%       1    0.204s
+─apply  (fun f =>   MapProjections.proj2   2.4%   2.4%       2    0.120s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  52.4%       1    4.268s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  43.8%       1    3.568s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  43.2%       1    3.520s
+ │ ├─ReflectiveTactics.do_reify --------   0.1%  21.7%       1    1.768s
+ │ │└Reify.Reify_rhs_gen ---------------   1.0%  20.9%       1    1.704s
+ │ │ ├─Reify.do_reify_abs_goal ---------   9.9%  10.1%       2    0.820s
+ │ │ │└Reify.do_reifyf_goal ------------   9.1%   9.3%      93    0.748s
+ │ │ │└eexact --------------------------   2.3%   2.3%      93    0.024s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   2.5%       1    0.204s
+ │ │ └─rewrite H -----------------------   2.4%   2.4%       1    0.196s
+ │ └─ReflectiveTactics.solve_post_reifie   0.6%  21.5%       1    1.752s
+ │   ├─UnifyAbstractReflexivity.unify_tr  13.3%  16.1%       7    0.360s
+ │   │└unify (constr) (constr) ---------   2.2%   2.2%       5    0.064s
+ │   └─ReflectiveTactics.unify_abstract_   3.3%   4.5%       1    0.368s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   8.6%       1    0.700s
+  â””Glue.zrange_to_reflective -----------   0.0%   5.3%       1    0.432s
+  â””Glue.zrange_to_reflective_goal ------   2.6%   4.0%       1    0.324s
+─synthesize_montgomery -----------------   0.0%  47.6%       1    3.872s
+ ├─IntegrationTestTemporaryMiscCommon.fa   1.4%  23.6%       1    1.924s
+ │└op_sig_side_conditions_t ------------   0.0%  20.0%       1    1.624s
+ │ ├─DestructHyps.do_all_matches_then --   0.0%  11.4%       4    0.244s
+ │ │└DestructHyps.do_one_match_then ----   0.3%  11.4%      24    0.052s
+ │ │└do_tac ----------------------------   0.0%  11.1%      20    0.052s
+ │ │└destruct H ------------------------  11.1%  11.1%      20    0.052s
+ │ └─rewrite <- (ZRange.is_bounded_by_No   8.4%   8.4%       4    0.328s
+ └─IntegrationTestTemporaryMiscCommon.do   0.0%  22.1%       1    1.796s
+   ├─IntegrationTestTemporaryMiscCommon.   0.0%  17.3%       1    1.408s
+   │└rewrite <- (lem : lemT) by by_tac l   0.2%  17.3%       1    1.408s
+   │└by_tac ----------------------------   0.0%  17.1%       4    0.504s
+   │ ├─DestructHyps.do_all_matches_then    0.0%   8.6%       4    0.184s
+   │ │└DestructHyps.do_one_match_then --   0.3%   8.5%      20    0.052s
+   │ │└do_tac --------------------------   0.0%   8.2%      16    0.052s
+   │ │└destruct H ----------------------   8.2%   8.2%      16    0.052s
+   │ └─rewrite <- (ZRange.is_bounded_by_   8.3%   8.3%       4    0.344s
+   └─IntegrationTestTemporaryMiscCommon.   0.0%   4.8%       1    0.388s
+    â””<Crypto.Util.Tactics.MoveLetIn.with   0.9%   4.6%       3    0.368s
+    â””k ---------------------------------   3.5%   3.6%       1    0.296s
+
+Finished transaction in 13.363 secs (12.516u,0.008s) (successful)
+Closed under the global context
+total time:      8.140s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  52.4%       1    4.268s
+─synthesize_montgomery -----------------   0.0%  47.6%       1    3.872s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  43.8%       1    3.568s
+─ReflectiveTactics.solve_side_conditions   0.0%  43.2%       1    3.520s
+─IntegrationTestTemporaryMiscCommon.fact   1.4%  23.6%       1    1.924s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  22.1%       1    1.796s
+─ReflectiveTactics.do_reify ------------   0.1%  21.7%       1    1.768s
+─ReflectiveTactics.solve_post_reified_si   0.6%  21.5%       1    1.752s
+─Reify.Reify_rhs_gen -------------------   1.0%  20.9%       1    1.704s
+─op_sig_side_conditions_t --------------   0.0%  20.0%       1    1.624s
+─DestructHyps.do_all_matches_then ------   0.0%  20.0%       8    0.244s
+─DestructHyps.do_one_match_then --------   0.7%  19.9%      44    0.052s
+─do_tac --------------------------------   0.0%  19.2%      36    0.052s
+─destruct H ----------------------------  19.2%  19.2%      36    0.052s
+─rewrite <- (lem : lemT) by by_tac ltac:   0.2%  17.3%       1    1.408s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  17.3%       1    1.408s
+─by_tac --------------------------------   0.0%  17.1%       4    0.504s
+─rewrite <- (ZRange.is_bounded_by_None_r  16.7%  16.7%       8    0.344s
+─UnifyAbstractReflexivity.unify_transfor  13.3%  16.1%       7    0.360s
+─Reify.do_reify_abs_goal ---------------   9.9%  10.1%       2    0.820s
+─Reify.do_reifyf_goal ------------------   9.1%   9.3%      93    0.748s
+─Glue.refine_to_reflective_glue' -------   0.0%   8.6%       1    0.700s
+─Glue.zrange_to_reflective -------------   0.0%   5.3%       1    0.432s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   4.8%       1    0.388s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.9%   4.6%       3    0.368s
+─ReflectiveTactics.unify_abstract_cbv_in   3.3%   4.5%       1    0.368s
+─Glue.zrange_to_reflective_goal --------   2.6%   4.0%       1    0.324s
+─k -------------------------------------   3.5%   3.6%       1    0.296s
+─unify (constr) (constr) ---------------   3.3%   3.3%       8    0.092s
+─rewrite H -----------------------------   2.6%   2.6%       2    0.196s
+─eexact --------------------------------   2.6%   2.6%      95    0.024s
+─prove_interp_compile_correct ----------   0.0%   2.5%       1    0.204s
+─apply  (fun f =>   MapProjections.proj2   2.4%   2.4%       2    0.120s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  52.4%       1    4.268s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  43.8%       1    3.568s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  43.2%       1    3.520s
+ │ ├─ReflectiveTactics.do_reify --------   0.1%  21.7%       1    1.768s
+ │ │└Reify.Reify_rhs_gen ---------------   1.0%  20.9%       1    1.704s
+ │ │ ├─Reify.do_reify_abs_goal ---------   9.9%  10.1%       2    0.820s
+ │ │ │└Reify.do_reifyf_goal ------------   9.1%   9.3%      93    0.748s
+ │ │ │└eexact --------------------------   2.3%   2.3%      93    0.024s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   2.5%       1    0.204s
+ │ │ └─rewrite H -----------------------   2.4%   2.4%       1    0.196s
+ │ └─ReflectiveTactics.solve_post_reifie   0.6%  21.5%       1    1.752s
+ │   ├─UnifyAbstractReflexivity.unify_tr  13.3%  16.1%       7    0.360s
+ │   │└unify (constr) (constr) ---------   2.2%   2.2%       5    0.064s
+ │   └─ReflectiveTactics.unify_abstract_   3.3%   4.5%       1    0.368s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   8.6%       1    0.700s
+  â””Glue.zrange_to_reflective -----------   0.0%   5.3%       1    0.432s
+  â””Glue.zrange_to_reflective_goal ------   2.6%   4.0%       1    0.324s
+─synthesize_montgomery -----------------   0.0%  47.6%       1    3.872s
+ ├─IntegrationTestTemporaryMiscCommon.fa   1.4%  23.6%       1    1.924s
+ │└op_sig_side_conditions_t ------------   0.0%  20.0%       1    1.624s
+ │ ├─DestructHyps.do_all_matches_then --   0.0%  11.4%       4    0.244s
+ │ │└DestructHyps.do_one_match_then ----   0.3%  11.4%      24    0.052s
+ │ │└do_tac ----------------------------   0.0%  11.1%      20    0.052s
+ │ │└destruct H ------------------------  11.1%  11.1%      20    0.052s
+ │ └─rewrite <- (ZRange.is_bounded_by_No   8.4%   8.4%       4    0.328s
+ └─IntegrationTestTemporaryMiscCommon.do   0.0%  22.1%       1    1.796s
+   ├─IntegrationTestTemporaryMiscCommon.   0.0%  17.3%       1    1.408s
+   │└rewrite <- (lem : lemT) by by_tac l   0.2%  17.3%       1    1.408s
+   │└by_tac ----------------------------   0.0%  17.1%       4    0.504s
+   │ ├─DestructHyps.do_all_matches_then    0.0%   8.6%       4    0.184s
+   │ │└DestructHyps.do_one_match_then --   0.3%   8.5%      20    0.052s
+   │ │└do_tac --------------------------   0.0%   8.2%      16    0.052s
+   │ │└destruct H ----------------------   8.2%   8.2%      16    0.052s
+   │ └─rewrite <- (ZRange.is_bounded_by_   8.3%   8.3%       4    0.344s
+   └─IntegrationTestTemporaryMiscCommon.   0.0%   4.8%       1    0.388s
+    â””<Crypto.Util.Tactics.MoveLetIn.with   0.9%   4.6%       3    0.368s
+    â””k ---------------------------------   3.5%   3.6%       1    0.296s
+
+src/Specific/NISTP256/AMD64/feadd (real: 38.19, user: 35.40, sys: 0.30, mem: 799216 ko)
+COQC src/Specific/NISTP256/AMD64/fenz.v
+Finished transaction in 6.356 secs (5.82u,0.004s) (successful)
+total time:      5.800s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_nonzero --------------------   0.0% 100.0%       1    5.800s
+─IntegrationTestTemporaryMiscCommon.nonz   0.2%  85.5%       1    4.960s
+─destruct (Decidable.dec x), (Decidable.  37.4%  37.4%       1    2.168s
+─destruct (Decidable.dec x) as [H| H] --  22.0%  22.0%       1    1.276s
+─Pipeline.refine_reflectively_gen ------   0.0%  14.5%       1    0.840s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  10.9%       1    0.632s
+─ReflectiveTactics.solve_side_conditions   0.0%  10.6%       1    0.612s
+─ReflectiveTactics.solve_post_reified_si   0.3%   8.5%       1    0.492s
+─IntegrationTestTemporaryMiscCommon.op_s   0.1%   8.1%       2    0.368s
+─rewrite <- (ZRange.is_bounded_by_None_r   5.2%   5.2%       2    0.288s
+─UnifyAbstractReflexivity.unify_transfor   3.4%   4.3%       7    0.076s
+─ReflectiveTactics.unify_abstract_cbv_in   2.8%   3.8%       1    0.220s
+─Glue.refine_to_reflective_glue' -------   0.1%   3.6%       1    0.208s
+─rewrite H' ----------------------------   3.4%   3.4%       1    0.200s
+─generalize dependent (constr) ---------   3.0%   3.0%       4    0.060s
+─congruence ----------------------------   2.8%   2.8%       1    0.160s
+─do_tac --------------------------------   0.0%   2.6%       4    0.044s
+─destruct H ----------------------------   2.6%   2.6%       4    0.044s
+─IntegrationTestTemporaryMiscCommon.do_s   0.1%   2.6%       1    0.152s
+─DestructHyps.do_one_match_then --------   0.0%   2.6%       6    0.044s
+─DestructHyps.do_all_matches_then ------   0.0%   2.6%       2    0.076s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.4%   2.5%       3    0.140s
+─Glue.zrange_to_reflective -------------   0.0%   2.2%       1    0.128s
+─rewrite H -----------------------------   1.9%   2.1%       3    0.112s
+─ReflectiveTactics.do_reify ------------   0.0%   2.1%       1    0.120s
+─k -------------------------------------   1.9%   2.0%       1    0.116s
+─Reify.Reify_rhs_gen -------------------   0.1%   2.0%       1    0.116s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_nonzero --------------------   0.0% 100.0%       1    5.800s
+ ├─IntegrationTestTemporaryMiscCommon.no   0.2%  85.5%       1    4.960s
+ │ ├─destruct (Decidable.dec x), (Decida  37.4%  37.4%       1    2.168s
+ │ ├─destruct (Decidable.dec x) as [H| H  22.0%  22.0%       1    1.276s
+ │ ├─IntegrationTestTemporaryMiscCommon.   0.1%   8.1%       2    0.368s
+ │ │ ├─rewrite <- (ZRange.is_bounded_by_   5.2%   5.2%       2    0.288s
+ │ │ └─DestructHyps.do_all_matches_then    0.0%   2.6%       2    0.076s
+ │ │  └DestructHyps.do_one_match_then --   0.0%   2.6%       6    0.044s
+ │ │  └do_tac --------------------------   0.0%   2.6%       4    0.044s
+ │ │  └destruct H ----------------------   2.6%   2.6%       4    0.044s
+ │ ├─rewrite H' ------------------------   3.4%   3.4%       1    0.200s
+ │ ├─generalize dependent (constr) -----   3.0%   3.0%       4    0.060s
+ │ ├─congruence ------------------------   2.8%   2.8%       1    0.160s
+ │ ├─IntegrationTestTemporaryMiscCommon.   0.1%   2.6%       1    0.152s
+ │ │└<Crypto.Util.Tactics.MoveLetIn.with   0.4%   2.5%       3    0.140s
+ │ │└k ---------------------------------   1.9%   2.0%       1    0.116s
+ │ └─rewrite H -------------------------   1.7%   2.0%       2    0.112s
+ └─Pipeline.refine_reflectively_gen ----   0.0%  14.5%       1    0.840s
+   ├─ReflectiveTactics.do_reflective_pip   0.0%  10.9%       1    0.632s
+   │└ReflectiveTactics.solve_side_condit   0.0%  10.6%       1    0.612s
+   │ ├─ReflectiveTactics.solve_post_reif   0.3%   8.5%       1    0.492s
+   │ │ ├─UnifyAbstractReflexivity.unify_   3.4%   4.3%       7    0.076s
+   │ │ └─ReflectiveTactics.unify_abstrac   2.8%   3.8%       1    0.220s
+   │ └─ReflectiveTactics.do_reify ------   0.0%   2.1%       1    0.120s
+   │  └Reify.Reify_rhs_gen -------------   0.1%   2.0%       1    0.116s
+   └─Glue.refine_to_reflective_glue' ---   0.1%   3.6%       1    0.208s
+    â””Glue.zrange_to_reflective ---------   0.0%   2.2%       1    0.128s
+
+Finished transaction in 6.657 secs (6.299u,0.s) (successful)
+Closed under the global context
+total time:      5.800s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_nonzero --------------------   0.0% 100.0%       1    5.800s
+─IntegrationTestTemporaryMiscCommon.nonz   0.2%  85.5%       1    4.960s
+─destruct (Decidable.dec x), (Decidable.  37.4%  37.4%       1    2.168s
+─destruct (Decidable.dec x) as [H| H] --  22.0%  22.0%       1    1.276s
+─Pipeline.refine_reflectively_gen ------   0.0%  14.5%       1    0.840s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  10.9%       1    0.632s
+─ReflectiveTactics.solve_side_conditions   0.0%  10.6%       1    0.612s
+─ReflectiveTactics.solve_post_reified_si   0.3%   8.5%       1    0.492s
+─IntegrationTestTemporaryMiscCommon.op_s   0.1%   8.1%       2    0.368s
+─rewrite <- (ZRange.is_bounded_by_None_r   5.2%   5.2%       2    0.288s
+─UnifyAbstractReflexivity.unify_transfor   3.4%   4.3%       7    0.076s
+─ReflectiveTactics.unify_abstract_cbv_in   2.8%   3.8%       1    0.220s
+─Glue.refine_to_reflective_glue' -------   0.1%   3.6%       1    0.208s
+─rewrite H' ----------------------------   3.4%   3.4%       1    0.200s
+─generalize dependent (constr) ---------   3.0%   3.0%       4    0.060s
+─congruence ----------------------------   2.8%   2.8%       1    0.160s
+─do_tac --------------------------------   0.0%   2.6%       4    0.044s
+─destruct H ----------------------------   2.6%   2.6%       4    0.044s
+─IntegrationTestTemporaryMiscCommon.do_s   0.1%   2.6%       1    0.152s
+─DestructHyps.do_one_match_then --------   0.0%   2.6%       6    0.044s
+─DestructHyps.do_all_matches_then ------   0.0%   2.6%       2    0.076s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.4%   2.5%       3    0.140s
+─Glue.zrange_to_reflective -------------   0.0%   2.2%       1    0.128s
+─rewrite H -----------------------------   1.9%   2.1%       3    0.112s
+─ReflectiveTactics.do_reify ------------   0.0%   2.1%       1    0.120s
+─k -------------------------------------   1.9%   2.0%       1    0.116s
+─Reify.Reify_rhs_gen -------------------   0.1%   2.0%       1    0.116s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_nonzero --------------------   0.0% 100.0%       1    5.800s
+ ├─IntegrationTestTemporaryMiscCommon.no   0.2%  85.5%       1    4.960s
+ │ ├─destruct (Decidable.dec x), (Decida  37.4%  37.4%       1    2.168s
+ │ ├─destruct (Decidable.dec x) as [H| H  22.0%  22.0%       1    1.276s
+ │ ├─IntegrationTestTemporaryMiscCommon.   0.1%   8.1%       2    0.368s
+ │ │ ├─rewrite <- (ZRange.is_bounded_by_   5.2%   5.2%       2    0.288s
+ │ │ └─DestructHyps.do_all_matches_then    0.0%   2.6%       2    0.076s
+ │ │  └DestructHyps.do_one_match_then --   0.0%   2.6%       6    0.044s
+ │ │  └do_tac --------------------------   0.0%   2.6%       4    0.044s
+ │ │  └destruct H ----------------------   2.6%   2.6%       4    0.044s
+ │ ├─rewrite H' ------------------------   3.4%   3.4%       1    0.200s
+ │ ├─generalize dependent (constr) -----   3.0%   3.0%       4    0.060s
+ │ ├─congruence ------------------------   2.8%   2.8%       1    0.160s
+ │ ├─IntegrationTestTemporaryMiscCommon.   0.1%   2.6%       1    0.152s
+ │ │└<Crypto.Util.Tactics.MoveLetIn.with   0.4%   2.5%       3    0.140s
+ │ │└k ---------------------------------   1.9%   2.0%       1    0.116s
+ │ └─rewrite H -------------------------   1.7%   2.0%       2    0.112s
+ └─Pipeline.refine_reflectively_gen ----   0.0%  14.5%       1    0.840s
+   ├─ReflectiveTactics.do_reflective_pip   0.0%  10.9%       1    0.632s
+   │└ReflectiveTactics.solve_side_condit   0.0%  10.6%       1    0.612s
+   │ ├─ReflectiveTactics.solve_post_reif   0.3%   8.5%       1    0.492s
+   │ │ ├─UnifyAbstractReflexivity.unify_   3.4%   4.3%       7    0.076s
+   │ │ └─ReflectiveTactics.unify_abstrac   2.8%   3.8%       1    0.220s
+   │ └─ReflectiveTactics.do_reify ------   0.0%   2.1%       1    0.120s
+   │  └Reify.Reify_rhs_gen -------------   0.1%   2.0%       1    0.116s
+   └─Glue.refine_to_reflective_glue' ---   0.1%   3.6%       1    0.208s
+    â””Glue.zrange_to_reflective ---------   0.0%   2.2%       1    0.128s
+
+src/Specific/NISTP256/AMD64/fenz (real: 27.81, user: 25.50, sys: 0.22, mem: 756080 ko)
+COQC src/Specific/NISTP256/AMD64/feopp.v
+Finished transaction in 7.73 secs (7.112u,0.008s) (successful)
+total time:      7.072s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  62.5%       1    4.420s
+─IntegrationTestTemporaryMiscCommon.fact  18.7%  51.6%       1    3.648s
+─Pipeline.refine_reflectively_gen ------   0.0%  37.5%       1    2.652s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  32.6%       1    2.308s
+─ReflectiveTactics.solve_side_conditions   0.0%  32.2%       1    2.276s
+─reflexivity ---------------------------  24.8%  24.8%       8    1.700s
+─ReflectiveTactics.solve_post_reified_si   0.5%  18.5%       1    1.308s
+─ReflectiveTactics.do_reify ------------   0.0%  13.7%       1    0.968s
+─UnifyAbstractReflexivity.unify_transfor  11.2%  13.6%       7    0.284s
+─Reify.Reify_rhs_gen -------------------   0.6%  13.4%       1    0.948s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   9.7%       1    0.684s
+─rewrite <- (ZRange.is_bounded_by_None_r   9.0%   9.0%       4    0.328s
+─op_sig_side_conditions_t --------------   0.0%   7.8%       1    0.552s
+─rewrite <- (lem : lemT) by by_tac ltac:   0.1%   7.4%       1    0.520s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   7.4%       1    0.520s
+─by_tac --------------------------------   0.0%   7.2%       2    0.404s
+─Reify.do_reify_abs_goal ---------------   7.1%   7.2%       2    0.512s
+─Reify.do_reifyf_goal ------------------   6.6%   6.7%      62    0.472s
+─DestructHyps.do_one_match_then --------   0.2%   5.8%      14    0.048s
+─DestructHyps.do_all_matches_then ------   0.0%   5.8%       4    0.124s
+─do_tac --------------------------------   0.0%   5.6%      10    0.048s
+─destruct H ----------------------------   5.6%   5.6%      10    0.048s
+─Glue.refine_to_reflective_glue' -------   0.0%   4.9%       1    0.344s
+─ReflectiveTactics.unify_abstract_cbv_in   2.9%   4.2%       1    0.300s
+─Glue.zrange_to_reflective -------------   0.0%   3.3%       1    0.232s
+─unify (constr) (constr) ---------------   3.2%   3.2%       7    0.088s
+─Glue.zrange_to_reflective_goal --------   1.9%   2.6%       1    0.184s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   2.3%       1    0.164s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.4%   2.2%       3    0.152s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  62.5%       1    4.420s
+ ├─IntegrationTestTemporaryMiscCommon.fa  18.7%  51.6%       1    3.648s
+ │ ├─reflexivity -----------------------  24.0%  24.0%       1    1.700s
+ │ └─op_sig_side_conditions_t ----------   0.0%   7.8%       1    0.552s
+ │   ├─rewrite <- (ZRange.is_bounded_by_   4.2%   4.2%       2    0.284s
+ │   └─DestructHyps.do_all_matches_then    0.0%   3.5%       2    0.124s
+ │    └DestructHyps.do_one_match_then --   0.2%   3.5%       8    0.044s
+ │    └do_tac --------------------------   0.0%   3.3%       6    0.040s
+ │    └destruct H ----------------------   3.3%   3.3%       6    0.040s
+ └─IntegrationTestTemporaryMiscCommon.do   0.0%   9.7%       1    0.684s
+   ├─IntegrationTestTemporaryMiscCommon.   0.0%   7.4%       1    0.520s
+   │└rewrite <- (lem : lemT) by by_tac l   0.1%   7.4%       1    0.520s
+   │└by_tac ----------------------------   0.0%   7.2%       2    0.404s
+   │ ├─rewrite <- (ZRange.is_bounded_by_   4.8%   4.8%       2    0.328s
+   │ └─DestructHyps.do_all_matches_then    0.0%   2.3%       2    0.088s
+   │  └DestructHyps.do_one_match_then --   0.0%   2.3%       6    0.048s
+   │  └do_tac --------------------------   0.0%   2.3%       4    0.048s
+   │  └destruct H ----------------------   2.3%   2.3%       4    0.048s
+   └─IntegrationTestTemporaryMiscCommon.   0.0%   2.3%       1    0.164s
+    â””<Crypto.Util.Tactics.MoveLetIn.with   0.4%   2.2%       3    0.152s
+─Pipeline.refine_reflectively_gen ------   0.0%  37.5%       1    2.652s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  32.6%       1    2.308s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  32.2%       1    2.276s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.5%  18.5%       1    1.308s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  11.2%  13.6%       7    0.284s
+ │ │ └─ReflectiveTactics.unify_abstract_   2.9%   4.2%       1    0.300s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  13.7%       1    0.968s
+ │  └Reify.Reify_rhs_gen ---------------   0.6%  13.4%       1    0.948s
+ │  └Reify.do_reify_abs_goal -----------   7.1%   7.2%       2    0.512s
+ │  └Reify.do_reifyf_goal --------------   6.6%   6.7%      62    0.472s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   4.9%       1    0.344s
+  â””Glue.zrange_to_reflective -----------   0.0%   3.3%       1    0.232s
+  â””Glue.zrange_to_reflective_goal ------   1.9%   2.6%       1    0.184s
+
+Finished transaction in 7.732 secs (7.1u,0.003s) (successful)
+Closed under the global context
+total time:      7.072s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  62.5%       1    4.420s
+─IntegrationTestTemporaryMiscCommon.fact  18.7%  51.6%       1    3.648s
+─Pipeline.refine_reflectively_gen ------   0.0%  37.5%       1    2.652s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  32.6%       1    2.308s
+─ReflectiveTactics.solve_side_conditions   0.0%  32.2%       1    2.276s
+─reflexivity ---------------------------  24.8%  24.8%       8    1.700s
+─ReflectiveTactics.solve_post_reified_si   0.5%  18.5%       1    1.308s
+─ReflectiveTactics.do_reify ------------   0.0%  13.7%       1    0.968s
+─UnifyAbstractReflexivity.unify_transfor  11.2%  13.6%       7    0.284s
+─Reify.Reify_rhs_gen -------------------   0.6%  13.4%       1    0.948s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   9.7%       1    0.684s
+─rewrite <- (ZRange.is_bounded_by_None_r   9.0%   9.0%       4    0.328s
+─op_sig_side_conditions_t --------------   0.0%   7.8%       1    0.552s
+─rewrite <- (lem : lemT) by by_tac ltac:   0.1%   7.4%       1    0.520s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   7.4%       1    0.520s
+─by_tac --------------------------------   0.0%   7.2%       2    0.404s
+─Reify.do_reify_abs_goal ---------------   7.1%   7.2%       2    0.512s
+─Reify.do_reifyf_goal ------------------   6.6%   6.7%      62    0.472s
+─DestructHyps.do_one_match_then --------   0.2%   5.8%      14    0.048s
+─DestructHyps.do_all_matches_then ------   0.0%   5.8%       4    0.124s
+─do_tac --------------------------------   0.0%   5.6%      10    0.048s
+─destruct H ----------------------------   5.6%   5.6%      10    0.048s
+─Glue.refine_to_reflective_glue' -------   0.0%   4.9%       1    0.344s
+─ReflectiveTactics.unify_abstract_cbv_in   2.9%   4.2%       1    0.300s
+─Glue.zrange_to_reflective -------------   0.0%   3.3%       1    0.232s
+─unify (constr) (constr) ---------------   3.2%   3.2%       7    0.088s
+─Glue.zrange_to_reflective_goal --------   1.9%   2.6%       1    0.184s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   2.3%       1    0.164s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.4%   2.2%       3    0.152s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  62.5%       1    4.420s
+ ├─IntegrationTestTemporaryMiscCommon.fa  18.7%  51.6%       1    3.648s
+ │ ├─reflexivity -----------------------  24.0%  24.0%       1    1.700s
+ │ └─op_sig_side_conditions_t ----------   0.0%   7.8%       1    0.552s
+ │   ├─rewrite <- (ZRange.is_bounded_by_   4.2%   4.2%       2    0.284s
+ │   └─DestructHyps.do_all_matches_then    0.0%   3.5%       2    0.124s
+ │    └DestructHyps.do_one_match_then --   0.2%   3.5%       8    0.044s
+ │    └do_tac --------------------------   0.0%   3.3%       6    0.040s
+ │    └destruct H ----------------------   3.3%   3.3%       6    0.040s
+ └─IntegrationTestTemporaryMiscCommon.do   0.0%   9.7%       1    0.684s
+   ├─IntegrationTestTemporaryMiscCommon.   0.0%   7.4%       1    0.520s
+   │└rewrite <- (lem : lemT) by by_tac l   0.1%   7.4%       1    0.520s
+   │└by_tac ----------------------------   0.0%   7.2%       2    0.404s
+   │ ├─rewrite <- (ZRange.is_bounded_by_   4.8%   4.8%       2    0.328s
+   │ └─DestructHyps.do_all_matches_then    0.0%   2.3%       2    0.088s
+   │  └DestructHyps.do_one_match_then --   0.0%   2.3%       6    0.048s
+   │  └do_tac --------------------------   0.0%   2.3%       4    0.048s
+   │  └destruct H ----------------------   2.3%   2.3%       4    0.048s
+   └─IntegrationTestTemporaryMiscCommon.   0.0%   2.3%       1    0.164s
+    â””<Crypto.Util.Tactics.MoveLetIn.with   0.4%   2.2%       3    0.152s
+─Pipeline.refine_reflectively_gen ------   0.0%  37.5%       1    2.652s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  32.6%       1    2.308s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  32.2%       1    2.276s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.5%  18.5%       1    1.308s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  11.2%  13.6%       7    0.284s
+ │ │ └─ReflectiveTactics.unify_abstract_   2.9%   4.2%       1    0.300s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  13.7%       1    0.968s
+ │  └Reify.Reify_rhs_gen ---------------   0.6%  13.4%       1    0.948s
+ │  └Reify.do_reify_abs_goal -----------   7.1%   7.2%       2    0.512s
+ │  └Reify.do_reifyf_goal --------------   6.6%   6.7%      62    0.472s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   4.9%       1    0.344s
+  â””Glue.zrange_to_reflective -----------   0.0%   3.3%       1    0.232s
+  â””Glue.zrange_to_reflective_goal ------   1.9%   2.6%       1    0.184s
+
+src/Specific/NISTP256/AMD64/feopp (real: 31.00, user: 28.51, sys: 0.20, mem: 765208 ko)
+COQC src/Specific/NISTP256/AMD64/fesub.v
+Finished transaction in 12.996 secs (12.091u,0.004s) (successful)
+total time:     12.048s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  66.1%       1    7.964s
+─IntegrationTestTemporaryMiscCommon.fact  16.2%  50.9%       1    6.128s
+─Pipeline.refine_reflectively_gen ------   0.0%  33.9%       1    4.084s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  28.3%       1    3.404s
+─ReflectiveTactics.solve_side_conditions   0.0%  27.8%       1    3.352s
+─reflexivity ---------------------------  21.7%  21.7%       8    2.480s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  14.1%       1    1.704s
+─ReflectiveTactics.solve_post_reified_si   0.4%  14.1%       1    1.696s
+─ReflectiveTactics.do_reify ------------   0.0%  13.7%       1    1.656s
+─Reify.Reify_rhs_gen -------------------   0.9%  13.2%       1    1.592s
+─DestructHyps.do_all_matches_then ------   0.0%  12.9%       8    0.232s
+─DestructHyps.do_one_match_then --------   0.6%  12.9%      44    0.052s
+─op_sig_side_conditions_t --------------   0.0%  12.7%       1    1.528s
+─do_tac --------------------------------   0.0%  12.3%      36    0.048s
+─destruct H ----------------------------  12.3%  12.3%      36    0.048s
+─rewrite <- (lem : lemT) by by_tac ltac:   0.1%  11.2%       1    1.352s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  11.2%       1    1.352s
+─by_tac --------------------------------   0.0%  11.1%       4    0.476s
+─UnifyAbstractReflexivity.unify_transfor   8.8%  10.6%       7    0.344s
+─rewrite <- (ZRange.is_bounded_by_None_r  10.5%  10.5%       8    0.316s
+─Reify.do_reify_abs_goal ---------------   6.0%   6.1%       2    0.732s
+─Glue.refine_to_reflective_glue' -------   0.0%   5.6%       1    0.680s
+─Reify.do_reifyf_goal ------------------   5.4%   5.5%      80    0.660s
+─Glue.zrange_to_reflective -------------   0.0%   3.6%       1    0.428s
+─ReflectiveTactics.unify_abstract_cbv_in   2.2%   3.0%       1    0.360s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   2.9%       1    0.348s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.5%   2.8%       3    0.332s
+─Glue.zrange_to_reflective_goal --------   1.7%   2.6%       1    0.316s
+─k -------------------------------------   2.1%   2.2%       1    0.268s
+─unify (constr) (constr) ---------------   2.1%   2.1%       8    0.092s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  66.1%       1    7.964s
+ ├─IntegrationTestTemporaryMiscCommon.fa  16.2%  50.9%       1    6.128s
+ │ ├─reflexivity -----------------------  20.6%  20.6%       1    2.480s
+ │ └─op_sig_side_conditions_t ----------   0.0%  12.7%       1    1.528s
+ │   ├─DestructHyps.do_all_matches_then    0.0%   7.3%       4    0.232s
+ │   │└DestructHyps.do_one_match_then --   0.3%   7.3%      24    0.052s
+ │   │└do_tac --------------------------   0.0%   7.0%      20    0.048s
+ │   │└destruct H ----------------------   6.9%   6.9%      20    0.048s
+ │   └─rewrite <- (ZRange.is_bounded_by_   5.2%   5.2%       4    0.300s
+ └─IntegrationTestTemporaryMiscCommon.do   0.0%  14.1%       1    1.704s
+   ├─IntegrationTestTemporaryMiscCommon.   0.0%  11.2%       1    1.352s
+   │└rewrite <- (lem : lemT) by by_tac l   0.1%  11.2%       1    1.352s
+   │└by_tac ----------------------------   0.0%  11.1%       4    0.476s
+   │ ├─DestructHyps.do_all_matches_then    0.0%   5.6%       4    0.176s
+   │ │└DestructHyps.do_one_match_then --   0.2%   5.6%      20    0.052s
+   │ │└do_tac --------------------------   0.0%   5.3%      16    0.048s
+   │ │└destruct H ----------------------   5.3%   5.3%      16    0.048s
+   │ └─rewrite <- (ZRange.is_bounded_by_   5.3%   5.3%       4    0.316s
+   └─IntegrationTestTemporaryMiscCommon.   0.0%   2.9%       1    0.348s
+    â””<Crypto.Util.Tactics.MoveLetIn.with   0.5%   2.8%       3    0.332s
+    â””k ---------------------------------   2.1%   2.2%       1    0.268s
+─Pipeline.refine_reflectively_gen ------   0.0%  33.9%       1    4.084s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  28.3%       1    3.404s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  27.8%       1    3.352s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.4%  14.1%       1    1.696s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr   8.8%  10.6%       7    0.344s
+ │ │ └─ReflectiveTactics.unify_abstract_   2.2%   3.0%       1    0.360s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  13.7%       1    1.656s
+ │  └Reify.Reify_rhs_gen ---------------   0.9%  13.2%       1    1.592s
+ │  └Reify.do_reify_abs_goal -----------   6.0%   6.1%       2    0.732s
+ │  └Reify.do_reifyf_goal --------------   5.4%   5.5%      80    0.660s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   5.6%       1    0.680s
+  â””Glue.zrange_to_reflective -----------   0.0%   3.6%       1    0.428s
+  â””Glue.zrange_to_reflective_goal ------   1.7%   2.6%       1    0.316s
+
+Finished transaction in 13.895 secs (12.78u,0.02s) (successful)
+Closed under the global context
+total time:     12.048s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  66.1%       1    7.964s
+─IntegrationTestTemporaryMiscCommon.fact  16.2%  50.9%       1    6.128s
+─Pipeline.refine_reflectively_gen ------   0.0%  33.9%       1    4.084s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  28.3%       1    3.404s
+─ReflectiveTactics.solve_side_conditions   0.0%  27.8%       1    3.352s
+─reflexivity ---------------------------  21.7%  21.7%       8    2.480s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  14.1%       1    1.704s
+─ReflectiveTactics.solve_post_reified_si   0.4%  14.1%       1    1.696s
+─ReflectiveTactics.do_reify ------------   0.0%  13.7%       1    1.656s
+─Reify.Reify_rhs_gen -------------------   0.9%  13.2%       1    1.592s
+─DestructHyps.do_all_matches_then ------   0.0%  12.9%       8    0.232s
+─DestructHyps.do_one_match_then --------   0.6%  12.9%      44    0.052s
+─op_sig_side_conditions_t --------------   0.0%  12.7%       1    1.528s
+─do_tac --------------------------------   0.0%  12.3%      36    0.048s
+─destruct H ----------------------------  12.3%  12.3%      36    0.048s
+─rewrite <- (lem : lemT) by by_tac ltac:   0.1%  11.2%       1    1.352s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  11.2%       1    1.352s
+─by_tac --------------------------------   0.0%  11.1%       4    0.476s
+─UnifyAbstractReflexivity.unify_transfor   8.8%  10.6%       7    0.344s
+─rewrite <- (ZRange.is_bounded_by_None_r  10.5%  10.5%       8    0.316s
+─Reify.do_reify_abs_goal ---------------   6.0%   6.1%       2    0.732s
+─Glue.refine_to_reflective_glue' -------   0.0%   5.6%       1    0.680s
+─Reify.do_reifyf_goal ------------------   5.4%   5.5%      80    0.660s
+─Glue.zrange_to_reflective -------------   0.0%   3.6%       1    0.428s
+─ReflectiveTactics.unify_abstract_cbv_in   2.2%   3.0%       1    0.360s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   2.9%       1    0.348s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.5%   2.8%       3    0.332s
+─Glue.zrange_to_reflective_goal --------   1.7%   2.6%       1    0.316s
+─k -------------------------------------   2.1%   2.2%       1    0.268s
+─unify (constr) (constr) ---------------   2.1%   2.1%       8    0.092s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  66.1%       1    7.964s
+ ├─IntegrationTestTemporaryMiscCommon.fa  16.2%  50.9%       1    6.128s
+ │ ├─reflexivity -----------------------  20.6%  20.6%       1    2.480s
+ │ └─op_sig_side_conditions_t ----------   0.0%  12.7%       1    1.528s
+ │   ├─DestructHyps.do_all_matches_then    0.0%   7.3%       4    0.232s
+ │   │└DestructHyps.do_one_match_then --   0.3%   7.3%      24    0.052s
+ │   │└do_tac --------------------------   0.0%   7.0%      20    0.048s
+ │   │└destruct H ----------------------   6.9%   6.9%      20    0.048s
+ │   └─rewrite <- (ZRange.is_bounded_by_   5.2%   5.2%       4    0.300s
+ └─IntegrationTestTemporaryMiscCommon.do   0.0%  14.1%       1    1.704s
+   ├─IntegrationTestTemporaryMiscCommon.   0.0%  11.2%       1    1.352s
+   │└rewrite <- (lem : lemT) by by_tac l   0.1%  11.2%       1    1.352s
+   │└by_tac ----------------------------   0.0%  11.1%       4    0.476s
+   │ ├─DestructHyps.do_all_matches_then    0.0%   5.6%       4    0.176s
+   │ │└DestructHyps.do_one_match_then --   0.2%   5.6%      20    0.052s
+   │ │└do_tac --------------------------   0.0%   5.3%      16    0.048s
+   │ │└destruct H ----------------------   5.3%   5.3%      16    0.048s
+   │ └─rewrite <- (ZRange.is_bounded_by_   5.3%   5.3%       4    0.316s
+   └─IntegrationTestTemporaryMiscCommon.   0.0%   2.9%       1    0.348s
+    â””<Crypto.Util.Tactics.MoveLetIn.with   0.5%   2.8%       3    0.332s
+    â””k ---------------------------------   2.1%   2.2%       1    0.268s
+─Pipeline.refine_reflectively_gen ------   0.0%  33.9%       1    4.084s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  28.3%       1    3.404s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  27.8%       1    3.352s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.4%  14.1%       1    1.696s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr   8.8%  10.6%       7    0.344s
+ │ │ └─ReflectiveTactics.unify_abstract_   2.2%   3.0%       1    0.360s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  13.7%       1    1.656s
+ │  └Reify.Reify_rhs_gen ---------------   0.9%  13.2%       1    1.592s
+ │  └Reify.do_reify_abs_goal -----------   6.0%   6.1%       2    0.732s
+ │  └Reify.do_reifyf_goal --------------   5.4%   5.5%      80    0.660s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   5.6%       1    0.680s
+  â””Glue.zrange_to_reflective -----------   0.0%   3.6%       1    0.428s
+  â””Glue.zrange_to_reflective_goal ------   1.7%   2.6%       1    0.316s
+
+src/Specific/NISTP256/AMD64/fesub (real: 43.34, user: 39.59, sys: 0.26, mem: 793376 ko)
+COQC src/Specific/NISTP256/AMD64/feaddDisplay > src/Specific/NISTP256/AMD64/feaddDisplay.log
+COQC src/Specific/NISTP256/AMD64/fenzDisplay > src/Specific/NISTP256/AMD64/fenzDisplay.log
+COQC src/Specific/solinas32_2e255m765_12limbs/femul.v
+Finished transaction in 50.426 secs (46.528u,0.072s) (successful)
+total time:     46.544s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------  -0.0%  94.9%       1   44.164s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  87.1%       1   40.552s
+─ReflectiveTactics.solve_side_conditions   0.0%  86.7%       1   40.372s
+─ReflectiveTactics.do_reify ------------   0.0%  59.6%       1   27.740s
+─Reify.Reify_rhs_gen -------------------   1.6%  58.9%       1   27.432s
+─Reify.do_reify_abs_goal ---------------  43.3%  43.6%       2   20.312s
+─Reify.do_reifyf_goal ------------------  42.5%  42.8%     108   10.328s
+─ReflectiveTactics.solve_post_reified_si   0.1%  27.1%       1   12.632s
+─UnifyAbstractReflexivity.unify_transfor  18.6%  23.5%       7    3.552s
+─eexact --------------------------------  13.7%  13.7%     110    0.136s
+─Glue.refine_to_reflective_glue' -------   0.0%   7.8%       1    3.612s
+─Glue.zrange_to_reflective -------------   0.0%   7.2%       1    3.332s
+─Glue.zrange_to_reflective_goal --------   1.7%   5.5%       1    2.544s
+─synthesize ----------------------------   0.0%   5.1%       1    2.380s
+─unify (constr) (constr) ---------------   5.1%   5.1%       6    1.068s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   5.0%       1    2.320s
+─change G' -----------------------------   4.8%   4.8%       1    2.252s
+─rewrite H -----------------------------   3.8%   3.8%       1    1.748s
+─pose proof  (pf   :   Interpretation.Bo   3.6%   3.6%       1    1.664s
+─prove_interp_compile_correct ----------   0.0%   3.5%       1    1.616s
+─rewrite ?EtaInterp.InterpExprEta ------   3.2%   3.2%       1    1.468s
+─ReflectiveTactics.unify_abstract_cbv_in   1.6%   2.4%       1    1.124s
+─reflexivity ---------------------------   2.1%   2.1%       7    0.396s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------  -0.0%  94.9%       1   44.164s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  87.1%       1   40.552s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  86.7%       1   40.372s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  59.6%       1   27.740s
+ │ │└Reify.Reify_rhs_gen ---------------   1.6%  58.9%       1   27.432s
+ │ │ ├─Reify.do_reify_abs_goal ---------  43.3%  43.6%       2   20.312s
+ │ │ │└Reify.do_reifyf_goal ------------  42.5%  42.8%     108   10.328s
+ │ │ │└eexact --------------------------  13.2%  13.2%     108    0.072s
+ │ │ ├─rewrite H -----------------------   3.8%   3.8%       1    1.748s
+ │ │ └─prove_interp_compile_correct ----   0.0%   3.5%       1    1.616s
+ │ │  └rewrite ?EtaInterp.InterpExprEta    3.2%   3.2%       1    1.468s
+ │ └─ReflectiveTactics.solve_post_reifie   0.1%  27.1%       1   12.632s
+ │   ├─UnifyAbstractReflexivity.unify_tr  18.6%  23.5%       7    3.552s
+ │   │└unify (constr) (constr) ---------   4.3%   4.3%       5    1.068s
+ │   └─ReflectiveTactics.unify_abstract_   1.6%   2.4%       1    1.124s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   7.8%       1    3.612s
+  â””Glue.zrange_to_reflective -----------   0.0%   7.2%       1    3.332s
+  â””Glue.zrange_to_reflective_goal ------   1.7%   5.5%       1    2.544s
+  â””pose proof  (pf   :   Interpretation.   3.6%   3.6%       1    1.664s
+─synthesize ----------------------------   0.0%   5.1%       1    2.380s
+â””IntegrationTestTemporaryMiscCommon.do_r   0.0%   5.0%       1    2.320s
+â””change G' -----------------------------   4.8%   4.8%       1    2.252s
+
+Finished transaction in 80.129 secs (74.068u,0.024s) (successful)
+Closed under the global context
+total time:     46.544s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------  -0.0%  94.9%       1   44.164s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  87.1%       1   40.552s
+─ReflectiveTactics.solve_side_conditions   0.0%  86.7%       1   40.372s
+─ReflectiveTactics.do_reify ------------   0.0%  59.6%       1   27.740s
+─Reify.Reify_rhs_gen -------------------   1.6%  58.9%       1   27.432s
+─Reify.do_reify_abs_goal ---------------  43.3%  43.6%       2   20.312s
+─Reify.do_reifyf_goal ------------------  42.5%  42.8%     108   10.328s
+─ReflectiveTactics.solve_post_reified_si   0.1%  27.1%       1   12.632s
+─UnifyAbstractReflexivity.unify_transfor  18.6%  23.5%       7    3.552s
+─eexact --------------------------------  13.7%  13.7%     110    0.136s
+─Glue.refine_to_reflective_glue' -------   0.0%   7.8%       1    3.612s
+─Glue.zrange_to_reflective -------------   0.0%   7.2%       1    3.332s
+─Glue.zrange_to_reflective_goal --------   1.7%   5.5%       1    2.544s
+─synthesize ----------------------------   0.0%   5.1%       1    2.380s
+─unify (constr) (constr) ---------------   5.1%   5.1%       6    1.068s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   5.0%       1    2.320s
+─change G' -----------------------------   4.8%   4.8%       1    2.252s
+─rewrite H -----------------------------   3.8%   3.8%       1    1.748s
+─pose proof  (pf   :   Interpretation.Bo   3.6%   3.6%       1    1.664s
+─prove_interp_compile_correct ----------   0.0%   3.5%       1    1.616s
+─rewrite ?EtaInterp.InterpExprEta ------   3.2%   3.2%       1    1.468s
+─ReflectiveTactics.unify_abstract_cbv_in   1.6%   2.4%       1    1.124s
+─reflexivity ---------------------------   2.1%   2.1%       7    0.396s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------  -0.0%  94.9%       1   44.164s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  87.1%       1   40.552s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  86.7%       1   40.372s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  59.6%       1   27.740s
+ │ │└Reify.Reify_rhs_gen ---------------   1.6%  58.9%       1   27.432s
+ │ │ ├─Reify.do_reify_abs_goal ---------  43.3%  43.6%       2   20.312s
+ │ │ │└Reify.do_reifyf_goal ------------  42.5%  42.8%     108   10.328s
+ │ │ │└eexact --------------------------  13.2%  13.2%     108    0.072s
+ │ │ ├─rewrite H -----------------------   3.8%   3.8%       1    1.748s
+ │ │ └─prove_interp_compile_correct ----   0.0%   3.5%       1    1.616s
+ │ │  └rewrite ?EtaInterp.InterpExprEta    3.2%   3.2%       1    1.468s
+ │ └─ReflectiveTactics.solve_post_reifie   0.1%  27.1%       1   12.632s
+ │   ├─UnifyAbstractReflexivity.unify_tr  18.6%  23.5%       7    3.552s
+ │   │└unify (constr) (constr) ---------   4.3%   4.3%       5    1.068s
+ │   └─ReflectiveTactics.unify_abstract_   1.6%   2.4%       1    1.124s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   7.8%       1    3.612s
+  â””Glue.zrange_to_reflective -----------   0.0%   7.2%       1    3.332s
+  â””Glue.zrange_to_reflective_goal ------   1.7%   5.5%       1    2.544s
+  â””pose proof  (pf   :   Interpretation.   3.6%   3.6%       1    1.664s
+─synthesize ----------------------------   0.0%   5.1%       1    2.380s
+â””IntegrationTestTemporaryMiscCommon.do_r   0.0%   5.0%       1    2.320s
+â””change G' -----------------------------   4.8%   4.8%       1    2.252s
+
+src/Specific/solinas32_2e255m765_12limbs/femul (real: 155.79, user: 143.70, sys: 0.32, mem: 1454696 ko)
+COQC src/Specific/NISTP256/AMD64/feoppDisplay > src/Specific/NISTP256/AMD64/feoppDisplay.log
+COQC src/Specific/NISTP256/AMD64/fesubDisplay > src/Specific/NISTP256/AMD64/fesubDisplay.log
+COQC src/Specific/X25519/C64/fesquareDisplay > src/Specific/X25519/C64/fesquareDisplay.log
+COQC src/Specific/X25519/C64/fesubDisplay > src/Specific/X25519/C64/fesubDisplay.log
+COQC src/Specific/X25519/C64/freezeDisplay > src/Specific/X25519/C64/freezeDisplay.log
+COQC src/Specific/solinas32_2e255m765_13limbs/femul.v
+Finished transaction in 61.854 secs (57.328u,0.079s) (successful)
+total time:     57.348s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  94.6%       1   54.224s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  86.2%       1   49.452s
+─ReflectiveTactics.solve_side_conditions   0.0%  85.9%       1   49.264s
+─ReflectiveTactics.do_reify ------------  -0.0%  57.6%       1   33.004s
+─Reify.Reify_rhs_gen -------------------   1.3%  56.9%       1   32.608s
+─Reify.do_reify_abs_goal ---------------  43.1%  43.3%       2   24.840s
+─Reify.do_reifyf_goal ------------------  42.3%  42.6%     117   12.704s
+─ReflectiveTactics.solve_post_reified_si   0.1%  28.4%       1   16.260s
+─UnifyAbstractReflexivity.unify_transfor  19.6%  25.0%       7    4.824s
+─eexact --------------------------------  13.9%  13.9%     119    0.144s
+─Glue.refine_to_reflective_glue' -------   0.0%   8.3%       1    4.772s
+─Glue.zrange_to_reflective -------------   0.0%   7.8%       1    4.484s
+─Glue.zrange_to_reflective_goal --------   1.7%   6.0%       1    3.464s
+─synthesize ----------------------------   0.0%   5.4%       1    3.124s
+─unify (constr) (constr) ---------------   5.4%   5.4%       6    1.540s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   5.3%       1    3.040s
+─change G' -----------------------------   5.2%   5.2%       1    2.964s
+─pose proof  (pf   :   Interpretation.Bo   4.2%   4.2%       1    2.416s
+─prove_interp_compile_correct ----------   0.0%   3.3%       1    1.904s
+─rewrite H -----------------------------   3.3%   3.3%       1    1.896s
+─rewrite ?EtaInterp.InterpExprEta ------   3.0%   3.0%       1    1.732s
+─ReflectiveTactics.unify_abstract_cbv_in   1.4%   2.1%       1    1.212s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  94.6%       1   54.224s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  86.2%       1   49.452s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  85.9%       1   49.264s
+ │ ├─ReflectiveTactics.do_reify --------  -0.0%  57.6%       1   33.004s
+ │ │└Reify.Reify_rhs_gen ---------------   1.3%  56.9%       1   32.608s
+ │ │ ├─Reify.do_reify_abs_goal ---------  43.1%  43.3%       2   24.840s
+ │ │ │└Reify.do_reifyf_goal ------------  42.3%  42.6%     117   12.704s
+ │ │ │└eexact --------------------------  13.4%  13.4%     117    0.084s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   3.3%       1    1.904s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    3.0%   3.0%       1    1.732s
+ │ │ └─rewrite H -----------------------   3.3%   3.3%       1    1.896s
+ │ └─ReflectiveTactics.solve_post_reifie   0.1%  28.4%       1   16.260s
+ │   ├─UnifyAbstractReflexivity.unify_tr  19.6%  25.0%       7    4.824s
+ │   │└unify (constr) (constr) ---------   4.8%   4.8%       5    1.540s
+ │   └─ReflectiveTactics.unify_abstract_   1.4%   2.1%       1    1.212s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   8.3%       1    4.772s
+  â””Glue.zrange_to_reflective -----------   0.0%   7.8%       1    4.484s
+  â””Glue.zrange_to_reflective_goal ------   1.7%   6.0%       1    3.464s
+  â””pose proof  (pf   :   Interpretation.   4.2%   4.2%       1    2.416s
+─synthesize ----------------------------   0.0%   5.4%       1    3.124s
+â””IntegrationTestTemporaryMiscCommon.do_r   0.0%   5.3%       1    3.040s
+â””change G' -----------------------------   5.2%   5.2%       1    2.964s
+
+Finished transaction in 94.432 secs (86.96u,0.02s) (successful)
+Closed under the global context
+total time:     57.348s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  94.6%       1   54.224s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  86.2%       1   49.452s
+─ReflectiveTactics.solve_side_conditions   0.0%  85.9%       1   49.264s
+─ReflectiveTactics.do_reify ------------  -0.0%  57.6%       1   33.004s
+─Reify.Reify_rhs_gen -------------------   1.3%  56.9%       1   32.608s
+─Reify.do_reify_abs_goal ---------------  43.1%  43.3%       2   24.840s
+─Reify.do_reifyf_goal ------------------  42.3%  42.6%     117   12.704s
+─ReflectiveTactics.solve_post_reified_si   0.1%  28.4%       1   16.260s
+─UnifyAbstractReflexivity.unify_transfor  19.6%  25.0%       7    4.824s
+─eexact --------------------------------  13.9%  13.9%     119    0.144s
+─Glue.refine_to_reflective_glue' -------   0.0%   8.3%       1    4.772s
+─Glue.zrange_to_reflective -------------   0.0%   7.8%       1    4.484s
+─Glue.zrange_to_reflective_goal --------   1.7%   6.0%       1    3.464s
+─synthesize ----------------------------   0.0%   5.4%       1    3.124s
+─unify (constr) (constr) ---------------   5.4%   5.4%       6    1.540s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   5.3%       1    3.040s
+─change G' -----------------------------   5.2%   5.2%       1    2.964s
+─pose proof  (pf   :   Interpretation.Bo   4.2%   4.2%       1    2.416s
+─prove_interp_compile_correct ----------   0.0%   3.3%       1    1.904s
+─rewrite H -----------------------------   3.3%   3.3%       1    1.896s
+─rewrite ?EtaInterp.InterpExprEta ------   3.0%   3.0%       1    1.732s
+─ReflectiveTactics.unify_abstract_cbv_in   1.4%   2.1%       1    1.212s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  94.6%       1   54.224s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  86.2%       1   49.452s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  85.9%       1   49.264s
+ │ ├─ReflectiveTactics.do_reify --------  -0.0%  57.6%       1   33.004s
+ │ │└Reify.Reify_rhs_gen ---------------   1.3%  56.9%       1   32.608s
+ │ │ ├─Reify.do_reify_abs_goal ---------  43.1%  43.3%       2   24.840s
+ │ │ │└Reify.do_reifyf_goal ------------  42.3%  42.6%     117   12.704s
+ │ │ │└eexact --------------------------  13.4%  13.4%     117    0.084s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   3.3%       1    1.904s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    3.0%   3.0%       1    1.732s
+ │ │ └─rewrite H -----------------------   3.3%   3.3%       1    1.896s
+ │ └─ReflectiveTactics.solve_post_reifie   0.1%  28.4%       1   16.260s
+ │   ├─UnifyAbstractReflexivity.unify_tr  19.6%  25.0%       7    4.824s
+ │   │└unify (constr) (constr) ---------   4.8%   4.8%       5    1.540s
+ │   └─ReflectiveTactics.unify_abstract_   1.4%   2.1%       1    1.212s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   8.3%       1    4.772s
+  â””Glue.zrange_to_reflective -----------   0.0%   7.8%       1    4.484s
+  â””Glue.zrange_to_reflective_goal ------   1.7%   6.0%       1    3.464s
+  â””pose proof  (pf   :   Interpretation.   4.2%   4.2%       1    2.416s
+─synthesize ----------------------------   0.0%   5.4%       1    3.124s
+â””IntegrationTestTemporaryMiscCommon.do_r   0.0%   5.3%       1    3.040s
+â””change G' -----------------------------   5.2%   5.2%       1    2.964s
+
+src/Specific/solinas32_2e255m765_13limbs/femul (real: 181.77, user: 168.52, sys: 0.40, mem: 1589516 ko)
+COQC src/Specific/NISTP256/AMD64/femul.v
+Finished transaction in 119.257 secs (109.936u,0.256s) (successful)
+total time:    110.140s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.1%       1  106.964s
+─ReflectiveTactics.do_reflective_pipelin  -0.0%  96.4%       1  106.196s
+─ReflectiveTactics.solve_side_conditions   0.0%  96.2%       1  105.992s
+─ReflectiveTactics.do_reify ------------  -0.0%  83.7%       1   92.208s
+─Reify.Reify_rhs_gen -------------------   0.7%  83.5%       1   91.960s
+─Reify.do_reify_abs_goal ---------------  77.7%  77.8%       2   85.708s
+─Reify.do_reifyf_goal ------------------  77.4%  77.5%     901   85.364s
+─eexact --------------------------------  17.9%  17.9%     903    0.136s
+─ReflectiveTactics.solve_post_reified_si   0.3%  12.5%       1   13.784s
+─UnifyAbstractReflexivity.unify_transfor   9.8%  11.2%       7    3.356s
+─synthesize_montgomery -----------------   0.0%   2.9%       1    3.176s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.1%       1  106.964s
+â””ReflectiveTactics.do_reflective_pipelin  -0.0%  96.4%       1  106.196s
+â””ReflectiveTactics.solve_side_conditions   0.0%  96.2%       1  105.992s
+ ├─ReflectiveTactics.do_reify ----------  -0.0%  83.7%       1   92.208s
+ │└Reify.Reify_rhs_gen -----------------   0.7%  83.5%       1   91.960s
+ │└Reify.do_reify_abs_goal -------------  77.7%  77.8%       2   85.708s
+ │└Reify.do_reifyf_goal ----------------  77.4%  77.5%     901   85.364s
+ │└eexact ------------------------------  17.7%  17.7%     901    0.136s
+ └─ReflectiveTactics.solve_post_reified_   0.3%  12.5%       1   13.784s
+  â””UnifyAbstractReflexivity.unify_transf   9.8%  11.2%       7    3.356s
+─synthesize_montgomery -----------------   0.0%   2.9%       1    3.176s
+
+Finished transaction in 61.452 secs (58.503u,0.055s) (successful)
+Closed under the global context
+total time:    110.140s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.1%       1  106.964s
+─ReflectiveTactics.do_reflective_pipelin  -0.0%  96.4%       1  106.196s
+─ReflectiveTactics.solve_side_conditions   0.0%  96.2%       1  105.992s
+─ReflectiveTactics.do_reify ------------  -0.0%  83.7%       1   92.208s
+─Reify.Reify_rhs_gen -------------------   0.7%  83.5%       1   91.960s
+─Reify.do_reify_abs_goal ---------------  77.7%  77.8%       2   85.708s
+─Reify.do_reifyf_goal ------------------  77.4%  77.5%     901   85.364s
+─eexact --------------------------------  17.9%  17.9%     903    0.136s
+─ReflectiveTactics.solve_post_reified_si   0.3%  12.5%       1   13.784s
+─UnifyAbstractReflexivity.unify_transfor   9.8%  11.2%       7    3.356s
+─synthesize_montgomery -----------------   0.0%   2.9%       1    3.176s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.1%       1  106.964s
+â””ReflectiveTactics.do_reflective_pipelin  -0.0%  96.4%       1  106.196s
+â””ReflectiveTactics.solve_side_conditions   0.0%  96.2%       1  105.992s
+ ├─ReflectiveTactics.do_reify ----------  -0.0%  83.7%       1   92.208s
+ │└Reify.Reify_rhs_gen -----------------   0.7%  83.5%       1   91.960s
+ │└Reify.do_reify_abs_goal -------------  77.7%  77.8%       2   85.708s
+ │└Reify.do_reifyf_goal ----------------  77.4%  77.5%     901   85.364s
+ │└eexact ------------------------------  17.7%  17.7%     901    0.136s
+ └─ReflectiveTactics.solve_post_reified_   0.3%  12.5%       1   13.784s
+  â””UnifyAbstractReflexivity.unify_transf   9.8%  11.2%       7    3.356s
+─synthesize_montgomery -----------------   0.0%   2.9%       1    3.176s
+
+src/Specific/NISTP256/AMD64/femul (real: 202.96, user: 189.62, sys: 0.64, mem: 3302508 ko)
+COQC src/Specific/NISTP256/AMD64/femulDisplay > src/Specific/NISTP256/AMD64/femulDisplay.log
+COQC src/Specific/X25519/C64/ladderstep.v
+total time:     52.080s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_xzladderstep ---------------   0.0% 100.0%       1   52.080s
+─Pipeline.refine_reflectively_gen ------   0.0%  98.5%       1   51.320s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  93.8%       1   48.872s
+─ReflectiveTactics.solve_side_conditions   0.0%  93.7%       1   48.776s
+─ReflectiveTactics.solve_post_reified_si   0.2%  56.5%       1   29.412s
+─UnifyAbstractReflexivity.unify_transfor  44.7%  49.1%       7    6.968s
+─ReflectiveTactics.do_reify ------------   0.0%  37.2%       1   19.364s
+─Reify.Reify_rhs_gen -------------------   2.1%  23.4%       1   12.200s
+─Reify.do_reifyf_goal ------------------  11.2%  11.3%     138    1.884s
+─Compilers.Reify.reify_context_variables   0.1%   9.2%       1    4.808s
+─rewrite H -----------------------------   7.3%   7.3%       1    3.816s
+─ReflectiveTactics.unify_abstract_cbv_in   4.7%   6.4%       1    3.336s
+─Glue.refine_to_reflective_glue' -------   0.0%   4.7%       1    2.448s
+─Glue.zrange_to_reflective -------------   0.0%   4.0%       1    2.068s
+─Reify.transitivity_tt -----------------   0.1%   3.7%       2    0.984s
+─transitivity --------------------------   3.5%   3.5%      10    0.880s
+─reflexivity ---------------------------   3.4%   3.4%      11    0.772s
+─Glue.zrange_to_reflective_goal --------   2.4%   3.3%       1    1.728s
+─eexact --------------------------------   3.2%   3.2%     140    0.032s
+─unify (constr) (constr) ---------------   3.1%   3.1%       6    0.852s
+─clear (var_list) ----------------------   3.1%   3.1%      98    0.584s
+─UnfoldArg.unfold_second_arg -----------   0.4%   3.0%       2    1.576s
+─tac -----------------------------------   2.1%   3.0%       2    1.564s
+─ClearAll.clear_all --------------------   0.2%   2.8%       7    0.584s
+─ChangeInAll.change_with_compute_in_all    0.0%   2.6%     221    0.012s
+─change c with c' in * -----------------   2.5%   2.5%     221    0.012s
+─Reify.do_reify_abs_goal ---------------   2.4%   2.5%       2    1.276s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_xzladderstep ---------------   0.0% 100.0%       1   52.080s
+â””Pipeline.refine_reflectively_gen ------   0.0%  98.5%       1   51.320s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  93.8%       1   48.872s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  93.7%       1   48.776s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.2%  56.5%       1   29.412s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  44.7%  49.1%       7    6.968s
+ │ │ │└ClearAll.clear_all --------------   0.2%   2.8%       7    0.584s
+ │ │ │└clear (var_list) ----------------   2.7%   2.7%      65    0.584s
+ │ │ └─ReflectiveTactics.unify_abstract_   4.7%   6.4%       1    3.336s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  37.2%       1   19.364s
+ │   ├─Reify.Reify_rhs_gen -------------   2.1%  23.4%       1   12.200s
+ │   │ ├─rewrite H ---------------------   7.3%   7.3%       1    3.816s
+ │   │ ├─Reify.transitivity_tt ---------   0.1%   3.7%       2    0.984s
+ │   │ │└transitivity ------------------   3.4%   3.4%       4    0.880s
+ │   │ ├─tac ---------------------------   2.1%   3.0%       1    1.564s
+ │   │ └─Reify.do_reify_abs_goal -------   2.4%   2.5%       2    1.276s
+ │   │  └Reify.do_reifyf_goal ----------   2.2%   2.2%      25    1.148s
+ │   ├─Compilers.Reify.reify_context_var   0.1%   9.2%       1    4.808s
+ │   │└Reify.do_reifyf_goal ------------   9.0%   9.1%     113    1.884s
+ │   │└eexact --------------------------   2.4%   2.4%     113    0.032s
+ │   └─UnfoldArg.unfold_second_arg -----   0.4%   3.0%       2    1.576s
+ │    └ChangeInAll.change_with_compute_i   0.0%   2.6%     221    0.012s
+ │    └change c with c' in * -----------   2.5%   2.5%     221    0.012s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   4.7%       1    2.448s
+  â””Glue.zrange_to_reflective -----------   0.0%   4.0%       1    2.068s
+  â””Glue.zrange_to_reflective_goal ------   2.4%   3.3%       1    1.728s
+
+Finished transaction in 171.122 secs (161.392u,0.039s) (successful)
+Closed under the global context
+total time:     52.080s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_xzladderstep ---------------   0.0% 100.0%       1   52.080s
+─Pipeline.refine_reflectively_gen ------   0.0%  98.5%       1   51.320s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  93.8%       1   48.872s
+─ReflectiveTactics.solve_side_conditions   0.0%  93.7%       1   48.776s
+─ReflectiveTactics.solve_post_reified_si   0.2%  56.5%       1   29.412s
+─UnifyAbstractReflexivity.unify_transfor  44.7%  49.1%       7    6.968s
+─ReflectiveTactics.do_reify ------------   0.0%  37.2%       1   19.364s
+─Reify.Reify_rhs_gen -------------------   2.1%  23.4%       1   12.200s
+─Reify.do_reifyf_goal ------------------  11.2%  11.3%     138    1.884s
+─Compilers.Reify.reify_context_variables   0.1%   9.2%       1    4.808s
+─rewrite H -----------------------------   7.3%   7.3%       1    3.816s
+─ReflectiveTactics.unify_abstract_cbv_in   4.7%   6.4%       1    3.336s
+─Glue.refine_to_reflective_glue' -------   0.0%   4.7%       1    2.448s
+─Glue.zrange_to_reflective -------------   0.0%   4.0%       1    2.068s
+─Reify.transitivity_tt -----------------   0.1%   3.7%       2    0.984s
+─transitivity --------------------------   3.5%   3.5%      10    0.880s
+─reflexivity ---------------------------   3.4%   3.4%      11    0.772s
+─Glue.zrange_to_reflective_goal --------   2.4%   3.3%       1    1.728s
+─eexact --------------------------------   3.2%   3.2%     140    0.032s
+─unify (constr) (constr) ---------------   3.1%   3.1%       6    0.852s
+─clear (var_list) ----------------------   3.1%   3.1%      98    0.584s
+─UnfoldArg.unfold_second_arg -----------   0.4%   3.0%       2    1.576s
+─tac -----------------------------------   2.1%   3.0%       2    1.564s
+─ClearAll.clear_all --------------------   0.2%   2.8%       7    0.584s
+─ChangeInAll.change_with_compute_in_all    0.0%   2.6%     221    0.012s
+─change c with c' in * -----------------   2.5%   2.5%     221    0.012s
+─Reify.do_reify_abs_goal ---------------   2.4%   2.5%       2    1.276s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_xzladderstep ---------------   0.0% 100.0%       1   52.080s
+â””Pipeline.refine_reflectively_gen ------   0.0%  98.5%       1   51.320s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  93.8%       1   48.872s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  93.7%       1   48.776s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.2%  56.5%       1   29.412s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  44.7%  49.1%       7    6.968s
+ │ │ │└ClearAll.clear_all --------------   0.2%   2.8%       7    0.584s
+ │ │ │└clear (var_list) ----------------   2.7%   2.7%      65    0.584s
+ │ │ └─ReflectiveTactics.unify_abstract_   4.7%   6.4%       1    3.336s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  37.2%       1   19.364s
+ │   ├─Reify.Reify_rhs_gen -------------   2.1%  23.4%       1   12.200s
+ │   │ ├─rewrite H ---------------------   7.3%   7.3%       1    3.816s
+ │   │ ├─Reify.transitivity_tt ---------   0.1%   3.7%       2    0.984s
+ │   │ │└transitivity ------------------   3.4%   3.4%       4    0.880s
+ │   │ ├─tac ---------------------------   2.1%   3.0%       1    1.564s
+ │   │ └─Reify.do_reify_abs_goal -------   2.4%   2.5%       2    1.276s
+ │   │  └Reify.do_reifyf_goal ----------   2.2%   2.2%      25    1.148s
+ │   ├─Compilers.Reify.reify_context_var   0.1%   9.2%       1    4.808s
+ │   │└Reify.do_reifyf_goal ------------   9.0%   9.1%     113    1.884s
+ │   │└eexact --------------------------   2.4%   2.4%     113    0.032s
+ │   └─UnfoldArg.unfold_second_arg -----   0.4%   3.0%       2    1.576s
+ │    └ChangeInAll.change_with_compute_i   0.0%   2.6%     221    0.012s
+ │    └change c with c' in * -----------   2.5%   2.5%     221    0.012s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   4.7%       1    2.448s
+  â””Glue.zrange_to_reflective -----------   0.0%   4.0%       1    2.068s
+  â””Glue.zrange_to_reflective_goal ------   2.4%   3.3%       1    1.728s
+
+src/Specific/X25519/C64/ladderstep (real: 256.77, user: 241.34, sys: 0.45, mem: 1617000 ko)
+COQC src/Specific/X25519/C64/ladderstepDisplay > src/Specific/X25519/C64/ladderstepDisplay.log
diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-before.log.in b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-before.log.in
new file mode 100644
index 000000000..14102902b
--- /dev/null
+++ b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-before.log.in
@@ -0,0 +1,1662 @@
+COQDEP src/Compilers/Z/Bounds/Pipeline/Definition.v
+COQDEP src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics.v
+/home/jgross/.local64/coq/coq-master/bin/coq_makefile -f _CoqProject INSTALLDEFAULTROOT = Crypto -o Makefile-old
+COQ_MAKEFILE -f _CoqProject > Makefile.coq
+make --no-print-directory -C coqprime
+make[1]: Nothing to be done for 'all'.
+ECHO > _CoqProject
+COQC src/Compilers/Z/Bounds/Pipeline/Definition.v
+src/Compilers/Z/Bounds/Pipeline/Definition (real: 7.40, user: 7.22, sys: 0.15, mem: 578344 ko)
+COQC src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics.v
+src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics (real: 1.73, user: 1.58, sys: 0.14, mem: 546112 ko)
+COQC src/Compilers/Z/Bounds/Pipeline.v
+src/Compilers/Z/Bounds/Pipeline (real: 1.18, user: 1.04, sys: 0.14, mem: 539160 ko)
+COQC src/Specific/Framework/SynthesisFramework.v
+src/Specific/Framework/SynthesisFramework (real: 1.95, user: 1.72, sys: 0.22, mem: 648632 ko)
+COQC src/Specific/X25519/C64/Synthesis.v
+src/Specific/X25519/C64/Synthesis (real: 11.23, user: 10.30, sys: 0.19, mem: 687812 ko)
+COQC src/Specific/NISTP256/AMD64/Synthesis.v
+src/Specific/NISTP256/AMD64/Synthesis (real: 13.74, user: 12.54, sys: 0.23, mem: 667664 ko)
+COQC src/Specific/X25519/C64/feadd.v
+Finished transaction in 2.852 secs (2.699u,0.012s) (successful)
+total time:      2.664s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.4%       1    2.596s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  70.9%       1    1.888s
+─ReflectiveTactics.solve_side_conditions   0.0%  69.5%       1    1.852s
+─ReflectiveTactics.solve_post_reified_si   1.4%  43.7%       1    1.164s
+─UnifyAbstractReflexivity.unify_transfor  27.0%  31.7%       8    0.256s
+─Glue.refine_to_reflective_glue' -------   0.0%  26.6%       1    0.708s
+─ReflectiveTactics.do_reify ------------   0.0%  25.8%       1    0.688s
+─Reify.Reify_rhs_gen -------------------   2.0%  24.0%       1    0.640s
+─Glue.zrange_to_reflective -------------   0.0%  17.9%       1    0.476s
+─Glue.zrange_to_reflective_goal --------   8.1%  13.1%       1    0.348s
+─Reify.do_reify_abs_goal ---------------  12.8%  12.9%       2    0.344s
+─Reify.do_reifyf_goal ------------------  11.7%  11.9%      16    0.316s
+─ReflectiveTactics.unify_abstract_cbv_in   7.7%  10.2%       1    0.272s
+─unify (constr) (constr) ---------------   6.0%   6.0%       7    0.064s
+─Glue.pattern_sig_sig_assoc ------------   0.0%   5.0%       1    0.132s
+─assert (H : is_bounded_by' bounds (map'   4.5%   4.7%       2    0.068s
+─Glue.pattern_proj1_sig_in_sig ---------   1.5%   4.7%       1    0.124s
+─pose proof  (pf   :   Interpretation.Bo   3.3%   3.3%       1    0.088s
+─Glue.split_BoundedWordToZ -------------   0.2%   3.0%       1    0.080s
+─destruct x ----------------------------   2.7%   2.7%       4    0.032s
+─clearbody (ne_var_list) ---------------   2.7%   2.7%       4    0.056s
+─destruct_sig --------------------------   0.0%   2.7%       4    0.040s
+─synthesize ----------------------------   0.0%   2.6%       1    0.068s
+─prove_interp_compile_correct ----------   0.0%   2.4%       1    0.064s
+─reflexivity ---------------------------   2.3%   2.3%       7    0.028s
+─rewrite ?EtaInterp.InterpExprEta ------   2.3%   2.3%       1    0.060s
+─ClearbodyAll.clearbody_all ------------   0.0%   2.1%       2    0.056s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.4%       1    2.596s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  70.9%       1    1.888s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  69.5%       1    1.852s
+ │ ├─ReflectiveTactics.solve_post_reifie   1.4%  43.7%       1    1.164s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  27.0%  31.7%       8    0.256s
+ │ │ │└unify (constr) (constr) ---------   3.6%   3.6%       6    0.028s
+ │ │ └─ReflectiveTactics.unify_abstract_   7.7%  10.2%       1    0.272s
+ │ │  └unify (constr) (constr) ---------   2.4%   2.4%       1    0.064s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  25.8%       1    0.688s
+ │  └Reify.Reify_rhs_gen ---------------   2.0%  24.0%       1    0.640s
+ │   ├─Reify.do_reify_abs_goal ---------  12.8%  12.9%       2    0.344s
+ │   │└Reify.do_reifyf_goal ------------  11.7%  11.9%      16    0.316s
+ │   └─prove_interp_compile_correct ----   0.0%   2.4%       1    0.064s
+ │    └rewrite ?EtaInterp.InterpExprEta    2.3%   2.3%       1    0.060s
+ └─Glue.refine_to_reflective_glue' -----   0.0%  26.6%       1    0.708s
+   ├─Glue.zrange_to_reflective ---------   0.0%  17.9%       1    0.476s
+   │ ├─Glue.zrange_to_reflective_goal --   8.1%  13.1%       1    0.348s
+   │ │└pose proof  (pf   :   Interpretat   3.3%   3.3%       1    0.088s
+   │ └─assert (H : is_bounded_by' bounds   4.5%   4.7%       2    0.068s
+   ├─Glue.pattern_sig_sig_assoc --------   0.0%   5.0%       1    0.132s
+   │└Glue.pattern_proj1_sig_in_sig -----   1.5%   4.7%       1    0.124s
+   │└ClearbodyAll.clearbody_all --------   0.0%   2.1%       2    0.056s
+   │└clearbody (ne_var_list) -----------   2.1%   2.1%       1    0.056s
+   └─Glue.split_BoundedWordToZ ---------   0.2%   3.0%       1    0.080s
+    â””destruct_sig ----------------------   0.0%   2.7%       4    0.040s
+    â””destruct x ------------------------   2.1%   2.1%       2    0.032s
+─synthesize ----------------------------   0.0%   2.6%       1    0.068s
+
+Finished transaction in 5.46 secs (5.068u,0.003s) (successful)
+Closed under the global context
+total time:      2.664s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.4%       1    2.596s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  70.9%       1    1.888s
+─ReflectiveTactics.solve_side_conditions   0.0%  69.5%       1    1.852s
+─ReflectiveTactics.solve_post_reified_si   1.4%  43.7%       1    1.164s
+─UnifyAbstractReflexivity.unify_transfor  27.0%  31.7%       8    0.256s
+─Glue.refine_to_reflective_glue' -------   0.0%  26.6%       1    0.708s
+─ReflectiveTactics.do_reify ------------   0.0%  25.8%       1    0.688s
+─Reify.Reify_rhs_gen -------------------   2.0%  24.0%       1    0.640s
+─Glue.zrange_to_reflective -------------   0.0%  17.9%       1    0.476s
+─Glue.zrange_to_reflective_goal --------   8.1%  13.1%       1    0.348s
+─Reify.do_reify_abs_goal ---------------  12.8%  12.9%       2    0.344s
+─Reify.do_reifyf_goal ------------------  11.7%  11.9%      16    0.316s
+─ReflectiveTactics.unify_abstract_cbv_in   7.7%  10.2%       1    0.272s
+─unify (constr) (constr) ---------------   6.0%   6.0%       7    0.064s
+─Glue.pattern_sig_sig_assoc ------------   0.0%   5.0%       1    0.132s
+─assert (H : is_bounded_by' bounds (map'   4.5%   4.7%       2    0.068s
+─Glue.pattern_proj1_sig_in_sig ---------   1.5%   4.7%       1    0.124s
+─pose proof  (pf   :   Interpretation.Bo   3.3%   3.3%       1    0.088s
+─Glue.split_BoundedWordToZ -------------   0.2%   3.0%       1    0.080s
+─destruct x ----------------------------   2.7%   2.7%       4    0.032s
+─clearbody (ne_var_list) ---------------   2.7%   2.7%       4    0.056s
+─destruct_sig --------------------------   0.0%   2.7%       4    0.040s
+─synthesize ----------------------------   0.0%   2.6%       1    0.068s
+─prove_interp_compile_correct ----------   0.0%   2.4%       1    0.064s
+─reflexivity ---------------------------   2.3%   2.3%       7    0.028s
+─rewrite ?EtaInterp.InterpExprEta ------   2.3%   2.3%       1    0.060s
+─ClearbodyAll.clearbody_all ------------   0.0%   2.1%       2    0.056s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.4%       1    2.596s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  70.9%       1    1.888s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  69.5%       1    1.852s
+ │ ├─ReflectiveTactics.solve_post_reifie   1.4%  43.7%       1    1.164s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  27.0%  31.7%       8    0.256s
+ │ │ │└unify (constr) (constr) ---------   3.6%   3.6%       6    0.028s
+ │ │ └─ReflectiveTactics.unify_abstract_   7.7%  10.2%       1    0.272s
+ │ │  └unify (constr) (constr) ---------   2.4%   2.4%       1    0.064s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  25.8%       1    0.688s
+ │  └Reify.Reify_rhs_gen ---------------   2.0%  24.0%       1    0.640s
+ │   ├─Reify.do_reify_abs_goal ---------  12.8%  12.9%       2    0.344s
+ │   │└Reify.do_reifyf_goal ------------  11.7%  11.9%      16    0.316s
+ │   └─prove_interp_compile_correct ----   0.0%   2.4%       1    0.064s
+ │    └rewrite ?EtaInterp.InterpExprEta    2.3%   2.3%       1    0.060s
+ └─Glue.refine_to_reflective_glue' -----   0.0%  26.6%       1    0.708s
+   ├─Glue.zrange_to_reflective ---------   0.0%  17.9%       1    0.476s
+   │ ├─Glue.zrange_to_reflective_goal --   8.1%  13.1%       1    0.348s
+   │ │└pose proof  (pf   :   Interpretat   3.3%   3.3%       1    0.088s
+   │ └─assert (H : is_bounded_by' bounds   4.5%   4.7%       2    0.068s
+   ├─Glue.pattern_sig_sig_assoc --------   0.0%   5.0%       1    0.132s
+   │└Glue.pattern_proj1_sig_in_sig -----   1.5%   4.7%       1    0.124s
+   │└ClearbodyAll.clearbody_all --------   0.0%   2.1%       2    0.056s
+   │└clearbody (ne_var_list) -----------   2.1%   2.1%       1    0.056s
+   └─Glue.split_BoundedWordToZ ---------   0.2%   3.0%       1    0.080s
+    â””destruct_sig ----------------------   0.0%   2.7%       4    0.040s
+    â””destruct x ------------------------   2.1%   2.1%       2    0.032s
+─synthesize ----------------------------   0.0%   2.6%       1    0.068s
+
+src/Specific/X25519/C64/feadd (real: 23.43, user: 21.41, sys: 0.26, mem: 766168 ko)
+COQC src/Specific/solinas32_2e255m765_12limbs/Synthesis.v
+src/Specific/solinas32_2e255m765_12limbs/Synthesis (real: 39.53, user: 36.64, sys: 0.21, mem: 729464 ko)
+COQC src/Specific/X25519/C64/fecarry.v
+Finished transaction in 4.798 secs (4.375u,0.003s) (successful)
+total time:      4.332s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.1%  99.0%       1    4.288s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  89.2%       1    3.864s
+─ReflectiveTactics.solve_side_conditions   0.0%  88.1%       1    3.816s
+─ReflectiveTactics.do_reify ------------   0.0%  53.2%       1    2.304s
+─Reify.Reify_rhs_gen -------------------   1.8%  52.6%       1    2.280s
+─ReflectiveTactics.solve_post_reified_si   0.6%  34.9%       1    1.512s
+─Reify.do_reify_abs_goal ---------------  33.5%  33.9%       2    1.468s
+─Reify.do_reifyf_goal ------------------  32.1%  32.5%      29    1.408s
+─UnifyAbstractReflexivity.unify_transfor  22.5%  27.1%       8    0.316s
+─Glue.refine_to_reflective_glue' -------   0.1%   9.7%       1    0.420s
+─eexact --------------------------------   9.3%   9.3%      31    0.024s
+─ReflectiveTactics.unify_abstract_cbv_in   5.2%   7.0%       1    0.304s
+─Glue.zrange_to_reflective -------------   0.1%   6.2%       1    0.268s
+─prove_interp_compile_correct ----------   0.0%   5.6%       1    0.244s
+─rewrite ?EtaInterp.InterpExprEta ------   5.3%   5.3%       1    0.228s
+─unify (constr) (constr) ---------------   5.3%   5.3%       7    0.076s
+─Glue.zrange_to_reflective_goal --------   4.0%   4.9%       1    0.212s
+─rewrite H -----------------------------   3.4%   3.4%       1    0.148s
+─tac -----------------------------------   1.8%   2.6%       2    0.112s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.1%  99.0%       1    4.288s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  89.2%       1    3.864s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  88.1%       1    3.816s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  53.2%       1    2.304s
+ │ │└Reify.Reify_rhs_gen ---------------   1.8%  52.6%       1    2.280s
+ │ │ ├─Reify.do_reify_abs_goal ---------  33.5%  33.9%       2    1.468s
+ │ │ │└Reify.do_reifyf_goal ------------  32.1%  32.5%      29    1.408s
+ │ │ │└eexact --------------------------   8.6%   8.6%      29    0.024s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   5.6%       1    0.244s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    5.3%   5.3%       1    0.228s
+ │ │ ├─rewrite H -----------------------   3.4%   3.4%       1    0.148s
+ │ │ └─tac -----------------------------   1.8%   2.6%       1    0.112s
+ │ └─ReflectiveTactics.solve_post_reifie   0.6%  34.9%       1    1.512s
+ │   ├─UnifyAbstractReflexivity.unify_tr  22.5%  27.1%       8    0.316s
+ │   │└unify (constr) (constr) ---------   3.5%   3.5%       6    0.044s
+ │   └─ReflectiveTactics.unify_abstract_   5.2%   7.0%       1    0.304s
+ └─Glue.refine_to_reflective_glue' -----   0.1%   9.7%       1    0.420s
+  â””Glue.zrange_to_reflective -----------   0.1%   6.2%       1    0.268s
+  â””Glue.zrange_to_reflective_goal ------   4.0%   4.9%       1    0.212s
+
+Finished transaction in 8.342 secs (7.604u,0.008s) (successful)
+Closed under the global context
+total time:      4.332s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.1%  99.0%       1    4.288s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  89.2%       1    3.864s
+─ReflectiveTactics.solve_side_conditions   0.0%  88.1%       1    3.816s
+─ReflectiveTactics.do_reify ------------   0.0%  53.2%       1    2.304s
+─Reify.Reify_rhs_gen -------------------   1.8%  52.6%       1    2.280s
+─ReflectiveTactics.solve_post_reified_si   0.6%  34.9%       1    1.512s
+─Reify.do_reify_abs_goal ---------------  33.5%  33.9%       2    1.468s
+─Reify.do_reifyf_goal ------------------  32.1%  32.5%      29    1.408s
+─UnifyAbstractReflexivity.unify_transfor  22.5%  27.1%       8    0.316s
+─Glue.refine_to_reflective_glue' -------   0.1%   9.7%       1    0.420s
+─eexact --------------------------------   9.3%   9.3%      31    0.024s
+─ReflectiveTactics.unify_abstract_cbv_in   5.2%   7.0%       1    0.304s
+─Glue.zrange_to_reflective -------------   0.1%   6.2%       1    0.268s
+─prove_interp_compile_correct ----------   0.0%   5.6%       1    0.244s
+─rewrite ?EtaInterp.InterpExprEta ------   5.3%   5.3%       1    0.228s
+─unify (constr) (constr) ---------------   5.3%   5.3%       7    0.076s
+─Glue.zrange_to_reflective_goal --------   4.0%   4.9%       1    0.212s
+─rewrite H -----------------------------   3.4%   3.4%       1    0.148s
+─tac -----------------------------------   1.8%   2.6%       2    0.112s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.1%  99.0%       1    4.288s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  89.2%       1    3.864s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  88.1%       1    3.816s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  53.2%       1    2.304s
+ │ │└Reify.Reify_rhs_gen ---------------   1.8%  52.6%       1    2.280s
+ │ │ ├─Reify.do_reify_abs_goal ---------  33.5%  33.9%       2    1.468s
+ │ │ │└Reify.do_reifyf_goal ------------  32.1%  32.5%      29    1.408s
+ │ │ │└eexact --------------------------   8.6%   8.6%      29    0.024s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   5.6%       1    0.244s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    5.3%   5.3%       1    0.228s
+ │ │ ├─rewrite H -----------------------   3.4%   3.4%       1    0.148s
+ │ │ └─tac -----------------------------   1.8%   2.6%       1    0.112s
+ │ └─ReflectiveTactics.solve_post_reifie   0.6%  34.9%       1    1.512s
+ │   ├─UnifyAbstractReflexivity.unify_tr  22.5%  27.1%       8    0.316s
+ │   │└unify (constr) (constr) ---------   3.5%   3.5%       6    0.044s
+ │   └─ReflectiveTactics.unify_abstract_   5.2%   7.0%       1    0.304s
+ └─Glue.refine_to_reflective_glue' -----   0.1%   9.7%       1    0.420s
+  â””Glue.zrange_to_reflective -----------   0.1%   6.2%       1    0.268s
+  â””Glue.zrange_to_reflective_goal ------   4.0%   4.9%       1    0.212s
+
+src/Specific/X25519/C64/fecarry (real: 28.85, user: 26.31, sys: 0.25, mem: 787148 ko)
+COQC src/Specific/solinas32_2e255m765_13limbs/Synthesis.v
+src/Specific/solinas32_2e255m765_13limbs/Synthesis (real: 49.50, user: 45.58, sys: 0.18, mem: 744472 ko)
+COQC src/Specific/X25519/C64/femul.v
+Finished transaction in 9.325 secs (8.62u,0.016s) (successful)
+total time:      8.576s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  95.8%       1    8.220s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  87.7%       1    7.524s
+─ReflectiveTactics.solve_side_conditions   0.0%  87.0%       1    7.460s
+─ReflectiveTactics.do_reify ------------   0.0%  43.8%       1    3.760s
+─ReflectiveTactics.solve_post_reified_si   0.6%  43.1%       1    3.700s
+─Reify.Reify_rhs_gen -------------------   1.4%  43.0%       1    3.688s
+─UnifyAbstractReflexivity.unify_transfor  31.1%  36.7%       8    1.096s
+─Reify.do_reify_abs_goal ---------------  26.3%  26.6%       2    2.284s
+─Reify.do_reifyf_goal ------------------  25.3%  25.6%      58    1.440s
+─Glue.refine_to_reflective_glue' -------   0.0%   8.1%       1    0.696s
+─eexact --------------------------------   7.6%   7.6%      60    0.032s
+─unify (constr) (constr) ---------------   5.8%   5.8%       7    0.128s
+─Glue.zrange_to_reflective -------------   0.0%   5.7%       1    0.488s
+─ReflectiveTactics.unify_abstract_cbv_in   3.8%   5.5%       1    0.468s
+─prove_interp_compile_correct ----------   0.0%   5.2%       1    0.448s
+─rewrite ?EtaInterp.InterpExprEta ------   4.9%   4.9%       1    0.416s
+─Glue.zrange_to_reflective_goal --------   2.6%   4.2%       1    0.364s
+─synthesize ----------------------------   0.0%   4.2%       1    0.356s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   3.8%       1    0.328s
+─rewrite H -----------------------------   3.2%   3.2%       1    0.276s
+─change G' -----------------------------   3.2%   3.2%       1    0.272s
+─tac -----------------------------------   1.4%   2.1%       2    0.180s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  95.8%       1    8.220s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  87.7%       1    7.524s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  87.0%       1    7.460s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  43.8%       1    3.760s
+ │ │└Reify.Reify_rhs_gen ---------------   1.4%  43.0%       1    3.688s
+ │ │ ├─Reify.do_reify_abs_goal ---------  26.3%  26.6%       2    2.284s
+ │ │ │└Reify.do_reifyf_goal ------------  25.3%  25.6%      58    1.440s
+ │ │ │└eexact --------------------------   6.9%   6.9%      58    0.032s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   5.2%       1    0.448s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    4.9%   4.9%       1    0.416s
+ │ │ ├─rewrite H -----------------------   3.2%   3.2%       1    0.276s
+ │ │ └─tac -----------------------------   1.4%   2.1%       1    0.180s
+ │ └─ReflectiveTactics.solve_post_reifie   0.6%  43.1%       1    3.700s
+ │   ├─UnifyAbstractReflexivity.unify_tr  31.1%  36.7%       8    1.096s
+ │   │└unify (constr) (constr) ---------   4.3%   4.3%       6    0.092s
+ │   └─ReflectiveTactics.unify_abstract_   3.8%   5.5%       1    0.468s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   8.1%       1    0.696s
+  â””Glue.zrange_to_reflective -----------   0.0%   5.7%       1    0.488s
+  â””Glue.zrange_to_reflective_goal ------   2.6%   4.2%       1    0.364s
+─synthesize ----------------------------   0.0%   4.2%       1    0.356s
+â””IntegrationTestTemporaryMiscCommon.do_r   0.0%   3.8%       1    0.328s
+â””change G' -----------------------------   3.2%   3.2%       1    0.272s
+
+Finished transaction in 16.611 secs (15.352u,0.s) (successful)
+Closed under the global context
+total time:      8.576s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  95.8%       1    8.220s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  87.7%       1    7.524s
+─ReflectiveTactics.solve_side_conditions   0.0%  87.0%       1    7.460s
+─ReflectiveTactics.do_reify ------------   0.0%  43.8%       1    3.760s
+─ReflectiveTactics.solve_post_reified_si   0.6%  43.1%       1    3.700s
+─Reify.Reify_rhs_gen -------------------   1.4%  43.0%       1    3.688s
+─UnifyAbstractReflexivity.unify_transfor  31.1%  36.7%       8    1.096s
+─Reify.do_reify_abs_goal ---------------  26.3%  26.6%       2    2.284s
+─Reify.do_reifyf_goal ------------------  25.3%  25.6%      58    1.440s
+─Glue.refine_to_reflective_glue' -------   0.0%   8.1%       1    0.696s
+─eexact --------------------------------   7.6%   7.6%      60    0.032s
+─unify (constr) (constr) ---------------   5.8%   5.8%       7    0.128s
+─Glue.zrange_to_reflective -------------   0.0%   5.7%       1    0.488s
+─ReflectiveTactics.unify_abstract_cbv_in   3.8%   5.5%       1    0.468s
+─prove_interp_compile_correct ----------   0.0%   5.2%       1    0.448s
+─rewrite ?EtaInterp.InterpExprEta ------   4.9%   4.9%       1    0.416s
+─Glue.zrange_to_reflective_goal --------   2.6%   4.2%       1    0.364s
+─synthesize ----------------------------   0.0%   4.2%       1    0.356s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   3.8%       1    0.328s
+─rewrite H -----------------------------   3.2%   3.2%       1    0.276s
+─change G' -----------------------------   3.2%   3.2%       1    0.272s
+─tac -----------------------------------   1.4%   2.1%       2    0.180s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  95.8%       1    8.220s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  87.7%       1    7.524s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  87.0%       1    7.460s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  43.8%       1    3.760s
+ │ │└Reify.Reify_rhs_gen ---------------   1.4%  43.0%       1    3.688s
+ │ │ ├─Reify.do_reify_abs_goal ---------  26.3%  26.6%       2    2.284s
+ │ │ │└Reify.do_reifyf_goal ------------  25.3%  25.6%      58    1.440s
+ │ │ │└eexact --------------------------   6.9%   6.9%      58    0.032s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   5.2%       1    0.448s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    4.9%   4.9%       1    0.416s
+ │ │ ├─rewrite H -----------------------   3.2%   3.2%       1    0.276s
+ │ │ └─tac -----------------------------   1.4%   2.1%       1    0.180s
+ │ └─ReflectiveTactics.solve_post_reifie   0.6%  43.1%       1    3.700s
+ │   ├─UnifyAbstractReflexivity.unify_tr  31.1%  36.7%       8    1.096s
+ │   │└unify (constr) (constr) ---------   4.3%   4.3%       6    0.092s
+ │   └─ReflectiveTactics.unify_abstract_   3.8%   5.5%       1    0.468s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   8.1%       1    0.696s
+  â””Glue.zrange_to_reflective -----------   0.0%   5.7%       1    0.488s
+  â””Glue.zrange_to_reflective_goal ------   2.6%   4.2%       1    0.364s
+─synthesize ----------------------------   0.0%   4.2%       1    0.356s
+â””IntegrationTestTemporaryMiscCommon.do_r   0.0%   3.8%       1    0.328s
+â””change G' -----------------------------   3.2%   3.2%       1    0.272s
+
+src/Specific/X25519/C64/femul (real: 42.98, user: 39.50, sys: 0.29, mem: 839624 ko)
+COQC src/Specific/X25519/C64/feaddDisplay > src/Specific/X25519/C64/feaddDisplay.log
+COQC src/Specific/X25519/C64/fecarryDisplay > src/Specific/X25519/C64/fecarryDisplay.log
+COQC src/Specific/X25519/C64/fesub.v
+Finished transaction in 3.729 secs (3.48u,0.012s) (successful)
+total time:      3.444s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  98.0%       1    3.376s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  77.1%       1    2.656s
+─ReflectiveTactics.solve_side_conditions   0.0%  75.8%       1    2.612s
+─ReflectiveTactics.solve_post_reified_si   1.2%  40.1%       1    1.380s
+─ReflectiveTactics.do_reify ------------   0.0%  35.8%       1    1.232s
+─Reify.Reify_rhs_gen -------------------   1.4%  34.4%       1    1.184s
+─UnifyAbstractReflexivity.unify_transfor  25.7%  30.5%       8    0.324s
+─Glue.refine_to_reflective_glue' -------   0.0%  20.9%       1    0.720s
+─Reify.do_reify_abs_goal ---------------  18.5%  18.8%       2    0.648s
+─Reify.do_reifyf_goal ------------------  17.3%  17.5%      16    0.604s
+─Glue.zrange_to_reflective -------------   0.0%  14.2%       1    0.488s
+─Glue.zrange_to_reflective_goal --------   6.5%  10.6%       1    0.364s
+─ReflectiveTactics.unify_abstract_cbv_in   5.8%   8.0%       1    0.276s
+─unify (constr) (constr) ---------------   5.8%   5.8%       7    0.076s
+─eexact --------------------------------   4.4%   4.4%      18    0.012s
+─Glue.pattern_sig_sig_assoc ------------   0.0%   3.8%       1    0.132s
+─assert (H : is_bounded_by' bounds (map'   3.6%   3.6%       2    0.064s
+─Glue.pattern_proj1_sig_in_sig ---------   1.2%   3.6%       1    0.124s
+─prove_interp_compile_correct ----------   0.0%   3.5%       1    0.120s
+─rewrite H -----------------------------   3.4%   3.4%       1    0.116s
+─rewrite ?EtaInterp.InterpExprEta ------   3.1%   3.1%       1    0.108s
+─pose proof  (pf   :   Interpretation.Bo   2.7%   2.7%       1    0.092s
+─reflexivity ---------------------------   2.6%   2.6%       7    0.032s
+─Glue.split_BoundedWordToZ -------------   0.2%   2.4%       1    0.084s
+─tac -----------------------------------   1.7%   2.2%       2    0.076s
+─Reify.transitivity_tt -----------------   0.1%   2.2%       2    0.040s
+─transitivity --------------------------   2.1%   2.1%       5    0.032s
+─clearbody (ne_var_list) ---------------   2.1%   2.1%       4    0.056s
+─destruct_sig --------------------------   0.0%   2.1%       4    0.040s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  98.0%       1    3.376s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  77.1%       1    2.656s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  75.8%       1    2.612s
+ │ ├─ReflectiveTactics.solve_post_reifie   1.2%  40.1%       1    1.380s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  25.7%  30.5%       8    0.324s
+ │ │ │└unify (constr) (constr) ---------   3.6%   3.6%       6    0.040s
+ │ │ └─ReflectiveTactics.unify_abstract_   5.8%   8.0%       1    0.276s
+ │ │  └unify (constr) (constr) ---------   2.2%   2.2%       1    0.076s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  35.8%       1    1.232s
+ │  └Reify.Reify_rhs_gen ---------------   1.4%  34.4%       1    1.184s
+ │   ├─Reify.do_reify_abs_goal ---------  18.5%  18.8%       2    0.648s
+ │   │└Reify.do_reifyf_goal ------------  17.3%  17.5%      16    0.604s
+ │   │└eexact --------------------------   3.8%   3.8%      16    0.012s
+ │   ├─prove_interp_compile_correct ----   0.0%   3.5%       1    0.120s
+ │   │└rewrite ?EtaInterp.InterpExprEta    3.1%   3.1%       1    0.108s
+ │   ├─rewrite H -----------------------   3.4%   3.4%       1    0.116s
+ │   ├─tac -----------------------------   1.7%   2.2%       1    0.076s
+ │   └─Reify.transitivity_tt -----------   0.1%   2.2%       2    0.040s
+ └─Glue.refine_to_reflective_glue' -----   0.0%  20.9%       1    0.720s
+   ├─Glue.zrange_to_reflective ---------   0.0%  14.2%       1    0.488s
+   │ ├─Glue.zrange_to_reflective_goal --   6.5%  10.6%       1    0.364s
+   │ │└pose proof  (pf   :   Interpretat   2.7%   2.7%       1    0.092s
+   │ └─assert (H : is_bounded_by' bounds   3.6%   3.6%       2    0.064s
+   ├─Glue.pattern_sig_sig_assoc --------   0.0%   3.8%       1    0.132s
+   │└Glue.pattern_proj1_sig_in_sig -----   1.2%   3.6%       1    0.124s
+   └─Glue.split_BoundedWordToZ ---------   0.2%   2.4%       1    0.084s
+    â””destruct_sig ----------------------   0.0%   2.1%       4    0.040s
+
+Finished transaction in 6.763 secs (6.183u,0.s) (successful)
+Closed under the global context
+total time:      3.444s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  98.0%       1    3.376s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  77.1%       1    2.656s
+─ReflectiveTactics.solve_side_conditions   0.0%  75.8%       1    2.612s
+─ReflectiveTactics.solve_post_reified_si   1.2%  40.1%       1    1.380s
+─ReflectiveTactics.do_reify ------------   0.0%  35.8%       1    1.232s
+─Reify.Reify_rhs_gen -------------------   1.4%  34.4%       1    1.184s
+─UnifyAbstractReflexivity.unify_transfor  25.7%  30.5%       8    0.324s
+─Glue.refine_to_reflective_glue' -------   0.0%  20.9%       1    0.720s
+─Reify.do_reify_abs_goal ---------------  18.5%  18.8%       2    0.648s
+─Reify.do_reifyf_goal ------------------  17.3%  17.5%      16    0.604s
+─Glue.zrange_to_reflective -------------   0.0%  14.2%       1    0.488s
+─Glue.zrange_to_reflective_goal --------   6.5%  10.6%       1    0.364s
+─ReflectiveTactics.unify_abstract_cbv_in   5.8%   8.0%       1    0.276s
+─unify (constr) (constr) ---------------   5.8%   5.8%       7    0.076s
+─eexact --------------------------------   4.4%   4.4%      18    0.012s
+─Glue.pattern_sig_sig_assoc ------------   0.0%   3.8%       1    0.132s
+─assert (H : is_bounded_by' bounds (map'   3.6%   3.6%       2    0.064s
+─Glue.pattern_proj1_sig_in_sig ---------   1.2%   3.6%       1    0.124s
+─prove_interp_compile_correct ----------   0.0%   3.5%       1    0.120s
+─rewrite H -----------------------------   3.4%   3.4%       1    0.116s
+─rewrite ?EtaInterp.InterpExprEta ------   3.1%   3.1%       1    0.108s
+─pose proof  (pf   :   Interpretation.Bo   2.7%   2.7%       1    0.092s
+─reflexivity ---------------------------   2.6%   2.6%       7    0.032s
+─Glue.split_BoundedWordToZ -------------   0.2%   2.4%       1    0.084s
+─tac -----------------------------------   1.7%   2.2%       2    0.076s
+─Reify.transitivity_tt -----------------   0.1%   2.2%       2    0.040s
+─transitivity --------------------------   2.1%   2.1%       5    0.032s
+─clearbody (ne_var_list) ---------------   2.1%   2.1%       4    0.056s
+─destruct_sig --------------------------   0.0%   2.1%       4    0.040s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  98.0%       1    3.376s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  77.1%       1    2.656s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  75.8%       1    2.612s
+ │ ├─ReflectiveTactics.solve_post_reifie   1.2%  40.1%       1    1.380s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  25.7%  30.5%       8    0.324s
+ │ │ │└unify (constr) (constr) ---------   3.6%   3.6%       6    0.040s
+ │ │ └─ReflectiveTactics.unify_abstract_   5.8%   8.0%       1    0.276s
+ │ │  └unify (constr) (constr) ---------   2.2%   2.2%       1    0.076s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  35.8%       1    1.232s
+ │  └Reify.Reify_rhs_gen ---------------   1.4%  34.4%       1    1.184s
+ │   ├─Reify.do_reify_abs_goal ---------  18.5%  18.8%       2    0.648s
+ │   │└Reify.do_reifyf_goal ------------  17.3%  17.5%      16    0.604s
+ │   │└eexact --------------------------   3.8%   3.8%      16    0.012s
+ │   ├─prove_interp_compile_correct ----   0.0%   3.5%       1    0.120s
+ │   │└rewrite ?EtaInterp.InterpExprEta    3.1%   3.1%       1    0.108s
+ │   ├─rewrite H -----------------------   3.4%   3.4%       1    0.116s
+ │   ├─tac -----------------------------   1.7%   2.2%       1    0.076s
+ │   └─Reify.transitivity_tt -----------   0.1%   2.2%       2    0.040s
+ └─Glue.refine_to_reflective_glue' -----   0.0%  20.9%       1    0.720s
+   ├─Glue.zrange_to_reflective ---------   0.0%  14.2%       1    0.488s
+   │ ├─Glue.zrange_to_reflective_goal --   6.5%  10.6%       1    0.364s
+   │ │└pose proof  (pf   :   Interpretat   2.7%   2.7%       1    0.092s
+   │ └─assert (H : is_bounded_by' bounds   3.6%   3.6%       2    0.064s
+   ├─Glue.pattern_sig_sig_assoc --------   0.0%   3.8%       1    0.132s
+   │└Glue.pattern_proj1_sig_in_sig -----   1.2%   3.6%       1    0.124s
+   └─Glue.split_BoundedWordToZ ---------   0.2%   2.4%       1    0.084s
+    â””destruct_sig ----------------------   0.0%   2.1%       4    0.040s
+
+src/Specific/X25519/C64/fesub (real: 26.11, user: 23.72, sys: 0.24, mem: 781808 ko)
+COQC src/Specific/X25519/C64/fesquare.v
+Finished transaction in 6.477 secs (6.044u,0.008s) (successful)
+total time:      6.012s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize ----------------------------   0.0% 100.0%       1    6.012s
+─Pipeline.refine_reflectively_gen ------   0.0%  95.9%       1    5.764s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  89.6%       1    5.388s
+─ReflectiveTactics.solve_side_conditions   0.0%  88.8%       1    5.340s
+─ReflectiveTactics.do_reify ------------   0.0%  47.0%       1    2.828s
+─Reify.Reify_rhs_gen -------------------   1.5%  46.3%       1    2.784s
+─ReflectiveTactics.solve_post_reified_si   0.5%  41.8%       1    2.512s
+─UnifyAbstractReflexivity.unify_transfor  28.5%  34.1%       8    0.552s
+─Reify.do_reify_abs_goal ---------------  28.7%  29.1%       2    1.752s
+─Reify.do_reifyf_goal ------------------  27.6%  27.9%      47    1.320s
+─eexact --------------------------------   8.4%   8.4%      49    0.024s
+─ReflectiveTactics.unify_abstract_cbv_in   5.0%   6.9%       1    0.412s
+─unify (constr) (constr) ---------------   6.3%   6.3%       7    0.104s
+─Glue.refine_to_reflective_glue' -------   0.0%   6.3%       1    0.376s
+─prove_interp_compile_correct ----------   0.0%   5.3%       1    0.316s
+─rewrite ?EtaInterp.InterpExprEta ------   4.8%   4.8%       1    0.288s
+─Glue.zrange_to_reflective -------------   0.0%   4.4%       1    0.264s
+─IntegrationTestTemporaryMiscCommon.do_r   0.1%   3.7%       1    0.224s
+─Glue.zrange_to_reflective_goal --------   2.6%   3.3%       1    0.196s
+─change G' -----------------------------   3.1%   3.1%       1    0.188s
+─rewrite H -----------------------------   3.0%   3.0%       1    0.180s
+─tac -----------------------------------   1.9%   2.7%       2    0.160s
+─reflexivity ---------------------------   2.4%   2.4%       7    0.060s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize ----------------------------   0.0% 100.0%       1    6.012s
+ ├─Pipeline.refine_reflectively_gen ----   0.0%  95.9%       1    5.764s
+ │ ├─ReflectiveTactics.do_reflective_pip   0.0%  89.6%       1    5.388s
+ │ │└ReflectiveTactics.solve_side_condit   0.0%  88.8%       1    5.340s
+ │ │ ├─ReflectiveTactics.do_reify ------   0.0%  47.0%       1    2.828s
+ │ │ │└Reify.Reify_rhs_gen -------------   1.5%  46.3%       1    2.784s
+ │ │ │ ├─Reify.do_reify_abs_goal -------  28.7%  29.1%       2    1.752s
+ │ │ │ │└Reify.do_reifyf_goal ----------  27.6%  27.9%      47    1.320s
+ │ │ │ │└eexact ------------------------   7.7%   7.7%      47    0.024s
+ │ │ │ ├─prove_interp_compile_correct --   0.0%   5.3%       1    0.316s
+ │ │ │ │└rewrite ?EtaInterp.InterpExprEt   4.8%   4.8%       1    0.288s
+ │ │ │ ├─rewrite H ---------------------   3.0%   3.0%       1    0.180s
+ │ │ │ └─tac ---------------------------   1.9%   2.7%       1    0.160s
+ │ │ └─ReflectiveTactics.solve_post_reif   0.5%  41.8%       1    2.512s
+ │ │   ├─UnifyAbstractReflexivity.unify_  28.5%  34.1%       8    0.552s
+ │ │   │└unify (constr) (constr) -------   4.6%   4.6%       6    0.076s
+ │ │   └─ReflectiveTactics.unify_abstrac   5.0%   6.9%       1    0.412s
+ │ └─Glue.refine_to_reflective_glue' ---   0.0%   6.3%       1    0.376s
+ │  └Glue.zrange_to_reflective ---------   0.0%   4.4%       1    0.264s
+ │  └Glue.zrange_to_reflective_goal ----   2.6%   3.3%       1    0.196s
+ └─IntegrationTestTemporaryMiscCommon.do   0.1%   3.7%       1    0.224s
+  â””change G' ---------------------------   3.1%   3.1%       1    0.188s
+
+Finished transaction in 12.356 secs (11.331u,0.004s) (successful)
+Closed under the global context
+total time:      6.012s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize ----------------------------   0.0% 100.0%       1    6.012s
+─Pipeline.refine_reflectively_gen ------   0.0%  95.9%       1    5.764s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  89.6%       1    5.388s
+─ReflectiveTactics.solve_side_conditions   0.0%  88.8%       1    5.340s
+─ReflectiveTactics.do_reify ------------   0.0%  47.0%       1    2.828s
+─Reify.Reify_rhs_gen -------------------   1.5%  46.3%       1    2.784s
+─ReflectiveTactics.solve_post_reified_si   0.5%  41.8%       1    2.512s
+─UnifyAbstractReflexivity.unify_transfor  28.5%  34.1%       8    0.552s
+─Reify.do_reify_abs_goal ---------------  28.7%  29.1%       2    1.752s
+─Reify.do_reifyf_goal ------------------  27.6%  27.9%      47    1.320s
+─eexact --------------------------------   8.4%   8.4%      49    0.024s
+─ReflectiveTactics.unify_abstract_cbv_in   5.0%   6.9%       1    0.412s
+─unify (constr) (constr) ---------------   6.3%   6.3%       7    0.104s
+─Glue.refine_to_reflective_glue' -------   0.0%   6.3%       1    0.376s
+─prove_interp_compile_correct ----------   0.0%   5.3%       1    0.316s
+─rewrite ?EtaInterp.InterpExprEta ------   4.8%   4.8%       1    0.288s
+─Glue.zrange_to_reflective -------------   0.0%   4.4%       1    0.264s
+─IntegrationTestTemporaryMiscCommon.do_r   0.1%   3.7%       1    0.224s
+─Glue.zrange_to_reflective_goal --------   2.6%   3.3%       1    0.196s
+─change G' -----------------------------   3.1%   3.1%       1    0.188s
+─rewrite H -----------------------------   3.0%   3.0%       1    0.180s
+─tac -----------------------------------   1.9%   2.7%       2    0.160s
+─reflexivity ---------------------------   2.4%   2.4%       7    0.060s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize ----------------------------   0.0% 100.0%       1    6.012s
+ ├─Pipeline.refine_reflectively_gen ----   0.0%  95.9%       1    5.764s
+ │ ├─ReflectiveTactics.do_reflective_pip   0.0%  89.6%       1    5.388s
+ │ │└ReflectiveTactics.solve_side_condit   0.0%  88.8%       1    5.340s
+ │ │ ├─ReflectiveTactics.do_reify ------   0.0%  47.0%       1    2.828s
+ │ │ │└Reify.Reify_rhs_gen -------------   1.5%  46.3%       1    2.784s
+ │ │ │ ├─Reify.do_reify_abs_goal -------  28.7%  29.1%       2    1.752s
+ │ │ │ │└Reify.do_reifyf_goal ----------  27.6%  27.9%      47    1.320s
+ │ │ │ │└eexact ------------------------   7.7%   7.7%      47    0.024s
+ │ │ │ ├─prove_interp_compile_correct --   0.0%   5.3%       1    0.316s
+ │ │ │ │└rewrite ?EtaInterp.InterpExprEt   4.8%   4.8%       1    0.288s
+ │ │ │ ├─rewrite H ---------------------   3.0%   3.0%       1    0.180s
+ │ │ │ └─tac ---------------------------   1.9%   2.7%       1    0.160s
+ │ │ └─ReflectiveTactics.solve_post_reif   0.5%  41.8%       1    2.512s
+ │ │   ├─UnifyAbstractReflexivity.unify_  28.5%  34.1%       8    0.552s
+ │ │   │└unify (constr) (constr) -------   4.6%   4.6%       6    0.076s
+ │ │   └─ReflectiveTactics.unify_abstrac   5.0%   6.9%       1    0.412s
+ │ └─Glue.refine_to_reflective_glue' ---   0.0%   6.3%       1    0.376s
+ │  └Glue.zrange_to_reflective ---------   0.0%   4.4%       1    0.264s
+ │  └Glue.zrange_to_reflective_goal ----   2.6%   3.3%       1    0.196s
+ └─IntegrationTestTemporaryMiscCommon.do   0.1%   3.7%       1    0.224s
+  â””change G' ---------------------------   3.1%   3.1%       1    0.188s
+
+src/Specific/X25519/C64/fesquare (real: 35.23, user: 32.24, sys: 0.26, mem: 802776 ko)
+COQC src/Specific/X25519/C64/femulDisplay > src/Specific/X25519/C64/femulDisplay.log
+COQC src/Specific/X25519/C64/freeze.v
+Finished transaction in 7.785 secs (7.139u,0.019s) (successful)
+total time:      7.112s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_freeze ---------------------  -0.0% 100.0%       1    7.112s
+─Pipeline.refine_reflectively_gen ------   0.0%  99.2%       1    7.056s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  92.8%       1    6.600s
+─ReflectiveTactics.solve_side_conditions  -0.0%  91.8%       1    6.532s
+─ReflectiveTactics.do_reify ------------   0.0%  57.1%       1    4.060s
+─Reify.Reify_rhs_gen -------------------   1.5%  56.4%       1    4.012s
+─Reify.do_reify_abs_goal ---------------  40.1%  40.3%       2    2.868s
+─Reify.do_reifyf_goal ------------------  39.1%  39.4%     129    2.800s
+─ReflectiveTactics.solve_post_reified_si   0.6%  34.8%       1    2.472s
+─UnifyAbstractReflexivity.unify_transfor  25.2%  29.4%       8    0.428s
+─eexact --------------------------------  12.9%  12.9%     131    0.028s
+─Glue.refine_to_reflective_glue' -------   0.1%   6.4%       1    0.456s
+─prove_interp_compile_correct ----------   0.0%   4.7%       1    0.332s
+─unify (constr) (constr) ---------------   4.6%   4.6%       7    0.096s
+─ReflectiveTactics.unify_abstract_cbv_in   3.1%   4.6%       1    0.324s
+─rewrite ?EtaInterp.InterpExprEta ------   4.3%   4.3%       1    0.308s
+─Glue.zrange_to_reflective -------------   0.0%   4.1%       1    0.292s
+─Glue.zrange_to_reflective_goal --------   2.6%   3.2%       1    0.228s
+─rewrite H -----------------------------   3.0%   3.0%       1    0.212s
+─reflexivity ---------------------------   2.3%   2.3%       7    0.064s
+─Reify.transitivity_tt -----------------   0.0%   2.1%       2    0.096s
+─transitivity --------------------------   2.1%   2.1%       5    0.084s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_freeze ---------------------  -0.0% 100.0%       1    7.112s
+â””Pipeline.refine_reflectively_gen ------   0.0%  99.2%       1    7.056s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  92.8%       1    6.600s
+ │└ReflectiveTactics.solve_side_conditio  -0.0%  91.8%       1    6.532s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  57.1%       1    4.060s
+ │ │└Reify.Reify_rhs_gen ---------------   1.5%  56.4%       1    4.012s
+ │ │ ├─Reify.do_reify_abs_goal ---------  40.1%  40.3%       2    2.868s
+ │ │ │└Reify.do_reifyf_goal ------------  39.1%  39.4%     129    2.800s
+ │ │ │└eexact --------------------------  12.4%  12.4%     129    0.028s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   4.7%       1    0.332s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    4.3%   4.3%       1    0.308s
+ │ │ ├─rewrite H -----------------------   3.0%   3.0%       1    0.212s
+ │ │ └─Reify.transitivity_tt -----------   0.0%   2.1%       2    0.096s
+ │ │  └transitivity --------------------   2.0%   2.0%       4    0.084s
+ │ └─ReflectiveTactics.solve_post_reifie   0.6%  34.8%       1    2.472s
+ │   ├─UnifyAbstractReflexivity.unify_tr  25.2%  29.4%       8    0.428s
+ │   │└unify (constr) (constr) ---------   3.2%   3.2%       6    0.068s
+ │   └─ReflectiveTactics.unify_abstract_   3.1%   4.6%       1    0.324s
+ └─Glue.refine_to_reflective_glue' -----   0.1%   6.4%       1    0.456s
+  â””Glue.zrange_to_reflective -----------   0.0%   4.1%       1    0.292s
+  â””Glue.zrange_to_reflective_goal ------   2.6%   3.2%       1    0.228s
+
+Finished transaction in 12.063 secs (11.036u,0.012s) (successful)
+Closed under the global context
+total time:      7.112s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_freeze ---------------------  -0.0% 100.0%       1    7.112s
+─Pipeline.refine_reflectively_gen ------   0.0%  99.2%       1    7.056s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  92.8%       1    6.600s
+─ReflectiveTactics.solve_side_conditions  -0.0%  91.8%       1    6.532s
+─ReflectiveTactics.do_reify ------------   0.0%  57.1%       1    4.060s
+─Reify.Reify_rhs_gen -------------------   1.5%  56.4%       1    4.012s
+─Reify.do_reify_abs_goal ---------------  40.1%  40.3%       2    2.868s
+─Reify.do_reifyf_goal ------------------  39.1%  39.4%     129    2.800s
+─ReflectiveTactics.solve_post_reified_si   0.6%  34.8%       1    2.472s
+─UnifyAbstractReflexivity.unify_transfor  25.2%  29.4%       8    0.428s
+─eexact --------------------------------  12.9%  12.9%     131    0.028s
+─Glue.refine_to_reflective_glue' -------   0.1%   6.4%       1    0.456s
+─prove_interp_compile_correct ----------   0.0%   4.7%       1    0.332s
+─unify (constr) (constr) ---------------   4.6%   4.6%       7    0.096s
+─ReflectiveTactics.unify_abstract_cbv_in   3.1%   4.6%       1    0.324s
+─rewrite ?EtaInterp.InterpExprEta ------   4.3%   4.3%       1    0.308s
+─Glue.zrange_to_reflective -------------   0.0%   4.1%       1    0.292s
+─Glue.zrange_to_reflective_goal --------   2.6%   3.2%       1    0.228s
+─rewrite H -----------------------------   3.0%   3.0%       1    0.212s
+─reflexivity ---------------------------   2.3%   2.3%       7    0.064s
+─Reify.transitivity_tt -----------------   0.0%   2.1%       2    0.096s
+─transitivity --------------------------   2.1%   2.1%       5    0.084s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_freeze ---------------------  -0.0% 100.0%       1    7.112s
+â””Pipeline.refine_reflectively_gen ------   0.0%  99.2%       1    7.056s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  92.8%       1    6.600s
+ │└ReflectiveTactics.solve_side_conditio  -0.0%  91.8%       1    6.532s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  57.1%       1    4.060s
+ │ │└Reify.Reify_rhs_gen ---------------   1.5%  56.4%       1    4.012s
+ │ │ ├─Reify.do_reify_abs_goal ---------  40.1%  40.3%       2    2.868s
+ │ │ │└Reify.do_reifyf_goal ------------  39.1%  39.4%     129    2.800s
+ │ │ │└eexact --------------------------  12.4%  12.4%     129    0.028s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   4.7%       1    0.332s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    4.3%   4.3%       1    0.308s
+ │ │ ├─rewrite H -----------------------   3.0%   3.0%       1    0.212s
+ │ │ └─Reify.transitivity_tt -----------   0.0%   2.1%       2    0.096s
+ │ │  └transitivity --------------------   2.0%   2.0%       4    0.084s
+ │ └─ReflectiveTactics.solve_post_reifie   0.6%  34.8%       1    2.472s
+ │   ├─UnifyAbstractReflexivity.unify_tr  25.2%  29.4%       8    0.428s
+ │   │└unify (constr) (constr) ---------   3.2%   3.2%       6    0.068s
+ │   └─ReflectiveTactics.unify_abstract_   3.1%   4.6%       1    0.324s
+ └─Glue.refine_to_reflective_glue' -----   0.1%   6.4%       1    0.456s
+  â””Glue.zrange_to_reflective -----------   0.0%   4.1%       1    0.292s
+  â””Glue.zrange_to_reflective_goal ------   2.6%   3.2%       1    0.228s
+
+src/Specific/X25519/C64/freeze (real: 36.42, user: 33.24, sys: 0.26, mem: 826476 ko)
+COQC src/Specific/NISTP256/AMD64/feadd.v
+Finished transaction in 9.065 secs (8.452u,0.004s) (successful)
+total time:      8.408s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  56.0%       1    4.712s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  47.7%       1    4.012s
+─ReflectiveTactics.solve_side_conditions   0.0%  47.1%       1    3.960s
+─synthesize_montgomery -----------------   0.0%  44.0%       1    3.696s
+─ReflectiveTactics.solve_post_reified_si   0.6%  26.4%       1    2.220s
+─UnifyAbstractReflexivity.unify_transfor  18.0%  21.3%       8    0.508s
+─IntegrationTestTemporaryMiscCommon.fact   1.3%  21.3%       1    1.788s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  21.0%       1    1.768s
+─ReflectiveTactics.do_reify ------------   0.0%  20.7%       1    1.740s
+─Reify.Reify_rhs_gen -------------------   1.0%  20.0%       1    1.684s
+─DestructHyps.do_all_matches_then ------   0.1%  18.6%       8    0.220s
+─DestructHyps.do_one_match_then --------   0.8%  18.5%      44    0.056s
+─op_sig_side_conditions_t --------------   0.0%  17.9%       1    1.504s
+─do_tac --------------------------------   0.0%  17.7%      43    0.052s
+─destruct H ----------------------------  17.7%  17.7%      36    0.052s
+─rewrite <- (lem : lemT) by by_tac ltac:   0.3%  17.3%       1    1.452s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  17.3%       1    1.452s
+─by_tac --------------------------------   0.0%  17.0%       4    0.532s
+─rewrite <- (ZRange.is_bounded_by_None_r  15.7%  15.8%       8    0.360s
+─Reify.do_reify_abs_goal ---------------   9.1%   9.3%       2    0.780s
+─Reify.do_reifyf_goal ------------------   8.5%   8.6%      93    0.716s
+─Glue.refine_to_reflective_glue' -------   0.0%   8.3%       1    0.700s
+─Glue.zrange_to_reflective -------------   0.0%   5.3%       1    0.444s
+─ReflectiveTactics.unify_abstract_cbv_in   2.9%   4.3%       1    0.360s
+─Glue.zrange_to_reflective_goal --------   2.5%   4.0%       1    0.336s
+─unify (constr) (constr) ---------------   3.9%   3.9%       9    0.108s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   3.8%       1    0.316s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.8%   3.6%       3    0.300s
+─k -------------------------------------   2.6%   2.8%       1    0.232s
+─rewrite H -----------------------------   2.4%   2.4%       2    0.192s
+─prove_interp_compile_correct ----------   0.0%   2.4%       1    0.200s
+─rewrite ?EtaInterp.InterpExprEta ------   2.2%   2.2%       1    0.188s
+─apply  (fun f =>   MapProjections.proj2   2.1%   2.1%       2    0.108s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  56.0%       1    4.712s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  47.7%       1    4.012s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  47.1%       1    3.960s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.6%  26.4%       1    2.220s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  18.0%  21.3%       8    0.508s
+ │ │ │└unify (constr) (constr) ---------   2.6%   2.6%       6    0.064s
+ │ │ └─ReflectiveTactics.unify_abstract_   2.9%   4.3%       1    0.360s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  20.7%       1    1.740s
+ │  └Reify.Reify_rhs_gen ---------------   1.0%  20.0%       1    1.684s
+ │   ├─Reify.do_reify_abs_goal ---------   9.1%   9.3%       2    0.780s
+ │   │└Reify.do_reifyf_goal ------------   8.5%   8.6%      93    0.716s
+ │   ├─prove_interp_compile_correct ----   0.0%   2.4%       1    0.200s
+ │   │└rewrite ?EtaInterp.InterpExprEta    2.2%   2.2%       1    0.188s
+ │   └─rewrite H -----------------------   2.3%   2.3%       1    0.192s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   8.3%       1    0.700s
+  â””Glue.zrange_to_reflective -----------   0.0%   5.3%       1    0.444s
+  â””Glue.zrange_to_reflective_goal ------   2.5%   4.0%       1    0.336s
+─synthesize_montgomery -----------------   0.0%  44.0%       1    3.696s
+ ├─IntegrationTestTemporaryMiscCommon.fa   1.3%  21.3%       1    1.788s
+ │└op_sig_side_conditions_t ------------   0.0%  17.9%       1    1.504s
+ │ ├─DestructHyps.do_all_matches_then --   0.1%  10.1%       4    0.220s
+ │ │└DestructHyps.do_one_match_then ----   0.4%  10.0%      24    0.052s
+ │ │└do_tac ----------------------------   0.0%   9.6%      20    0.048s
+ │ │└destruct H ------------------------   9.6%   9.6%      20    0.048s
+ │ └─rewrite <- (ZRange.is_bounded_by_No   7.5%   7.6%       4    0.308s
+ └─IntegrationTestTemporaryMiscCommon.do   0.0%  21.0%       1    1.768s
+   ├─IntegrationTestTemporaryMiscCommon.   0.0%  17.3%       1    1.452s
+   │└rewrite <- (lem : lemT) by by_tac l   0.3%  17.3%       1    1.452s
+   │└by_tac ----------------------------   0.0%  17.0%       4    0.532s
+   │ ├─DestructHyps.do_all_matches_then    0.0%   8.5%       4    0.184s
+   │ │└DestructHyps.do_one_match_then --   0.3%   8.5%      20    0.056s
+   │ │└do_tac --------------------------   0.0%   8.2%      16    0.052s
+   │ │└destruct H ----------------------   8.2%   8.2%      16    0.052s
+   │ └─rewrite <- (ZRange.is_bounded_by_   8.2%   8.3%       4    0.360s
+   └─IntegrationTestTemporaryMiscCommon.   0.0%   3.8%       1    0.316s
+    â””<Crypto.Util.Tactics.MoveLetIn.with   0.8%   3.6%       3    0.300s
+    â””k ---------------------------------   2.6%   2.8%       1    0.232s
+
+Finished transaction in 15.052 secs (13.947u,0.003s) (successful)
+Closed under the global context
+total time:      8.408s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  56.0%       1    4.712s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  47.7%       1    4.012s
+─ReflectiveTactics.solve_side_conditions   0.0%  47.1%       1    3.960s
+─synthesize_montgomery -----------------   0.0%  44.0%       1    3.696s
+─ReflectiveTactics.solve_post_reified_si   0.6%  26.4%       1    2.220s
+─UnifyAbstractReflexivity.unify_transfor  18.0%  21.3%       8    0.508s
+─IntegrationTestTemporaryMiscCommon.fact   1.3%  21.3%       1    1.788s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  21.0%       1    1.768s
+─ReflectiveTactics.do_reify ------------   0.0%  20.7%       1    1.740s
+─Reify.Reify_rhs_gen -------------------   1.0%  20.0%       1    1.684s
+─DestructHyps.do_all_matches_then ------   0.1%  18.6%       8    0.220s
+─DestructHyps.do_one_match_then --------   0.8%  18.5%      44    0.056s
+─op_sig_side_conditions_t --------------   0.0%  17.9%       1    1.504s
+─do_tac --------------------------------   0.0%  17.7%      43    0.052s
+─destruct H ----------------------------  17.7%  17.7%      36    0.052s
+─rewrite <- (lem : lemT) by by_tac ltac:   0.3%  17.3%       1    1.452s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  17.3%       1    1.452s
+─by_tac --------------------------------   0.0%  17.0%       4    0.532s
+─rewrite <- (ZRange.is_bounded_by_None_r  15.7%  15.8%       8    0.360s
+─Reify.do_reify_abs_goal ---------------   9.1%   9.3%       2    0.780s
+─Reify.do_reifyf_goal ------------------   8.5%   8.6%      93    0.716s
+─Glue.refine_to_reflective_glue' -------   0.0%   8.3%       1    0.700s
+─Glue.zrange_to_reflective -------------   0.0%   5.3%       1    0.444s
+─ReflectiveTactics.unify_abstract_cbv_in   2.9%   4.3%       1    0.360s
+─Glue.zrange_to_reflective_goal --------   2.5%   4.0%       1    0.336s
+─unify (constr) (constr) ---------------   3.9%   3.9%       9    0.108s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   3.8%       1    0.316s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.8%   3.6%       3    0.300s
+─k -------------------------------------   2.6%   2.8%       1    0.232s
+─rewrite H -----------------------------   2.4%   2.4%       2    0.192s
+─prove_interp_compile_correct ----------   0.0%   2.4%       1    0.200s
+─rewrite ?EtaInterp.InterpExprEta ------   2.2%   2.2%       1    0.188s
+─apply  (fun f =>   MapProjections.proj2   2.1%   2.1%       2    0.108s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  56.0%       1    4.712s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  47.7%       1    4.012s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  47.1%       1    3.960s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.6%  26.4%       1    2.220s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  18.0%  21.3%       8    0.508s
+ │ │ │└unify (constr) (constr) ---------   2.6%   2.6%       6    0.064s
+ │ │ └─ReflectiveTactics.unify_abstract_   2.9%   4.3%       1    0.360s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  20.7%       1    1.740s
+ │  └Reify.Reify_rhs_gen ---------------   1.0%  20.0%       1    1.684s
+ │   ├─Reify.do_reify_abs_goal ---------   9.1%   9.3%       2    0.780s
+ │   │└Reify.do_reifyf_goal ------------   8.5%   8.6%      93    0.716s
+ │   ├─prove_interp_compile_correct ----   0.0%   2.4%       1    0.200s
+ │   │└rewrite ?EtaInterp.InterpExprEta    2.2%   2.2%       1    0.188s
+ │   └─rewrite H -----------------------   2.3%   2.3%       1    0.192s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   8.3%       1    0.700s
+  â””Glue.zrange_to_reflective -----------   0.0%   5.3%       1    0.444s
+  â””Glue.zrange_to_reflective_goal ------   2.5%   4.0%       1    0.336s
+─synthesize_montgomery -----------------   0.0%  44.0%       1    3.696s
+ ├─IntegrationTestTemporaryMiscCommon.fa   1.3%  21.3%       1    1.788s
+ │└op_sig_side_conditions_t ------------   0.0%  17.9%       1    1.504s
+ │ ├─DestructHyps.do_all_matches_then --   0.1%  10.1%       4    0.220s
+ │ │└DestructHyps.do_one_match_then ----   0.4%  10.0%      24    0.052s
+ │ │└do_tac ----------------------------   0.0%   9.6%      20    0.048s
+ │ │└destruct H ------------------------   9.6%   9.6%      20    0.048s
+ │ └─rewrite <- (ZRange.is_bounded_by_No   7.5%   7.6%       4    0.308s
+ └─IntegrationTestTemporaryMiscCommon.do   0.0%  21.0%       1    1.768s
+   ├─IntegrationTestTemporaryMiscCommon.   0.0%  17.3%       1    1.452s
+   │└rewrite <- (lem : lemT) by by_tac l   0.3%  17.3%       1    1.452s
+   │└by_tac ----------------------------   0.0%  17.0%       4    0.532s
+   │ ├─DestructHyps.do_all_matches_then    0.0%   8.5%       4    0.184s
+   │ │└DestructHyps.do_one_match_then --   0.3%   8.5%      20    0.056s
+   │ │└do_tac --------------------------   0.0%   8.2%      16    0.052s
+   │ │└destruct H ----------------------   8.2%   8.2%      16    0.052s
+   │ └─rewrite <- (ZRange.is_bounded_by_   8.2%   8.3%       4    0.360s
+   └─IntegrationTestTemporaryMiscCommon.   0.0%   3.8%       1    0.316s
+    â””<Crypto.Util.Tactics.MoveLetIn.with   0.8%   3.6%       3    0.300s
+    â””k ---------------------------------   2.6%   2.8%       1    0.232s
+
+src/Specific/NISTP256/AMD64/feadd (real: 40.48, user: 37.21, sys: 0.27, mem: 797944 ko)
+COQC src/Specific/NISTP256/AMD64/fenz.v
+Finished transaction in 6.724 secs (6.196u,0.007s) (successful)
+total time:      6.180s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_nonzero --------------------   0.0% 100.0%       1    6.180s
+─IntegrationTestTemporaryMiscCommon.nonz   0.1%  84.5%       1    5.224s
+─destruct (Decidable.dec x), (Decidable.  36.7%  36.7%       1    2.268s
+─destruct (Decidable.dec x) as [H| H] --  21.6%  21.6%       1    1.336s
+─Pipeline.refine_reflectively_gen ------   0.1%  15.5%       1    0.956s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  11.9%       1    0.736s
+─ReflectiveTactics.solve_side_conditions   0.0%  11.6%       1    0.716s
+─ReflectiveTactics.solve_post_reified_si   0.3%   9.6%       1    0.592s
+─IntegrationTestTemporaryMiscCommon.op_s   0.1%   7.9%       2    0.392s
+─rewrite <- (ZRange.is_bounded_by_None_r   5.2%   5.2%       2    0.308s
+─UnifyAbstractReflexivity.unify_transfor   4.2%   5.2%       8    0.076s
+─ReflectiveTactics.unify_abstract_cbv_in   3.0%   4.0%       1    0.248s
+─Glue.refine_to_reflective_glue' -------   0.0%   3.5%       1    0.216s
+─rewrite H' ----------------------------   3.4%   3.4%       1    0.208s
+─generalize dependent (constr) ---------   3.1%   3.1%       4    0.068s
+─congruence ----------------------------   2.8%   2.8%       1    0.176s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   2.7%       1    0.164s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.5%   2.6%       3    0.156s
+─DestructHyps.do_one_match_then --------   0.1%   2.5%       6    0.048s
+─DestructHyps.do_all_matches_then ------   0.0%   2.5%       2    0.084s
+─do_tac --------------------------------   0.0%   2.5%       7    0.044s
+─destruct H ----------------------------   2.5%   2.5%       4    0.044s
+─Glue.zrange_to_reflective -------------   0.1%   2.1%       1    0.132s
+─rewrite H -----------------------------   1.9%   2.1%       3    0.116s
+─k -------------------------------------   1.9%   2.0%       1    0.124s
+─ReflectiveTactics.do_reify ------------   0.0%   2.0%       1    0.124s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_nonzero --------------------   0.0% 100.0%       1    6.180s
+ ├─IntegrationTestTemporaryMiscCommon.no   0.1%  84.5%       1    5.224s
+ │ ├─destruct (Decidable.dec x), (Decida  36.7%  36.7%       1    2.268s
+ │ ├─destruct (Decidable.dec x) as [H| H  21.6%  21.6%       1    1.336s
+ │ ├─IntegrationTestTemporaryMiscCommon.   0.1%   7.9%       2    0.392s
+ │ │ ├─rewrite <- (ZRange.is_bounded_by_   5.2%   5.2%       2    0.308s
+ │ │ └─DestructHyps.do_all_matches_then    0.0%   2.5%       2    0.084s
+ │ │  └DestructHyps.do_one_match_then --   0.1%   2.5%       6    0.048s
+ │ │  └do_tac --------------------------   0.0%   2.5%       4    0.044s
+ │ │  └destruct H ----------------------   2.5%   2.5%       4    0.044s
+ │ ├─rewrite H' ------------------------   3.4%   3.4%       1    0.208s
+ │ ├─generalize dependent (constr) -----   3.1%   3.1%       4    0.068s
+ │ ├─congruence ------------------------   2.8%   2.8%       1    0.176s
+ │ └─IntegrationTestTemporaryMiscCommon.   0.0%   2.7%       1    0.164s
+ │  └<Crypto.Util.Tactics.MoveLetIn.with   0.5%   2.6%       3    0.156s
+ │  └k ---------------------------------   1.9%   2.0%       1    0.124s
+ └─Pipeline.refine_reflectively_gen ----   0.1%  15.5%       1    0.956s
+   ├─ReflectiveTactics.do_reflective_pip   0.0%  11.9%       1    0.736s
+   │└ReflectiveTactics.solve_side_condit   0.0%  11.6%       1    0.716s
+   │ ├─ReflectiveTactics.solve_post_reif   0.3%   9.6%       1    0.592s
+   │ │ ├─UnifyAbstractReflexivity.unify_   4.2%   5.2%       8    0.076s
+   │ │ └─ReflectiveTactics.unify_abstrac   3.0%   4.0%       1    0.248s
+   │ └─ReflectiveTactics.do_reify ------   0.0%   2.0%       1    0.124s
+   └─Glue.refine_to_reflective_glue' ---   0.0%   3.5%       1    0.216s
+    â””Glue.zrange_to_reflective ---------   0.1%   2.1%       1    0.132s
+
+Finished transaction in 7.301 secs (6.731u,0.s) (successful)
+Closed under the global context
+total time:      6.180s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_nonzero --------------------   0.0% 100.0%       1    6.180s
+─IntegrationTestTemporaryMiscCommon.nonz   0.1%  84.5%       1    5.224s
+─destruct (Decidable.dec x), (Decidable.  36.7%  36.7%       1    2.268s
+─destruct (Decidable.dec x) as [H| H] --  21.6%  21.6%       1    1.336s
+─Pipeline.refine_reflectively_gen ------   0.1%  15.5%       1    0.956s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  11.9%       1    0.736s
+─ReflectiveTactics.solve_side_conditions   0.0%  11.6%       1    0.716s
+─ReflectiveTactics.solve_post_reified_si   0.3%   9.6%       1    0.592s
+─IntegrationTestTemporaryMiscCommon.op_s   0.1%   7.9%       2    0.392s
+─rewrite <- (ZRange.is_bounded_by_None_r   5.2%   5.2%       2    0.308s
+─UnifyAbstractReflexivity.unify_transfor   4.2%   5.2%       8    0.076s
+─ReflectiveTactics.unify_abstract_cbv_in   3.0%   4.0%       1    0.248s
+─Glue.refine_to_reflective_glue' -------   0.0%   3.5%       1    0.216s
+─rewrite H' ----------------------------   3.4%   3.4%       1    0.208s
+─generalize dependent (constr) ---------   3.1%   3.1%       4    0.068s
+─congruence ----------------------------   2.8%   2.8%       1    0.176s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   2.7%       1    0.164s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.5%   2.6%       3    0.156s
+─DestructHyps.do_one_match_then --------   0.1%   2.5%       6    0.048s
+─DestructHyps.do_all_matches_then ------   0.0%   2.5%       2    0.084s
+─do_tac --------------------------------   0.0%   2.5%       7    0.044s
+─destruct H ----------------------------   2.5%   2.5%       4    0.044s
+─Glue.zrange_to_reflective -------------   0.1%   2.1%       1    0.132s
+─rewrite H -----------------------------   1.9%   2.1%       3    0.116s
+─k -------------------------------------   1.9%   2.0%       1    0.124s
+─ReflectiveTactics.do_reify ------------   0.0%   2.0%       1    0.124s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_nonzero --------------------   0.0% 100.0%       1    6.180s
+ ├─IntegrationTestTemporaryMiscCommon.no   0.1%  84.5%       1    5.224s
+ │ ├─destruct (Decidable.dec x), (Decida  36.7%  36.7%       1    2.268s
+ │ ├─destruct (Decidable.dec x) as [H| H  21.6%  21.6%       1    1.336s
+ │ ├─IntegrationTestTemporaryMiscCommon.   0.1%   7.9%       2    0.392s
+ │ │ ├─rewrite <- (ZRange.is_bounded_by_   5.2%   5.2%       2    0.308s
+ │ │ └─DestructHyps.do_all_matches_then    0.0%   2.5%       2    0.084s
+ │ │  └DestructHyps.do_one_match_then --   0.1%   2.5%       6    0.048s
+ │ │  └do_tac --------------------------   0.0%   2.5%       4    0.044s
+ │ │  └destruct H ----------------------   2.5%   2.5%       4    0.044s
+ │ ├─rewrite H' ------------------------   3.4%   3.4%       1    0.208s
+ │ ├─generalize dependent (constr) -----   3.1%   3.1%       4    0.068s
+ │ ├─congruence ------------------------   2.8%   2.8%       1    0.176s
+ │ └─IntegrationTestTemporaryMiscCommon.   0.0%   2.7%       1    0.164s
+ │  └<Crypto.Util.Tactics.MoveLetIn.with   0.5%   2.6%       3    0.156s
+ │  └k ---------------------------------   1.9%   2.0%       1    0.124s
+ └─Pipeline.refine_reflectively_gen ----   0.1%  15.5%       1    0.956s
+   ├─ReflectiveTactics.do_reflective_pip   0.0%  11.9%       1    0.736s
+   │└ReflectiveTactics.solve_side_condit   0.0%  11.6%       1    0.716s
+   │ ├─ReflectiveTactics.solve_post_reif   0.3%   9.6%       1    0.592s
+   │ │ ├─UnifyAbstractReflexivity.unify_   4.2%   5.2%       8    0.076s
+   │ │ └─ReflectiveTactics.unify_abstrac   3.0%   4.0%       1    0.248s
+   │ └─ReflectiveTactics.do_reify ------   0.0%   2.0%       1    0.124s
+   └─Glue.refine_to_reflective_glue' ---   0.0%   3.5%       1    0.216s
+    â””Glue.zrange_to_reflective ---------   0.1%   2.1%       1    0.132s
+
+src/Specific/NISTP256/AMD64/fenz (real: 28.91, user: 26.41, sys: 0.19, mem: 756216 ko)
+COQC src/Specific/NISTP256/AMD64/feopp.v
+Finished transaction in 7.716 secs (7.216u,0.s) (successful)
+total time:      7.168s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  59.8%       1    4.284s
+─IntegrationTestTemporaryMiscCommon.fact  17.6%  49.1%       1    3.516s
+─Pipeline.refine_reflectively_gen ------   0.0%  40.2%       1    2.884s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  35.3%       1    2.528s
+─ReflectiveTactics.solve_side_conditions   0.0%  34.8%       1    2.492s
+─reflexivity ---------------------------  23.8%  23.8%       8    1.660s
+─ReflectiveTactics.solve_post_reified_si   0.4%  21.0%       1    1.504s
+─UnifyAbstractReflexivity.unify_transfor  13.8%  16.4%       8    0.268s
+─ReflectiveTactics.do_reify ------------   0.1%  13.8%       1    0.988s
+─Reify.Reify_rhs_gen -------------------   0.8%  13.6%       1    0.972s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   9.5%       1    0.680s
+─rewrite <- (ZRange.is_bounded_by_None_r   8.7%   8.7%       4    0.332s
+─rewrite <- (lem : lemT) by by_tac ltac:   0.1%   7.3%       1    0.520s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   7.3%       1    0.520s
+─op_sig_side_conditions_t --------------   0.0%   7.2%       1    0.516s
+─by_tac --------------------------------   0.0%   7.1%       2    0.412s
+─Reify.do_reify_abs_goal ---------------   6.9%   7.0%       2    0.500s
+─Reify.do_reifyf_goal ------------------   6.3%   6.5%      62    0.460s
+─DestructHyps.do_one_match_then --------   0.3%   5.4%      14    0.044s
+─DestructHyps.do_all_matches_then ------   0.0%   5.4%       4    0.116s
+─do_tac --------------------------------   0.0%   5.1%      13    0.044s
+─destruct H ----------------------------   5.1%   5.1%      10    0.044s
+─Glue.refine_to_reflective_glue' -------   0.0%   5.0%       1    0.356s
+─ReflectiveTactics.unify_abstract_cbv_in   3.1%   4.1%       1    0.292s
+─Glue.zrange_to_reflective -------------   0.0%   3.4%       1    0.244s
+─unify (constr) (constr) ---------------   3.1%   3.1%       8    0.072s
+─Glue.zrange_to_reflective_goal --------   2.1%   2.7%       1    0.196s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   2.2%       1    0.160s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.3%   2.2%       3    0.152s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  59.8%       1    4.284s
+ ├─IntegrationTestTemporaryMiscCommon.fa  17.6%  49.1%       1    3.516s
+ │ ├─reflexivity -----------------------  23.2%  23.2%       1    1.660s
+ │ └─op_sig_side_conditions_t ----------   0.0%   7.2%       1    0.516s
+ │   ├─rewrite <- (ZRange.is_bounded_by_   3.9%   3.9%       2    0.272s
+ │   └─DestructHyps.do_all_matches_then    0.0%   3.2%       2    0.116s
+ │    └DestructHyps.do_one_match_then --   0.2%   3.2%       8    0.044s
+ │    └do_tac --------------------------   0.0%   3.0%       6    0.040s
+ │    └destruct H ----------------------   3.0%   3.0%       6    0.040s
+ └─IntegrationTestTemporaryMiscCommon.do   0.0%   9.5%       1    0.680s
+   ├─IntegrationTestTemporaryMiscCommon.   0.0%   7.3%       1    0.520s
+   │└rewrite <- (lem : lemT) by by_tac l   0.1%   7.3%       1    0.520s
+   │└by_tac ----------------------------   0.0%   7.1%       2    0.412s
+   │ ├─rewrite <- (ZRange.is_bounded_by_   4.8%   4.8%       2    0.332s
+   │ └─DestructHyps.do_all_matches_then    0.0%   2.2%       2    0.080s
+   │  └DestructHyps.do_one_match_then --   0.1%   2.2%       6    0.044s
+   │  └do_tac --------------------------   0.0%   2.2%       4    0.044s
+   │  └destruct H ----------------------   2.2%   2.2%       4    0.044s
+   └─IntegrationTestTemporaryMiscCommon.   0.0%   2.2%       1    0.160s
+    â””<Crypto.Util.Tactics.MoveLetIn.with   0.3%   2.2%       3    0.152s
+─Pipeline.refine_reflectively_gen ------   0.0%  40.2%       1    2.884s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  35.3%       1    2.528s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  34.8%       1    2.492s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.4%  21.0%       1    1.504s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  13.8%  16.4%       8    0.268s
+ │ │ │└unify (constr) (constr) ---------   2.1%   2.1%       6    0.048s
+ │ │ └─ReflectiveTactics.unify_abstract_   3.1%   4.1%       1    0.292s
+ │ └─ReflectiveTactics.do_reify --------   0.1%  13.8%       1    0.988s
+ │  └Reify.Reify_rhs_gen ---------------   0.8%  13.6%       1    0.972s
+ │  └Reify.do_reify_abs_goal -----------   6.9%   7.0%       2    0.500s
+ │  └Reify.do_reifyf_goal --------------   6.3%   6.5%      62    0.460s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   5.0%       1    0.356s
+  â””Glue.zrange_to_reflective -----------   0.0%   3.4%       1    0.244s
+  â””Glue.zrange_to_reflective_goal ------   2.1%   2.7%       1    0.196s
+
+Finished transaction in 8.918 secs (8.116u,0.004s) (successful)
+Closed under the global context
+total time:      7.168s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  59.8%       1    4.284s
+─IntegrationTestTemporaryMiscCommon.fact  17.6%  49.1%       1    3.516s
+─Pipeline.refine_reflectively_gen ------   0.0%  40.2%       1    2.884s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  35.3%       1    2.528s
+─ReflectiveTactics.solve_side_conditions   0.0%  34.8%       1    2.492s
+─reflexivity ---------------------------  23.8%  23.8%       8    1.660s
+─ReflectiveTactics.solve_post_reified_si   0.4%  21.0%       1    1.504s
+─UnifyAbstractReflexivity.unify_transfor  13.8%  16.4%       8    0.268s
+─ReflectiveTactics.do_reify ------------   0.1%  13.8%       1    0.988s
+─Reify.Reify_rhs_gen -------------------   0.8%  13.6%       1    0.972s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   9.5%       1    0.680s
+─rewrite <- (ZRange.is_bounded_by_None_r   8.7%   8.7%       4    0.332s
+─rewrite <- (lem : lemT) by by_tac ltac:   0.1%   7.3%       1    0.520s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   7.3%       1    0.520s
+─op_sig_side_conditions_t --------------   0.0%   7.2%       1    0.516s
+─by_tac --------------------------------   0.0%   7.1%       2    0.412s
+─Reify.do_reify_abs_goal ---------------   6.9%   7.0%       2    0.500s
+─Reify.do_reifyf_goal ------------------   6.3%   6.5%      62    0.460s
+─DestructHyps.do_one_match_then --------   0.3%   5.4%      14    0.044s
+─DestructHyps.do_all_matches_then ------   0.0%   5.4%       4    0.116s
+─do_tac --------------------------------   0.0%   5.1%      13    0.044s
+─destruct H ----------------------------   5.1%   5.1%      10    0.044s
+─Glue.refine_to_reflective_glue' -------   0.0%   5.0%       1    0.356s
+─ReflectiveTactics.unify_abstract_cbv_in   3.1%   4.1%       1    0.292s
+─Glue.zrange_to_reflective -------------   0.0%   3.4%       1    0.244s
+─unify (constr) (constr) ---------------   3.1%   3.1%       8    0.072s
+─Glue.zrange_to_reflective_goal --------   2.1%   2.7%       1    0.196s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   2.2%       1    0.160s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.3%   2.2%       3    0.152s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  59.8%       1    4.284s
+ ├─IntegrationTestTemporaryMiscCommon.fa  17.6%  49.1%       1    3.516s
+ │ ├─reflexivity -----------------------  23.2%  23.2%       1    1.660s
+ │ └─op_sig_side_conditions_t ----------   0.0%   7.2%       1    0.516s
+ │   ├─rewrite <- (ZRange.is_bounded_by_   3.9%   3.9%       2    0.272s
+ │   └─DestructHyps.do_all_matches_then    0.0%   3.2%       2    0.116s
+ │    └DestructHyps.do_one_match_then --   0.2%   3.2%       8    0.044s
+ │    └do_tac --------------------------   0.0%   3.0%       6    0.040s
+ │    └destruct H ----------------------   3.0%   3.0%       6    0.040s
+ └─IntegrationTestTemporaryMiscCommon.do   0.0%   9.5%       1    0.680s
+   ├─IntegrationTestTemporaryMiscCommon.   0.0%   7.3%       1    0.520s
+   │└rewrite <- (lem : lemT) by by_tac l   0.1%   7.3%       1    0.520s
+   │└by_tac ----------------------------   0.0%   7.1%       2    0.412s
+   │ ├─rewrite <- (ZRange.is_bounded_by_   4.8%   4.8%       2    0.332s
+   │ └─DestructHyps.do_all_matches_then    0.0%   2.2%       2    0.080s
+   │  └DestructHyps.do_one_match_then --   0.1%   2.2%       6    0.044s
+   │  └do_tac --------------------------   0.0%   2.2%       4    0.044s
+   │  └destruct H ----------------------   2.2%   2.2%       4    0.044s
+   └─IntegrationTestTemporaryMiscCommon.   0.0%   2.2%       1    0.160s
+    â””<Crypto.Util.Tactics.MoveLetIn.with   0.3%   2.2%       3    0.152s
+─Pipeline.refine_reflectively_gen ------   0.0%  40.2%       1    2.884s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  35.3%       1    2.528s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  34.8%       1    2.492s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.4%  21.0%       1    1.504s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  13.8%  16.4%       8    0.268s
+ │ │ │└unify (constr) (constr) ---------   2.1%   2.1%       6    0.048s
+ │ │ └─ReflectiveTactics.unify_abstract_   3.1%   4.1%       1    0.292s
+ │ └─ReflectiveTactics.do_reify --------   0.1%  13.8%       1    0.988s
+ │  └Reify.Reify_rhs_gen ---------------   0.8%  13.6%       1    0.972s
+ │  └Reify.do_reify_abs_goal -----------   6.9%   7.0%       2    0.500s
+ │  └Reify.do_reifyf_goal --------------   6.3%   6.5%      62    0.460s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   5.0%       1    0.356s
+  â””Glue.zrange_to_reflective -----------   0.0%   3.4%       1    0.244s
+  â””Glue.zrange_to_reflective_goal ------   2.1%   2.7%       1    0.196s
+
+src/Specific/NISTP256/AMD64/feopp (real: 32.08, user: 29.46, sys: 0.25, mem: 765212 ko)
+COQC src/Specific/NISTP256/AMD64/fesub.v
+Finished transaction in 12.83 secs (11.988u,0.019s) (successful)
+total time:     11.956s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  63.2%       1    7.560s
+─IntegrationTestTemporaryMiscCommon.fact  15.6%  48.5%       1    5.796s
+─Pipeline.refine_reflectively_gen ------   0.0%  36.8%       1    4.396s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  31.0%       1    3.712s
+─ReflectiveTactics.solve_side_conditions   0.0%  30.6%       1    3.656s
+─reflexivity ---------------------------  20.3%  20.3%       8    2.312s
+─ReflectiveTactics.solve_post_reified_si   0.5%  17.3%       1    2.064s
+─UnifyAbstractReflexivity.unify_transfor  11.8%  13.9%       8    0.452s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  13.7%       1    1.636s
+─ReflectiveTactics.do_reify ------------   0.0%  13.3%       1    1.592s
+─Reify.Reify_rhs_gen -------------------   0.9%  12.8%       1    1.536s
+─DestructHyps.do_all_matches_then ------   0.1%  12.6%       8    0.224s
+─DestructHyps.do_one_match_then --------   0.5%  12.5%      44    0.056s
+─op_sig_side_conditions_t --------------   0.0%  12.2%       1    1.456s
+─do_tac --------------------------------   0.0%  12.0%      43    0.052s
+─destruct H ----------------------------  11.9%  11.9%      36    0.052s
+─rewrite <- (lem : lemT) by by_tac ltac:   0.2%  11.1%       1    1.324s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  11.1%       1    1.324s
+─by_tac --------------------------------   0.0%  10.9%       4    0.488s
+─rewrite <- (ZRange.is_bounded_by_None_r  10.1%  10.2%       8    0.328s
+─Reify.do_reify_abs_goal ---------------   6.0%   6.1%       2    0.724s
+─Glue.refine_to_reflective_glue' -------   0.0%   5.7%       1    0.680s
+─Reify.do_reifyf_goal ------------------   5.5%   5.6%      80    0.660s
+─Glue.zrange_to_reflective -------------   0.0%   3.6%       1    0.432s
+─ReflectiveTactics.unify_abstract_cbv_in   2.0%   2.8%       1    0.340s
+─Glue.zrange_to_reflective_goal --------   1.7%   2.7%       1    0.324s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   2.6%       1    0.312s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.5%   2.5%       3    0.300s
+─unify (constr) (constr) ---------------   2.4%   2.4%       9    0.100s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  63.2%       1    7.560s
+ ├─IntegrationTestTemporaryMiscCommon.fa  15.6%  48.5%       1    5.796s
+ │ ├─reflexivity -----------------------  19.3%  19.3%       1    2.312s
+ │ └─op_sig_side_conditions_t ----------   0.0%  12.2%       1    1.456s
+ │   ├─DestructHyps.do_all_matches_then    0.1%   7.1%       4    0.224s
+ │   │└DestructHyps.do_one_match_then --   0.3%   7.1%      24    0.056s
+ │   │└do_tac --------------------------   0.0%   6.7%      20    0.052s
+ │   │└destruct H ----------------------   6.7%   6.7%      20    0.052s
+ │   └─rewrite <- (ZRange.is_bounded_by_   4.9%   4.9%       4    0.292s
+ └─IntegrationTestTemporaryMiscCommon.do   0.0%  13.7%       1    1.636s
+   ├─IntegrationTestTemporaryMiscCommon.   0.0%  11.1%       1    1.324s
+   │└rewrite <- (lem : lemT) by by_tac l   0.2%  11.1%       1    1.324s
+   │└by_tac ----------------------------   0.0%  10.9%       4    0.488s
+   │ ├─DestructHyps.do_all_matches_then    0.0%   5.5%       4    0.176s
+   │ │└DestructHyps.do_one_match_then --   0.2%   5.5%      20    0.048s
+   │ │└do_tac --------------------------   0.0%   5.3%      16    0.048s
+   │ │└destruct H ----------------------   5.2%   5.2%      16    0.048s
+   │ └─rewrite <- (ZRange.is_bounded_by_   5.3%   5.3%       4    0.328s
+   └─IntegrationTestTemporaryMiscCommon.   0.0%   2.6%       1    0.312s
+    â””<Crypto.Util.Tactics.MoveLetIn.with   0.5%   2.5%       3    0.300s
+─Pipeline.refine_reflectively_gen ------   0.0%  36.8%       1    4.396s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  31.0%       1    3.712s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  30.6%       1    3.656s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.5%  17.3%       1    2.064s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  11.8%  13.9%       8    0.452s
+ │ │ └─ReflectiveTactics.unify_abstract_   2.0%   2.8%       1    0.340s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  13.3%       1    1.592s
+ │  └Reify.Reify_rhs_gen ---------------   0.9%  12.8%       1    1.536s
+ │  └Reify.do_reify_abs_goal -----------   6.0%   6.1%       2    0.724s
+ │  └Reify.do_reifyf_goal --------------   5.5%   5.6%      80    0.660s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   5.7%       1    0.680s
+  â””Glue.zrange_to_reflective -----------   0.0%   3.6%       1    0.432s
+  â””Glue.zrange_to_reflective_goal ------   1.7%   2.7%       1    0.324s
+
+Finished transaction in 14.576 secs (13.372u,0.004s) (successful)
+Closed under the global context
+total time:     11.956s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  63.2%       1    7.560s
+─IntegrationTestTemporaryMiscCommon.fact  15.6%  48.5%       1    5.796s
+─Pipeline.refine_reflectively_gen ------   0.0%  36.8%       1    4.396s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  31.0%       1    3.712s
+─ReflectiveTactics.solve_side_conditions   0.0%  30.6%       1    3.656s
+─reflexivity ---------------------------  20.3%  20.3%       8    2.312s
+─ReflectiveTactics.solve_post_reified_si   0.5%  17.3%       1    2.064s
+─UnifyAbstractReflexivity.unify_transfor  11.8%  13.9%       8    0.452s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  13.7%       1    1.636s
+─ReflectiveTactics.do_reify ------------   0.0%  13.3%       1    1.592s
+─Reify.Reify_rhs_gen -------------------   0.9%  12.8%       1    1.536s
+─DestructHyps.do_all_matches_then ------   0.1%  12.6%       8    0.224s
+─DestructHyps.do_one_match_then --------   0.5%  12.5%      44    0.056s
+─op_sig_side_conditions_t --------------   0.0%  12.2%       1    1.456s
+─do_tac --------------------------------   0.0%  12.0%      43    0.052s
+─destruct H ----------------------------  11.9%  11.9%      36    0.052s
+─rewrite <- (lem : lemT) by by_tac ltac:   0.2%  11.1%       1    1.324s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  11.1%       1    1.324s
+─by_tac --------------------------------   0.0%  10.9%       4    0.488s
+─rewrite <- (ZRange.is_bounded_by_None_r  10.1%  10.2%       8    0.328s
+─Reify.do_reify_abs_goal ---------------   6.0%   6.1%       2    0.724s
+─Glue.refine_to_reflective_glue' -------   0.0%   5.7%       1    0.680s
+─Reify.do_reifyf_goal ------------------   5.5%   5.6%      80    0.660s
+─Glue.zrange_to_reflective -------------   0.0%   3.6%       1    0.432s
+─ReflectiveTactics.unify_abstract_cbv_in   2.0%   2.8%       1    0.340s
+─Glue.zrange_to_reflective_goal --------   1.7%   2.7%       1    0.324s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   2.6%       1    0.312s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.5%   2.5%       3    0.300s
+─unify (constr) (constr) ---------------   2.4%   2.4%       9    0.100s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  63.2%       1    7.560s
+ ├─IntegrationTestTemporaryMiscCommon.fa  15.6%  48.5%       1    5.796s
+ │ ├─reflexivity -----------------------  19.3%  19.3%       1    2.312s
+ │ └─op_sig_side_conditions_t ----------   0.0%  12.2%       1    1.456s
+ │   ├─DestructHyps.do_all_matches_then    0.1%   7.1%       4    0.224s
+ │   │└DestructHyps.do_one_match_then --   0.3%   7.1%      24    0.056s
+ │   │└do_tac --------------------------   0.0%   6.7%      20    0.052s
+ │   │└destruct H ----------------------   6.7%   6.7%      20    0.052s
+ │   └─rewrite <- (ZRange.is_bounded_by_   4.9%   4.9%       4    0.292s
+ └─IntegrationTestTemporaryMiscCommon.do   0.0%  13.7%       1    1.636s
+   ├─IntegrationTestTemporaryMiscCommon.   0.0%  11.1%       1    1.324s
+   │└rewrite <- (lem : lemT) by by_tac l   0.2%  11.1%       1    1.324s
+   │└by_tac ----------------------------   0.0%  10.9%       4    0.488s
+   │ ├─DestructHyps.do_all_matches_then    0.0%   5.5%       4    0.176s
+   │ │└DestructHyps.do_one_match_then --   0.2%   5.5%      20    0.048s
+   │ │└do_tac --------------------------   0.0%   5.3%      16    0.048s
+   │ │└destruct H ----------------------   5.2%   5.2%      16    0.048s
+   │ └─rewrite <- (ZRange.is_bounded_by_   5.3%   5.3%       4    0.328s
+   └─IntegrationTestTemporaryMiscCommon.   0.0%   2.6%       1    0.312s
+    â””<Crypto.Util.Tactics.MoveLetIn.with   0.5%   2.5%       3    0.300s
+─Pipeline.refine_reflectively_gen ------   0.0%  36.8%       1    4.396s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  31.0%       1    3.712s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  30.6%       1    3.656s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.5%  17.3%       1    2.064s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  11.8%  13.9%       8    0.452s
+ │ │ └─ReflectiveTactics.unify_abstract_   2.0%   2.8%       1    0.340s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  13.3%       1    1.592s
+ │  └Reify.Reify_rhs_gen ---------------   0.9%  12.8%       1    1.536s
+ │  └Reify.do_reify_abs_goal -----------   6.0%   6.1%       2    0.724s
+ │  └Reify.do_reifyf_goal --------------   5.5%   5.6%      80    0.660s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   5.7%       1    0.680s
+  â””Glue.zrange_to_reflective -----------   0.0%   3.6%       1    0.432s
+  â””Glue.zrange_to_reflective_goal ------   1.7%   2.7%       1    0.324s
+
+src/Specific/NISTP256/AMD64/fesub (real: 43.78, user: 40.09, sys: 0.30, mem: 799668 ko)
+COQC src/Specific/NISTP256/AMD64/feaddDisplay > src/Specific/NISTP256/AMD64/feaddDisplay.log
+COQC src/Specific/NISTP256/AMD64/fenzDisplay > src/Specific/NISTP256/AMD64/fenzDisplay.log
+COQC src/Specific/NISTP256/AMD64/feoppDisplay > src/Specific/NISTP256/AMD64/feoppDisplay.log
+COQC src/Specific/NISTP256/AMD64/fesubDisplay > src/Specific/NISTP256/AMD64/fesubDisplay.log
+COQC src/Specific/X25519/C64/fesquareDisplay > src/Specific/X25519/C64/fesquareDisplay.log
+COQC src/Specific/solinas32_2e255m765_12limbs/femul.v
+Finished transaction in 60.265 secs (55.388u,0.103s) (successful)
+total time:     55.440s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  95.9%       1   53.156s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  89.2%       1   49.464s
+─ReflectiveTactics.solve_side_conditions   0.0%  88.9%       1   49.288s
+─ReflectiveTactics.do_reify ------------  -0.0%  49.9%       1   27.684s
+─Reify.Reify_rhs_gen -------------------   1.3%  49.3%       1   27.348s
+─ReflectiveTactics.solve_post_reified_si   0.1%  39.0%       1   21.604s
+─Reify.do_reify_abs_goal ---------------  36.3%  36.6%       2   20.272s
+─UnifyAbstractReflexivity.unify_transfor  30.8%  36.1%       8    8.636s
+─Reify.do_reifyf_goal ------------------  35.7%  35.9%     108   10.356s
+─eexact --------------------------------  11.5%  11.5%     110    0.128s
+─Glue.refine_to_reflective_glue' -------   0.0%   6.7%       1    3.692s
+─Glue.zrange_to_reflective -------------   0.0%   6.2%       1    3.424s
+─unify (constr) (constr) ---------------   4.9%   4.9%       7    1.140s
+─Glue.zrange_to_reflective_goal --------   1.4%   4.7%       1    2.592s
+─synthesize ----------------------------   0.0%   4.1%       1    2.284s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   4.0%       1    2.220s
+─change G' -----------------------------   3.9%   3.9%       1    2.148s
+─pose proof  (pf   :   Interpretation.Bo   3.1%   3.1%       1    1.736s
+─rewrite H -----------------------------   3.1%   3.1%       1    1.692s
+─prove_interp_compile_correct ----------   0.0%   3.0%       1    1.636s
+─rewrite ?EtaInterp.InterpExprEta ------   2.7%   2.7%       1    1.484s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  95.9%       1   53.156s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  89.2%       1   49.464s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  88.9%       1   49.288s
+ │ ├─ReflectiveTactics.do_reify --------  -0.0%  49.9%       1   27.684s
+ │ │└Reify.Reify_rhs_gen ---------------   1.3%  49.3%       1   27.348s
+ │ │ ├─Reify.do_reify_abs_goal ---------  36.3%  36.6%       2   20.272s
+ │ │ │└Reify.do_reifyf_goal ------------  35.7%  35.9%     108   10.356s
+ │ │ │└eexact --------------------------  11.1%  11.1%     108    0.072s
+ │ │ ├─rewrite H -----------------------   3.1%   3.1%       1    1.692s
+ │ │ └─prove_interp_compile_correct ----   0.0%   3.0%       1    1.636s
+ │ │  └rewrite ?EtaInterp.InterpExprEta    2.7%   2.7%       1    1.484s
+ │ └─ReflectiveTactics.solve_post_reifie   0.1%  39.0%       1   21.604s
+ │  └UnifyAbstractReflexivity.unify_tran  30.8%  36.1%       8    8.636s
+ │  └unify (constr) (constr) -----------   4.4%   4.4%       6    1.140s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   6.7%       1    3.692s
+  â””Glue.zrange_to_reflective -----------   0.0%   6.2%       1    3.424s
+  â””Glue.zrange_to_reflective_goal ------   1.4%   4.7%       1    2.592s
+  â””pose proof  (pf   :   Interpretation.   3.1%   3.1%       1    1.736s
+─synthesize ----------------------------   0.0%   4.1%       1    2.284s
+â””IntegrationTestTemporaryMiscCommon.do_r   0.0%   4.0%       1    2.220s
+â””change G' -----------------------------   3.9%   3.9%       1    2.148s
+
+Finished transaction in 92.046 secs (84.315u,0.032s) (successful)
+Closed under the global context
+total time:     55.440s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  95.9%       1   53.156s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  89.2%       1   49.464s
+─ReflectiveTactics.solve_side_conditions   0.0%  88.9%       1   49.288s
+─ReflectiveTactics.do_reify ------------  -0.0%  49.9%       1   27.684s
+─Reify.Reify_rhs_gen -------------------   1.3%  49.3%       1   27.348s
+─ReflectiveTactics.solve_post_reified_si   0.1%  39.0%       1   21.604s
+─Reify.do_reify_abs_goal ---------------  36.3%  36.6%       2   20.272s
+─UnifyAbstractReflexivity.unify_transfor  30.8%  36.1%       8    8.636s
+─Reify.do_reifyf_goal ------------------  35.7%  35.9%     108   10.356s
+─eexact --------------------------------  11.5%  11.5%     110    0.128s
+─Glue.refine_to_reflective_glue' -------   0.0%   6.7%       1    3.692s
+─Glue.zrange_to_reflective -------------   0.0%   6.2%       1    3.424s
+─unify (constr) (constr) ---------------   4.9%   4.9%       7    1.140s
+─Glue.zrange_to_reflective_goal --------   1.4%   4.7%       1    2.592s
+─synthesize ----------------------------   0.0%   4.1%       1    2.284s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   4.0%       1    2.220s
+─change G' -----------------------------   3.9%   3.9%       1    2.148s
+─pose proof  (pf   :   Interpretation.Bo   3.1%   3.1%       1    1.736s
+─rewrite H -----------------------------   3.1%   3.1%       1    1.692s
+─prove_interp_compile_correct ----------   0.0%   3.0%       1    1.636s
+─rewrite ?EtaInterp.InterpExprEta ------   2.7%   2.7%       1    1.484s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  95.9%       1   53.156s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  89.2%       1   49.464s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  88.9%       1   49.288s
+ │ ├─ReflectiveTactics.do_reify --------  -0.0%  49.9%       1   27.684s
+ │ │└Reify.Reify_rhs_gen ---------------   1.3%  49.3%       1   27.348s
+ │ │ ├─Reify.do_reify_abs_goal ---------  36.3%  36.6%       2   20.272s
+ │ │ │└Reify.do_reifyf_goal ------------  35.7%  35.9%     108   10.356s
+ │ │ │└eexact --------------------------  11.1%  11.1%     108    0.072s
+ │ │ ├─rewrite H -----------------------   3.1%   3.1%       1    1.692s
+ │ │ └─prove_interp_compile_correct ----   0.0%   3.0%       1    1.636s
+ │ │  └rewrite ?EtaInterp.InterpExprEta    2.7%   2.7%       1    1.484s
+ │ └─ReflectiveTactics.solve_post_reifie   0.1%  39.0%       1   21.604s
+ │  └UnifyAbstractReflexivity.unify_tran  30.8%  36.1%       8    8.636s
+ │  └unify (constr) (constr) -----------   4.4%   4.4%       6    1.140s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   6.7%       1    3.692s
+  â””Glue.zrange_to_reflective -----------   0.0%   6.2%       1    3.424s
+  â””Glue.zrange_to_reflective_goal ------   1.4%   4.7%       1    2.592s
+  â””pose proof  (pf   :   Interpretation.   3.1%   3.1%       1    1.736s
+─synthesize ----------------------------   0.0%   4.1%       1    2.284s
+â””IntegrationTestTemporaryMiscCommon.do_r   0.0%   4.0%       1    2.220s
+â””change G' -----------------------------   3.9%   3.9%       1    2.148s
+
+src/Specific/solinas32_2e255m765_12limbs/femul (real: 179.21, user: 164.11, sys: 0.42, mem: 1549104 ko)
+COQC src/Specific/X25519/C64/fesubDisplay > src/Specific/X25519/C64/fesubDisplay.log
+COQC src/Specific/X25519/C64/freezeDisplay > src/Specific/X25519/C64/freezeDisplay.log
+COQC src/Specific/solinas32_2e255m765_13limbs/femul.v
+Finished transaction in 74.548 secs (68.928u,0.079s) (successful)
+total time:     68.948s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  95.7%       1   65.956s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  88.7%       1   61.172s
+─ReflectiveTactics.solve_side_conditions   0.0%  88.4%       1   60.944s
+─ReflectiveTactics.do_reify ------------   0.0%  48.5%       1   33.408s
+─Reify.Reify_rhs_gen -------------------   1.3%  47.9%       1   33.020s
+─ReflectiveTactics.solve_post_reified_si   0.1%  39.9%       1   27.536s
+─UnifyAbstractReflexivity.unify_transfor  32.0%  37.2%       8   11.528s
+─Reify.do_reify_abs_goal ---------------  36.0%  36.2%       2   24.960s
+─Reify.do_reifyf_goal ------------------  35.3%  35.5%     117   12.840s
+─eexact --------------------------------  11.4%  11.4%     119    0.160s
+─Glue.refine_to_reflective_glue' -------   0.0%   6.9%       1    4.784s
+─Glue.zrange_to_reflective -------------   0.0%   6.5%       1    4.512s
+─Glue.zrange_to_reflective_goal --------   1.3%   4.9%       1    3.396s
+─unify (constr) (constr) ---------------   4.9%   4.9%       7    1.524s
+─synthesize ----------------------------   0.0%   4.3%       1    2.992s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   4.2%       1    2.912s
+─change G' -----------------------------   4.1%   4.1%       1    2.840s
+─pose proof  (pf   :   Interpretation.Bo   3.5%   3.5%       1    2.420s
+─rewrite H -----------------------------   3.0%   3.0%       1    2.084s
+─prove_interp_compile_correct ----------   0.0%   2.7%       1    1.856s
+─rewrite ?EtaInterp.InterpExprEta ------   2.5%   2.5%       1    1.692s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  95.7%       1   65.956s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  88.7%       1   61.172s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  88.4%       1   60.944s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  48.5%       1   33.408s
+ │ │└Reify.Reify_rhs_gen ---------------   1.3%  47.9%       1   33.020s
+ │ │ ├─Reify.do_reify_abs_goal ---------  36.0%  36.2%       2   24.960s
+ │ │ │└Reify.do_reifyf_goal ------------  35.3%  35.5%     117   12.840s
+ │ │ │└eexact --------------------------  10.9%  10.9%     117    0.088s
+ │ │ ├─rewrite H -----------------------   3.0%   3.0%       1    2.084s
+ │ │ └─prove_interp_compile_correct ----   0.0%   2.7%       1    1.856s
+ │ │  └rewrite ?EtaInterp.InterpExprEta    2.5%   2.5%       1    1.692s
+ │ └─ReflectiveTactics.solve_post_reifie   0.1%  39.9%       1   27.536s
+ │  └UnifyAbstractReflexivity.unify_tran  32.0%  37.2%       8   11.528s
+ │  └unify (constr) (constr) -----------   4.3%   4.3%       6    1.524s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   6.9%       1    4.784s
+  â””Glue.zrange_to_reflective -----------   0.0%   6.5%       1    4.512s
+  â””Glue.zrange_to_reflective_goal ------   1.3%   4.9%       1    3.396s
+  â””pose proof  (pf   :   Interpretation.   3.5%   3.5%       1    2.420s
+─synthesize ----------------------------   0.0%   4.3%       1    2.992s
+â””IntegrationTestTemporaryMiscCommon.do_r   0.0%   4.2%       1    2.912s
+â””change G' -----------------------------   4.1%   4.1%       1    2.840s
+
+Finished transaction in 105.62 secs (97.6u,0.02s) (successful)
+Closed under the global context
+total time:     68.948s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  95.7%       1   65.956s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  88.7%       1   61.172s
+─ReflectiveTactics.solve_side_conditions   0.0%  88.4%       1   60.944s
+─ReflectiveTactics.do_reify ------------   0.0%  48.5%       1   33.408s
+─Reify.Reify_rhs_gen -------------------   1.3%  47.9%       1   33.020s
+─ReflectiveTactics.solve_post_reified_si   0.1%  39.9%       1   27.536s
+─UnifyAbstractReflexivity.unify_transfor  32.0%  37.2%       8   11.528s
+─Reify.do_reify_abs_goal ---------------  36.0%  36.2%       2   24.960s
+─Reify.do_reifyf_goal ------------------  35.3%  35.5%     117   12.840s
+─eexact --------------------------------  11.4%  11.4%     119    0.160s
+─Glue.refine_to_reflective_glue' -------   0.0%   6.9%       1    4.784s
+─Glue.zrange_to_reflective -------------   0.0%   6.5%       1    4.512s
+─Glue.zrange_to_reflective_goal --------   1.3%   4.9%       1    3.396s
+─unify (constr) (constr) ---------------   4.9%   4.9%       7    1.524s
+─synthesize ----------------------------   0.0%   4.3%       1    2.992s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   4.2%       1    2.912s
+─change G' -----------------------------   4.1%   4.1%       1    2.840s
+─pose proof  (pf   :   Interpretation.Bo   3.5%   3.5%       1    2.420s
+─rewrite H -----------------------------   3.0%   3.0%       1    2.084s
+─prove_interp_compile_correct ----------   0.0%   2.7%       1    1.856s
+─rewrite ?EtaInterp.InterpExprEta ------   2.5%   2.5%       1    1.692s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  95.7%       1   65.956s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  88.7%       1   61.172s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  88.4%       1   60.944s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  48.5%       1   33.408s
+ │ │└Reify.Reify_rhs_gen ---------------   1.3%  47.9%       1   33.020s
+ │ │ ├─Reify.do_reify_abs_goal ---------  36.0%  36.2%       2   24.960s
+ │ │ │└Reify.do_reifyf_goal ------------  35.3%  35.5%     117   12.840s
+ │ │ │└eexact --------------------------  10.9%  10.9%     117    0.088s
+ │ │ ├─rewrite H -----------------------   3.0%   3.0%       1    2.084s
+ │ │ └─prove_interp_compile_correct ----   0.0%   2.7%       1    1.856s
+ │ │  └rewrite ?EtaInterp.InterpExprEta    2.5%   2.5%       1    1.692s
+ │ └─ReflectiveTactics.solve_post_reifie   0.1%  39.9%       1   27.536s
+ │  └UnifyAbstractReflexivity.unify_tran  32.0%  37.2%       8   11.528s
+ │  └unify (constr) (constr) -----------   4.3%   4.3%       6    1.524s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   6.9%       1    4.784s
+  â””Glue.zrange_to_reflective -----------   0.0%   6.5%       1    4.512s
+  â””Glue.zrange_to_reflective_goal ------   1.3%   4.9%       1    3.396s
+  â””pose proof  (pf   :   Interpretation.   3.5%   3.5%       1    2.420s
+─synthesize ----------------------------   0.0%   4.3%       1    2.992s
+â””IntegrationTestTemporaryMiscCommon.do_r   0.0%   4.2%       1    2.912s
+â””change G' -----------------------------   4.1%   4.1%       1    2.840s
+
+src/Specific/solinas32_2e255m765_13limbs/femul (real: 207.94, user: 192.95, sys: 0.48, mem: 1656912 ko)
+COQC src/Specific/NISTP256/AMD64/femul.v
+Finished transaction in 122.29 secs (111.972u,0.239s) (successful)
+total time:    112.164s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.1%       1  108.944s
+─ReflectiveTactics.do_reflective_pipelin  -0.0%  96.5%       1  108.236s
+─ReflectiveTactics.solve_side_conditions   0.0%  96.3%       1  108.000s
+─ReflectiveTactics.do_reify ------------   0.0%  81.8%       1   91.740s
+─Reify.Reify_rhs_gen -------------------   0.7%  81.6%       1   91.504s
+─Reify.do_reify_abs_goal ---------------  75.6%  75.7%       2   84.892s
+─Reify.do_reifyf_goal ------------------  75.2%  75.4%     901   84.532s
+─eexact --------------------------------  17.1%  17.1%     903    0.140s
+─ReflectiveTactics.solve_post_reified_si   0.2%  14.5%       1   16.260s
+─UnifyAbstractReflexivity.unify_transfor  11.7%  13.3%       8    3.152s
+─synthesize_montgomery -----------------   0.0%   2.9%       1    3.220s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.1%       1  108.944s
+â””ReflectiveTactics.do_reflective_pipelin  -0.0%  96.5%       1  108.236s
+â””ReflectiveTactics.solve_side_conditions   0.0%  96.3%       1  108.000s
+ ├─ReflectiveTactics.do_reify ----------   0.0%  81.8%       1   91.740s
+ │└Reify.Reify_rhs_gen -----------------   0.7%  81.6%       1   91.504s
+ │└Reify.do_reify_abs_goal -------------  75.6%  75.7%       2   84.892s
+ │└Reify.do_reifyf_goal ----------------  75.2%  75.4%     901   84.532s
+ │└eexact ------------------------------  16.9%  16.9%     901    0.140s
+ └─ReflectiveTactics.solve_post_reified_   0.2%  14.5%       1   16.260s
+  â””UnifyAbstractReflexivity.unify_transf  11.7%  13.3%       8    3.152s
+─synthesize_montgomery -----------------   0.0%   2.9%       1    3.220s
+
+Finished transaction in 72.408 secs (68.432u,0.064s) (successful)
+Closed under the global context
+total time:    112.164s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.1%       1  108.944s
+─ReflectiveTactics.do_reflective_pipelin  -0.0%  96.5%       1  108.236s
+─ReflectiveTactics.solve_side_conditions   0.0%  96.3%       1  108.000s
+─ReflectiveTactics.do_reify ------------   0.0%  81.8%       1   91.740s
+─Reify.Reify_rhs_gen -------------------   0.7%  81.6%       1   91.504s
+─Reify.do_reify_abs_goal ---------------  75.6%  75.7%       2   84.892s
+─Reify.do_reifyf_goal ------------------  75.2%  75.4%     901   84.532s
+─eexact --------------------------------  17.1%  17.1%     903    0.140s
+─ReflectiveTactics.solve_post_reified_si   0.2%  14.5%       1   16.260s
+─UnifyAbstractReflexivity.unify_transfor  11.7%  13.3%       8    3.152s
+─synthesize_montgomery -----------------   0.0%   2.9%       1    3.220s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.1%       1  108.944s
+â””ReflectiveTactics.do_reflective_pipelin  -0.0%  96.5%       1  108.236s
+â””ReflectiveTactics.solve_side_conditions   0.0%  96.3%       1  108.000s
+ ├─ReflectiveTactics.do_reify ----------   0.0%  81.8%       1   91.740s
+ │└Reify.Reify_rhs_gen -----------------   0.7%  81.6%       1   91.504s
+ │└Reify.do_reify_abs_goal -------------  75.6%  75.7%       2   84.892s
+ │└Reify.do_reifyf_goal ----------------  75.2%  75.4%     901   84.532s
+ │└eexact ------------------------------  16.9%  16.9%     901    0.140s
+ └─ReflectiveTactics.solve_post_reified_   0.2%  14.5%       1   16.260s
+  â””UnifyAbstractReflexivity.unify_transf  11.7%  13.3%       8    3.152s
+─synthesize_montgomery -----------------   0.0%   2.9%       1    3.220s
+
+src/Specific/NISTP256/AMD64/femul (real: 217.80, user: 202.52, sys: 0.53, mem: 3307052 ko)
+COQC src/Specific/NISTP256/AMD64/femulDisplay > src/Specific/NISTP256/AMD64/femulDisplay.log
+COQC src/Specific/X25519/C64/ladderstep.v
+total time:     82.012s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_xzladderstep ---------------   0.0% 100.0%       1   82.012s
+─Pipeline.refine_reflectively_gen ------   0.0%  99.0%       1   81.228s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  96.1%       1   78.784s
+─ReflectiveTactics.solve_side_conditions   0.0%  95.9%       1   78.684s
+─ReflectiveTactics.solve_post_reified_si   0.1%  72.6%       1   59.540s
+─UnifyAbstractReflexivity.unify_transfor  64.6%  68.0%       8   30.740s
+─ReflectiveTactics.do_reify ------------   0.0%  23.3%       1   19.144s
+─Reify.Reify_rhs_gen -------------------   1.2%  14.5%       1   11.860s
+─Reify.do_reifyf_goal ------------------   7.1%   7.2%     138    1.908s
+─Compilers.Reify.reify_context_variables   0.0%   5.9%       1    4.828s
+─rewrite H -----------------------------   4.4%   4.4%       1    3.600s
+─ReflectiveTactics.unify_abstract_cbv_in   2.9%   4.0%       1    3.288s
+─Glue.refine_to_reflective_glue' -------   0.0%   3.0%       1    2.444s
+─Glue.zrange_to_reflective -------------   0.0%   2.5%       1    2.060s
+─reflexivity ---------------------------   2.3%   2.3%      11    0.816s
+─Reify.transitivity_tt -----------------   0.0%   2.1%       2    0.968s
+─Glue.zrange_to_reflective_goal --------   1.4%   2.1%       1    1.720s
+─clear (var_list) ----------------------   2.0%   2.0%     159    0.584s
+─eexact --------------------------------   2.0%   2.0%     140    0.032s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_xzladderstep ---------------   0.0% 100.0%       1   82.012s
+â””Pipeline.refine_reflectively_gen ------   0.0%  99.0%       1   81.228s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  96.1%       1   78.784s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  95.9%       1   78.684s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.1%  72.6%       1   59.540s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  64.6%  68.0%       8   30.740s
+ │ │ └─ReflectiveTactics.unify_abstract_   2.9%   4.0%       1    3.288s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  23.3%       1   19.144s
+ │   ├─Reify.Reify_rhs_gen -------------   1.2%  14.5%       1   11.860s
+ │   │ ├─rewrite H ---------------------   4.4%   4.4%       1    3.600s
+ │   │ └─Reify.transitivity_tt ---------   0.0%   2.1%       2    0.968s
+ │   └─Compilers.Reify.reify_context_var   0.0%   5.9%       1    4.828s
+ │    └Reify.do_reifyf_goal ------------   5.7%   5.8%     113    1.908s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   3.0%       1    2.444s
+  â””Glue.zrange_to_reflective -----------   0.0%   2.5%       1    2.060s
+  â””Glue.zrange_to_reflective_goal ------   1.4%   2.1%       1    1.720s
+
+Finished transaction in 194.903 secs (185.732u,0.043s) (successful)
+Closed under the global context
+total time:     82.012s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_xzladderstep ---------------   0.0% 100.0%       1   82.012s
+─Pipeline.refine_reflectively_gen ------   0.0%  99.0%       1   81.228s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  96.1%       1   78.784s
+─ReflectiveTactics.solve_side_conditions   0.0%  95.9%       1   78.684s
+─ReflectiveTactics.solve_post_reified_si   0.1%  72.6%       1   59.540s
+─UnifyAbstractReflexivity.unify_transfor  64.6%  68.0%       8   30.740s
+─ReflectiveTactics.do_reify ------------   0.0%  23.3%       1   19.144s
+─Reify.Reify_rhs_gen -------------------   1.2%  14.5%       1   11.860s
+─Reify.do_reifyf_goal ------------------   7.1%   7.2%     138    1.908s
+─Compilers.Reify.reify_context_variables   0.0%   5.9%       1    4.828s
+─rewrite H -----------------------------   4.4%   4.4%       1    3.600s
+─ReflectiveTactics.unify_abstract_cbv_in   2.9%   4.0%       1    3.288s
+─Glue.refine_to_reflective_glue' -------   0.0%   3.0%       1    2.444s
+─Glue.zrange_to_reflective -------------   0.0%   2.5%       1    2.060s
+─reflexivity ---------------------------   2.3%   2.3%      11    0.816s
+─Reify.transitivity_tt -----------------   0.0%   2.1%       2    0.968s
+─Glue.zrange_to_reflective_goal --------   1.4%   2.1%       1    1.720s
+─clear (var_list) ----------------------   2.0%   2.0%     159    0.584s
+─eexact --------------------------------   2.0%   2.0%     140    0.032s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_xzladderstep ---------------   0.0% 100.0%       1   82.012s
+â””Pipeline.refine_reflectively_gen ------   0.0%  99.0%       1   81.228s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  96.1%       1   78.784s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  95.9%       1   78.684s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.1%  72.6%       1   59.540s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  64.6%  68.0%       8   30.740s
+ │ │ └─ReflectiveTactics.unify_abstract_   2.9%   4.0%       1    3.288s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  23.3%       1   19.144s
+ │   ├─Reify.Reify_rhs_gen -------------   1.2%  14.5%       1   11.860s
+ │   │ ├─rewrite H ---------------------   4.4%   4.4%       1    3.600s
+ │   │ └─Reify.transitivity_tt ---------   0.0%   2.1%       2    0.968s
+ │   └─Compilers.Reify.reify_context_var   0.0%   5.9%       1    4.828s
+ │    └Reify.do_reifyf_goal ------------   5.7%   5.8%     113    1.908s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   3.0%       1    2.444s
+  â””Glue.zrange_to_reflective -----------   0.0%   2.5%       1    2.060s
+  â””Glue.zrange_to_reflective_goal ------   1.4%   2.1%       1    1.720s
+
+src/Specific/X25519/C64/ladderstep (real: 316.83, user: 299.49, sys: 0.52, mem: 1621500 ko)
+COQC src/Specific/X25519/C64/ladderstepDisplay > src/Specific/X25519/C64/ladderstepDisplay.log
diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both.log.expected
new file mode 100644
index 000000000..975e359b7
--- /dev/null
+++ b/test-suite/coq-makefile/timing/precomputed-time-tests/001-correct-diff-sorting-order/time-of-build-both.log.expected
@@ -0,0 +1,26 @@
+After     | File Name                                      | Before    || Change    | % Change
+----------------------------------------------------------------------------------------------
+19m16.05s | Total                                          | 21m25.28s || -2m09.23s | -10.05% 
+----------------------------------------------------------------------------------------------
+4m01.34s  | Specific/X25519/C64/ladderstep                 | 4m59.49s  || -0m58.15s | -19.41% 
+2m48.52s  | Specific/solinas32_2e255m765_13limbs/femul     | 3m12.95s  || -0m24.42s | -12.66% 
+2m23.70s  | Specific/solinas32_2e255m765_12limbs/femul     | 2m44.11s  || -0m20.41s | -12.43% 
+3m09.62s  | Specific/NISTP256/AMD64/femul                  | 3m22.52s  || -0m12.90s | -6.36%  
+0m36.32s  | Specific/X25519/C64/femul                      | 0m39.50s  || -0m03.17s | -8.05%  
+0m30.13s  | Specific/X25519/C64/fesquare                   | 0m32.24s  || -0m02.11s | -6.54%  
+0m35.40s  | Specific/NISTP256/AMD64/feadd                  | 0m37.21s  || -0m01.81s | -4.86%  
+0m31.50s  | Specific/X25519/C64/freeze                     | 0m33.24s  || -0m01.74s | -5.23%  
+0m24.99s  | Specific/X25519/C64/fecarry                    | 0m26.31s  || -0m01.32s | -5.01%  
+0m22.65s  | Specific/X25519/C64/fesub                      | 0m23.72s  || -0m01.07s | -4.51%  
+0m45.75s  | Specific/solinas32_2e255m765_13limbs/Synthesis | 0m45.58s  || +0m00.17s | +0.37%  
+0m39.59s  | Specific/NISTP256/AMD64/fesub                  | 0m40.09s  || -0m00.50s | -1.24%  
+0m36.92s  | Specific/solinas32_2e255m765_12limbs/Synthesis | 0m36.64s  || +0m00.28s | +0.76%  
+0m28.51s  | Specific/NISTP256/AMD64/feopp                  | 0m29.46s  || -0m00.94s | -3.22%  
+0m25.50s  | Specific/NISTP256/AMD64/fenz                   | 0m26.41s  || -0m00.91s | -3.44%  
+0m20.93s  | Specific/X25519/C64/feadd                      | 0m21.41s  || -0m00.48s | -2.24%  
+0m12.55s  | Specific/NISTP256/AMD64/Synthesis              | 0m12.54s  || +0m00.01s | +0.07%  
+0m10.37s  | Specific/X25519/C64/Synthesis                  | 0m10.30s  || +0m00.06s | +0.67%  
+0m07.18s  | Compilers/Z/Bounds/Pipeline/Definition         | 0m07.22s  || -0m00.04s | -0.55%  
+0m01.72s  | Compilers/Z/Bounds/Pipeline/ReflectiveTactics  | 0m01.58s  || +0m00.13s | +8.86%  
+0m01.67s  | Specific/Framework/SynthesisFramework          | 0m01.72s  || -0m00.05s | -2.90%  
+0m01.19s  | Compilers/Z/Bounds/Pipeline                    | 0m01.04s  || +0m00.14s | +14.42% 
\ No newline at end of file
diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/002-single-file-sorting/run.sh b/test-suite/coq-makefile/timing/precomputed-time-tests/002-single-file-sorting/run.sh
new file mode 100755
index 000000000..4f39b3ce7
--- /dev/null
+++ b/test-suite/coq-makefile/timing/precomputed-time-tests/002-single-file-sorting/run.sh
@@ -0,0 +1,10 @@
+#!/usr/bin/env bash
+
+set -x
+set -e
+
+cd "$(dirname "${BASH_SOURCE[0]}")"
+
+"$COQLIB"/tools/make-one-time-file.py time-of-build.log.in time-of-build-pretty.log
+
+diff -u time-of-build-pretty.log.expected time-of-build-pretty.log || exit $?
diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/002-single-file-sorting/time-of-build-pretty.log.expected b/test-suite/coq-makefile/timing/precomputed-time-tests/002-single-file-sorting/time-of-build-pretty.log.expected
new file mode 100644
index 000000000..fdd5ec21d
--- /dev/null
+++ b/test-suite/coq-makefile/timing/precomputed-time-tests/002-single-file-sorting/time-of-build-pretty.log.expected
@@ -0,0 +1,26 @@
+Time      | File Name                                     
+----------------------------------------------------------
+19m16.05s | Total                                         
+----------------------------------------------------------
+4m01.34s  | Specific/X25519/C64/ladderstep                
+3m09.62s  | Specific/NISTP256/AMD64/femul                 
+2m48.52s  | Specific/solinas32_2e255m765_13limbs/femul    
+2m23.70s  | Specific/solinas32_2e255m765_12limbs/femul    
+0m45.75s  | Specific/solinas32_2e255m765_13limbs/Synthesis
+0m39.59s  | Specific/NISTP256/AMD64/fesub                 
+0m36.92s  | Specific/solinas32_2e255m765_12limbs/Synthesis
+0m36.32s  | Specific/X25519/C64/femul                     
+0m35.40s  | Specific/NISTP256/AMD64/feadd                 
+0m31.50s  | Specific/X25519/C64/freeze                    
+0m30.13s  | Specific/X25519/C64/fesquare                  
+0m28.51s  | Specific/NISTP256/AMD64/feopp                 
+0m25.50s  | Specific/NISTP256/AMD64/fenz                  
+0m24.99s  | Specific/X25519/C64/fecarry                   
+0m22.65s  | Specific/X25519/C64/fesub                     
+0m20.93s  | Specific/X25519/C64/feadd                     
+0m12.55s  | Specific/NISTP256/AMD64/Synthesis             
+0m10.37s  | Specific/X25519/C64/Synthesis                 
+0m07.18s  | Compilers/Z/Bounds/Pipeline/Definition        
+0m01.72s  | Compilers/Z/Bounds/Pipeline/ReflectiveTactics 
+0m01.67s  | Specific/Framework/SynthesisFramework         
+0m01.19s  | Compilers/Z/Bounds/Pipeline                   
\ No newline at end of file
diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/002-single-file-sorting/time-of-build.log.in b/test-suite/coq-makefile/timing/precomputed-time-tests/002-single-file-sorting/time-of-build.log.in
new file mode 100644
index 000000000..5757018e9
--- /dev/null
+++ b/test-suite/coq-makefile/timing/precomputed-time-tests/002-single-file-sorting/time-of-build.log.in
@@ -0,0 +1,1760 @@
+COQDEP src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics.v
+COQDEP src/Compilers/Z/Bounds/Pipeline/Definition.v
+/home/jgross/.local64/coq/coq-master/bin/coq_makefile -f _CoqProject INSTALLDEFAULTROOT = Crypto -o Makefile-old
+COQ_MAKEFILE -f _CoqProject > Makefile.coq
+make --no-print-directory -C coqprime
+make[1]: Nothing to be done for 'all'.
+ECHO > _CoqProject
+COQC src/Compilers/Z/Bounds/Pipeline/Definition.v
+src/Compilers/Z/Bounds/Pipeline/Definition (real: 7.33, user: 7.18, sys: 0.14, mem: 574388 ko)
+COQC src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics.v
+src/Compilers/Z/Bounds/Pipeline/ReflectiveTactics (real: 1.93, user: 1.72, sys: 0.20, mem: 544172 ko)
+COQC src/Compilers/Z/Bounds/Pipeline.v
+src/Compilers/Z/Bounds/Pipeline (real: 1.38, user: 1.19, sys: 0.16, mem: 539808 ko)
+COQC src/Specific/Framework/SynthesisFramework.v
+src/Specific/Framework/SynthesisFramework (real: 1.85, user: 1.67, sys: 0.17, mem: 646300 ko)
+COQC src/Specific/X25519/C64/Synthesis.v
+src/Specific/X25519/C64/Synthesis (real: 11.15, user: 10.37, sys: 0.18, mem: 687760 ko)
+COQC src/Specific/NISTP256/AMD64/Synthesis.v
+src/Specific/NISTP256/AMD64/Synthesis (real: 13.45, user: 12.55, sys: 0.19, mem: 668216 ko)
+COQC src/Specific/X25519/C64/feadd.v
+Finished transaction in 2.814 secs (2.624u,0.s) (successful)
+total time:      2.576s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.2%  97.4%       1    2.508s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  66.9%       1    1.724s
+─ReflectiveTactics.solve_side_conditions   0.0%  65.5%       1    1.688s
+─ReflectiveTactics.solve_post_reified_si   1.2%  37.0%       1    0.952s
+─Glue.refine_to_reflective_glue' -------   0.0%  30.3%       1    0.780s
+─ReflectiveTactics.do_reify ------------   0.0%  28.6%       1    0.736s
+─Reify.Reify_rhs_gen -------------------   2.2%  26.6%       1    0.684s
+─UnifyAbstractReflexivity.unify_transfor  20.3%  24.1%       7    0.164s
+─Glue.zrange_to_reflective -------------   0.0%  20.3%       1    0.524s
+─Glue.zrange_to_reflective_goal --------   9.5%  15.2%       1    0.392s
+─Reify.do_reify_abs_goal ---------------  13.7%  13.8%       2    0.356s
+─Reify.do_reifyf_goal ------------------  12.4%  12.6%      16    0.324s
+─ReflectiveTactics.unify_abstract_cbv_in   8.4%  11.2%       1    0.288s
+─unify (constr) (constr) ---------------   5.7%   5.7%       6    0.072s
+─Glue.pattern_sig_sig_assoc ------------   0.0%   5.4%       1    0.140s
+─assert (H : is_bounded_by' bounds (map'   4.8%   5.1%       2    0.072s
+─Glue.pattern_proj1_sig_in_sig ---------   1.7%   5.1%       1    0.132s
+─pose proof  (pf   :   Interpretation.Bo   3.7%   3.7%       1    0.096s
+─Glue.split_BoundedWordToZ -------------   0.3%   3.7%       1    0.096s
+─destruct_sig --------------------------   0.2%   3.3%       4    0.044s
+─destruct x ----------------------------   3.1%   3.1%       4    0.036s
+─eexact --------------------------------   3.0%   3.0%      18    0.008s
+─clearbody (ne_var_list) ---------------   3.0%   3.0%       4    0.060s
+─prove_interp_compile_correct ----------   0.0%   2.8%       1    0.072s
+─synthesize ----------------------------   0.0%   2.6%       1    0.068s
+─rewrite ?EtaInterp.InterpExprEta ------   2.5%   2.5%       1    0.064s
+─ClearbodyAll.clearbody_all ------------   0.0%   2.3%       2    0.060s
+─rewrite H -----------------------------   2.2%   2.2%       1    0.056s
+─reflexivity ---------------------------   2.2%   2.2%       7    0.032s
+─Reify.transitivity_tt -----------------   0.0%   2.2%       2    0.032s
+─transitivity --------------------------   2.0%   2.0%       5    0.024s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.2%  97.4%       1    2.508s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  66.9%       1    1.724s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  65.5%       1    1.688s
+ │ ├─ReflectiveTactics.solve_post_reifie   1.2%  37.0%       1    0.952s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  20.3%  24.1%       7    0.164s
+ │ │ │└unify (constr) (constr) ---------   3.0%   3.0%       5    0.028s
+ │ │ └─ReflectiveTactics.unify_abstract_   8.4%  11.2%       1    0.288s
+ │ │  └unify (constr) (constr) ---------   2.8%   2.8%       1    0.072s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  28.6%       1    0.736s
+ │  └Reify.Reify_rhs_gen ---------------   2.2%  26.6%       1    0.684s
+ │   ├─Reify.do_reify_abs_goal ---------  13.7%  13.8%       2    0.356s
+ │   │└Reify.do_reifyf_goal ------------  12.4%  12.6%      16    0.324s
+ │   │└eexact --------------------------   2.6%   2.6%      16    0.008s
+ │   ├─prove_interp_compile_correct ----   0.0%   2.8%       1    0.072s
+ │   │└rewrite ?EtaInterp.InterpExprEta    2.5%   2.5%       1    0.064s
+ │   ├─rewrite H -----------------------   2.2%   2.2%       1    0.056s
+ │   └─Reify.transitivity_tt -----------   0.0%   2.2%       2    0.032s
+ └─Glue.refine_to_reflective_glue' -----   0.0%  30.3%       1    0.780s
+   ├─Glue.zrange_to_reflective ---------   0.0%  20.3%       1    0.524s
+   │ ├─Glue.zrange_to_reflective_goal --   9.5%  15.2%       1    0.392s
+   │ │└pose proof  (pf   :   Interpretat   3.7%   3.7%       1    0.096s
+   │ └─assert (H : is_bounded_by' bounds   4.8%   5.1%       2    0.072s
+   ├─Glue.pattern_sig_sig_assoc --------   0.0%   5.4%       1    0.140s
+   │└Glue.pattern_proj1_sig_in_sig -----   1.7%   5.1%       1    0.132s
+   │└ClearbodyAll.clearbody_all --------   0.0%   2.3%       2    0.060s
+   │└clearbody (ne_var_list) -----------   2.3%   2.3%       1    0.060s
+   └─Glue.split_BoundedWordToZ ---------   0.3%   3.7%       1    0.096s
+    â””destruct_sig ----------------------   0.2%   3.3%       4    0.044s
+    â””destruct x ------------------------   2.5%   2.5%       2    0.036s
+─synthesize ----------------------------   0.0%   2.6%       1    0.068s
+
+Finished transaction in 5.021 secs (4.636u,0.s) (successful)
+Closed under the global context
+total time:      2.576s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.2%  97.4%       1    2.508s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  66.9%       1    1.724s
+─ReflectiveTactics.solve_side_conditions   0.0%  65.5%       1    1.688s
+─ReflectiveTactics.solve_post_reified_si   1.2%  37.0%       1    0.952s
+─Glue.refine_to_reflective_glue' -------   0.0%  30.3%       1    0.780s
+─ReflectiveTactics.do_reify ------------   0.0%  28.6%       1    0.736s
+─Reify.Reify_rhs_gen -------------------   2.2%  26.6%       1    0.684s
+─UnifyAbstractReflexivity.unify_transfor  20.3%  24.1%       7    0.164s
+─Glue.zrange_to_reflective -------------   0.0%  20.3%       1    0.524s
+─Glue.zrange_to_reflective_goal --------   9.5%  15.2%       1    0.392s
+─Reify.do_reify_abs_goal ---------------  13.7%  13.8%       2    0.356s
+─Reify.do_reifyf_goal ------------------  12.4%  12.6%      16    0.324s
+─ReflectiveTactics.unify_abstract_cbv_in   8.4%  11.2%       1    0.288s
+─unify (constr) (constr) ---------------   5.7%   5.7%       6    0.072s
+─Glue.pattern_sig_sig_assoc ------------   0.0%   5.4%       1    0.140s
+─assert (H : is_bounded_by' bounds (map'   4.8%   5.1%       2    0.072s
+─Glue.pattern_proj1_sig_in_sig ---------   1.7%   5.1%       1    0.132s
+─pose proof  (pf   :   Interpretation.Bo   3.7%   3.7%       1    0.096s
+─Glue.split_BoundedWordToZ -------------   0.3%   3.7%       1    0.096s
+─destruct_sig --------------------------   0.2%   3.3%       4    0.044s
+─destruct x ----------------------------   3.1%   3.1%       4    0.036s
+─eexact --------------------------------   3.0%   3.0%      18    0.008s
+─clearbody (ne_var_list) ---------------   3.0%   3.0%       4    0.060s
+─prove_interp_compile_correct ----------   0.0%   2.8%       1    0.072s
+─synthesize ----------------------------   0.0%   2.6%       1    0.068s
+─rewrite ?EtaInterp.InterpExprEta ------   2.5%   2.5%       1    0.064s
+─ClearbodyAll.clearbody_all ------------   0.0%   2.3%       2    0.060s
+─rewrite H -----------------------------   2.2%   2.2%       1    0.056s
+─reflexivity ---------------------------   2.2%   2.2%       7    0.032s
+─Reify.transitivity_tt -----------------   0.0%   2.2%       2    0.032s
+─transitivity --------------------------   2.0%   2.0%       5    0.024s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.2%  97.4%       1    2.508s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  66.9%       1    1.724s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  65.5%       1    1.688s
+ │ ├─ReflectiveTactics.solve_post_reifie   1.2%  37.0%       1    0.952s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  20.3%  24.1%       7    0.164s
+ │ │ │└unify (constr) (constr) ---------   3.0%   3.0%       5    0.028s
+ │ │ └─ReflectiveTactics.unify_abstract_   8.4%  11.2%       1    0.288s
+ │ │  └unify (constr) (constr) ---------   2.8%   2.8%       1    0.072s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  28.6%       1    0.736s
+ │  └Reify.Reify_rhs_gen ---------------   2.2%  26.6%       1    0.684s
+ │   ├─Reify.do_reify_abs_goal ---------  13.7%  13.8%       2    0.356s
+ │   │└Reify.do_reifyf_goal ------------  12.4%  12.6%      16    0.324s
+ │   │└eexact --------------------------   2.6%   2.6%      16    0.008s
+ │   ├─prove_interp_compile_correct ----   0.0%   2.8%       1    0.072s
+ │   │└rewrite ?EtaInterp.InterpExprEta    2.5%   2.5%       1    0.064s
+ │   ├─rewrite H -----------------------   2.2%   2.2%       1    0.056s
+ │   └─Reify.transitivity_tt -----------   0.0%   2.2%       2    0.032s
+ └─Glue.refine_to_reflective_glue' -----   0.0%  30.3%       1    0.780s
+   ├─Glue.zrange_to_reflective ---------   0.0%  20.3%       1    0.524s
+   │ ├─Glue.zrange_to_reflective_goal --   9.5%  15.2%       1    0.392s
+   │ │└pose proof  (pf   :   Interpretat   3.7%   3.7%       1    0.096s
+   │ └─assert (H : is_bounded_by' bounds   4.8%   5.1%       2    0.072s
+   ├─Glue.pattern_sig_sig_assoc --------   0.0%   5.4%       1    0.140s
+   │└Glue.pattern_proj1_sig_in_sig -----   1.7%   5.1%       1    0.132s
+   │└ClearbodyAll.clearbody_all --------   0.0%   2.3%       2    0.060s
+   │└clearbody (ne_var_list) -----------   2.3%   2.3%       1    0.060s
+   └─Glue.split_BoundedWordToZ ---------   0.3%   3.7%       1    0.096s
+    â””destruct_sig ----------------------   0.2%   3.3%       4    0.044s
+    â””destruct x ------------------------   2.5%   2.5%       2    0.036s
+─synthesize ----------------------------   0.0%   2.6%       1    0.068s
+
+src/Specific/X25519/C64/feadd (real: 22.81, user: 20.93, sys: 0.25, mem: 766300 ko)
+COQC src/Specific/X25519/C64/fecarry.v
+Finished transaction in 4.343 secs (4.016u,0.004s) (successful)
+total time:      3.976s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  99.0%       1    3.936s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  87.9%       1    3.496s
+─ReflectiveTactics.solve_side_conditions   0.0%  86.9%       1    3.456s
+─ReflectiveTactics.do_reify ------------   0.0%  56.9%       1    2.264s
+─Reify.Reify_rhs_gen -------------------   1.8%  56.2%       1    2.236s
+─Reify.do_reify_abs_goal ---------------  36.1%  36.5%       2    1.452s
+─Reify.do_reifyf_goal ------------------  34.8%  35.1%      29    1.396s
+─ReflectiveTactics.solve_post_reified_si   0.6%  30.0%       1    1.192s
+─UnifyAbstractReflexivity.unify_transfor  17.7%  21.7%       7    0.240s
+─Glue.refine_to_reflective_glue' -------   0.0%  11.1%       1    0.440s
+─eexact --------------------------------  10.9%  10.9%      31    0.024s
+─ReflectiveTactics.unify_abstract_cbv_in   5.2%   7.3%       1    0.292s
+─Glue.zrange_to_reflective -------------   0.0%   7.1%       1    0.284s
+─prove_interp_compile_correct ----------   0.0%   5.7%       1    0.228s
+─Glue.zrange_to_reflective_goal --------   4.3%   5.5%       1    0.220s
+─unify (constr) (constr) ---------------   5.3%   5.3%       6    0.084s
+─rewrite ?EtaInterp.InterpExprEta ------   5.2%   5.2%       1    0.208s
+─rewrite H -----------------------------   3.5%   3.5%       1    0.140s
+─tac -----------------------------------   1.9%   2.6%       2    0.104s
+─reflexivity ---------------------------   2.2%   2.2%       7    0.028s
+─Reify.transitivity_tt -----------------   0.0%   2.2%       2    0.056s
+─transitivity --------------------------   2.0%   2.0%       5    0.048s
+─Glue.split_BoundedWordToZ -------------   0.1%   2.0%       1    0.080s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  99.0%       1    3.936s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  87.9%       1    3.496s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  86.9%       1    3.456s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  56.9%       1    2.264s
+ │ │└Reify.Reify_rhs_gen ---------------   1.8%  56.2%       1    2.236s
+ │ │ ├─Reify.do_reify_abs_goal ---------  36.1%  36.5%       2    1.452s
+ │ │ │└Reify.do_reifyf_goal ------------  34.8%  35.1%      29    1.396s
+ │ │ │└eexact --------------------------  10.1%  10.1%      29    0.024s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   5.7%       1    0.228s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    5.2%   5.2%       1    0.208s
+ │ │ ├─rewrite H -----------------------   3.5%   3.5%       1    0.140s
+ │ │ ├─tac -----------------------------   1.9%   2.6%       1    0.104s
+ │ │ └─Reify.transitivity_tt -----------   0.0%   2.2%       2    0.056s
+ │ │  └transitivity --------------------   2.0%   2.0%       4    0.048s
+ │ └─ReflectiveTactics.solve_post_reifie   0.6%  30.0%       1    1.192s
+ │   ├─UnifyAbstractReflexivity.unify_tr  17.7%  21.7%       7    0.240s
+ │   │└unify (constr) (constr) ---------   3.2%   3.2%       5    0.048s
+ │   └─ReflectiveTactics.unify_abstract_   5.2%   7.3%       1    0.292s
+ │    └unify (constr) (constr) ---------   2.1%   2.1%       1    0.084s
+ └─Glue.refine_to_reflective_glue' -----   0.0%  11.1%       1    0.440s
+   ├─Glue.zrange_to_reflective ---------   0.0%   7.1%       1    0.284s
+   │└Glue.zrange_to_reflective_goal ----   4.3%   5.5%       1    0.220s
+   └─Glue.split_BoundedWordToZ ---------   0.1%   2.0%       1    0.080s
+
+Finished transaction in 7.078 secs (6.728u,0.s) (successful)
+Closed under the global context
+total time:      3.976s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  99.0%       1    3.936s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  87.9%       1    3.496s
+─ReflectiveTactics.solve_side_conditions   0.0%  86.9%       1    3.456s
+─ReflectiveTactics.do_reify ------------   0.0%  56.9%       1    2.264s
+─Reify.Reify_rhs_gen -------------------   1.8%  56.2%       1    2.236s
+─Reify.do_reify_abs_goal ---------------  36.1%  36.5%       2    1.452s
+─Reify.do_reifyf_goal ------------------  34.8%  35.1%      29    1.396s
+─ReflectiveTactics.solve_post_reified_si   0.6%  30.0%       1    1.192s
+─UnifyAbstractReflexivity.unify_transfor  17.7%  21.7%       7    0.240s
+─Glue.refine_to_reflective_glue' -------   0.0%  11.1%       1    0.440s
+─eexact --------------------------------  10.9%  10.9%      31    0.024s
+─ReflectiveTactics.unify_abstract_cbv_in   5.2%   7.3%       1    0.292s
+─Glue.zrange_to_reflective -------------   0.0%   7.1%       1    0.284s
+─prove_interp_compile_correct ----------   0.0%   5.7%       1    0.228s
+─Glue.zrange_to_reflective_goal --------   4.3%   5.5%       1    0.220s
+─unify (constr) (constr) ---------------   5.3%   5.3%       6    0.084s
+─rewrite ?EtaInterp.InterpExprEta ------   5.2%   5.2%       1    0.208s
+─rewrite H -----------------------------   3.5%   3.5%       1    0.140s
+─tac -----------------------------------   1.9%   2.6%       2    0.104s
+─reflexivity ---------------------------   2.2%   2.2%       7    0.028s
+─Reify.transitivity_tt -----------------   0.0%   2.2%       2    0.056s
+─transitivity --------------------------   2.0%   2.0%       5    0.048s
+─Glue.split_BoundedWordToZ -------------   0.1%   2.0%       1    0.080s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  99.0%       1    3.936s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  87.9%       1    3.496s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  86.9%       1    3.456s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  56.9%       1    2.264s
+ │ │└Reify.Reify_rhs_gen ---------------   1.8%  56.2%       1    2.236s
+ │ │ ├─Reify.do_reify_abs_goal ---------  36.1%  36.5%       2    1.452s
+ │ │ │└Reify.do_reifyf_goal ------------  34.8%  35.1%      29    1.396s
+ │ │ │└eexact --------------------------  10.1%  10.1%      29    0.024s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   5.7%       1    0.228s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    5.2%   5.2%       1    0.208s
+ │ │ ├─rewrite H -----------------------   3.5%   3.5%       1    0.140s
+ │ │ ├─tac -----------------------------   1.9%   2.6%       1    0.104s
+ │ │ └─Reify.transitivity_tt -----------   0.0%   2.2%       2    0.056s
+ │ │  └transitivity --------------------   2.0%   2.0%       4    0.048s
+ │ └─ReflectiveTactics.solve_post_reifie   0.6%  30.0%       1    1.192s
+ │   ├─UnifyAbstractReflexivity.unify_tr  17.7%  21.7%       7    0.240s
+ │   │└unify (constr) (constr) ---------   3.2%   3.2%       5    0.048s
+ │   └─ReflectiveTactics.unify_abstract_   5.2%   7.3%       1    0.292s
+ │    └unify (constr) (constr) ---------   2.1%   2.1%       1    0.084s
+ └─Glue.refine_to_reflective_glue' -----   0.0%  11.1%       1    0.440s
+   ├─Glue.zrange_to_reflective ---------   0.0%   7.1%       1    0.284s
+   │└Glue.zrange_to_reflective_goal ----   4.3%   5.5%       1    0.220s
+   └─Glue.split_BoundedWordToZ ---------   0.1%   2.0%       1    0.080s
+
+src/Specific/X25519/C64/fecarry (real: 27.11, user: 24.99, sys: 0.21, mem: 786052 ko)
+COQC src/Specific/solinas32_2e255m765_12limbs/Synthesis.v
+src/Specific/solinas32_2e255m765_12limbs/Synthesis (real: 40.13, user: 36.92, sys: 0.26, mem: 728464 ko)
+COQC src/Specific/solinas32_2e255m765_13limbs/Synthesis.v
+src/Specific/solinas32_2e255m765_13limbs/Synthesis (real: 49.44, user: 45.75, sys: 0.18, mem: 744240 ko)
+COQC src/Specific/X25519/C64/femul.v
+Finished transaction in 8.415 secs (7.664u,0.015s) (successful)
+total time:      7.616s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  94.8%       1    7.220s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  85.0%       1    6.476s
+─ReflectiveTactics.solve_side_conditions   0.0%  84.2%       1    6.416s
+─ReflectiveTactics.do_reify ------------   0.0%  50.3%       1    3.832s
+─Reify.Reify_rhs_gen -------------------   1.8%  49.4%       1    3.760s
+─ReflectiveTactics.solve_post_reified_si   0.5%  33.9%       1    2.584s
+─Reify.do_reify_abs_goal ---------------  31.1%  31.4%       2    2.392s
+─Reify.do_reifyf_goal ------------------  30.0%  30.3%      58    1.528s
+─UnifyAbstractReflexivity.unify_transfor  22.1%  27.3%       7    0.600s
+─Glue.refine_to_reflective_glue' -------   0.0%   9.8%       1    0.744s
+─eexact --------------------------------   8.2%   8.2%      60    0.024s
+─Glue.zrange_to_reflective -------------   0.1%   6.8%       1    0.516s
+─unify (constr) (constr) ---------------   5.9%   5.9%       6    0.124s
+─prove_interp_compile_correct ----------   0.0%   5.8%       1    0.444s
+─ReflectiveTactics.unify_abstract_cbv_in   3.9%   5.7%       1    0.432s
+─rewrite ?EtaInterp.InterpExprEta ------   5.4%   5.4%       1    0.408s
+─synthesize ----------------------------   0.0%   5.2%       1    0.396s
+─Glue.zrange_to_reflective_goal --------   3.0%   5.0%       1    0.384s
+─IntegrationTestTemporaryMiscCommon.do_r   0.1%   4.8%       1    0.364s
+─change G' -----------------------------   3.9%   3.9%       1    0.300s
+─rewrite H -----------------------------   3.0%   3.0%       1    0.232s
+─tac -----------------------------------   1.5%   2.3%       2    0.176s
+─Reify.transitivity_tt -----------------   0.0%   2.1%       2    0.092s
+─reflexivity ---------------------------   2.0%   2.0%       7    0.052s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  94.8%       1    7.220s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  85.0%       1    6.476s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  84.2%       1    6.416s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  50.3%       1    3.832s
+ │ │└Reify.Reify_rhs_gen ---------------   1.8%  49.4%       1    3.760s
+ │ │ ├─Reify.do_reify_abs_goal ---------  31.1%  31.4%       2    2.392s
+ │ │ │└Reify.do_reifyf_goal ------------  30.0%  30.3%      58    1.528s
+ │ │ │└eexact --------------------------   7.6%   7.6%      58    0.020s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   5.8%       1    0.444s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    5.4%   5.4%       1    0.408s
+ │ │ ├─rewrite H -----------------------   3.0%   3.0%       1    0.232s
+ │ │ ├─tac -----------------------------   1.5%   2.3%       1    0.176s
+ │ │ └─Reify.transitivity_tt -----------   0.0%   2.1%       2    0.092s
+ │ └─ReflectiveTactics.solve_post_reifie   0.5%  33.9%       1    2.584s
+ │   ├─UnifyAbstractReflexivity.unify_tr  22.1%  27.3%       7    0.600s
+ │   │└unify (constr) (constr) ---------   4.3%   4.3%       5    0.096s
+ │   └─ReflectiveTactics.unify_abstract_   3.9%   5.7%       1    0.432s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   9.8%       1    0.744s
+  â””Glue.zrange_to_reflective -----------   0.1%   6.8%       1    0.516s
+  â””Glue.zrange_to_reflective_goal ------   3.0%   5.0%       1    0.384s
+─synthesize ----------------------------   0.0%   5.2%       1    0.396s
+â””IntegrationTestTemporaryMiscCommon.do_r   0.1%   4.8%       1    0.364s
+â””change G' -----------------------------   3.9%   3.9%       1    0.300s
+
+Finished transaction in 14.616 secs (13.528u,0.008s) (successful)
+Closed under the global context
+total time:      7.616s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  94.8%       1    7.220s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  85.0%       1    6.476s
+─ReflectiveTactics.solve_side_conditions   0.0%  84.2%       1    6.416s
+─ReflectiveTactics.do_reify ------------   0.0%  50.3%       1    3.832s
+─Reify.Reify_rhs_gen -------------------   1.8%  49.4%       1    3.760s
+─ReflectiveTactics.solve_post_reified_si   0.5%  33.9%       1    2.584s
+─Reify.do_reify_abs_goal ---------------  31.1%  31.4%       2    2.392s
+─Reify.do_reifyf_goal ------------------  30.0%  30.3%      58    1.528s
+─UnifyAbstractReflexivity.unify_transfor  22.1%  27.3%       7    0.600s
+─Glue.refine_to_reflective_glue' -------   0.0%   9.8%       1    0.744s
+─eexact --------------------------------   8.2%   8.2%      60    0.024s
+─Glue.zrange_to_reflective -------------   0.1%   6.8%       1    0.516s
+─unify (constr) (constr) ---------------   5.9%   5.9%       6    0.124s
+─prove_interp_compile_correct ----------   0.0%   5.8%       1    0.444s
+─ReflectiveTactics.unify_abstract_cbv_in   3.9%   5.7%       1    0.432s
+─rewrite ?EtaInterp.InterpExprEta ------   5.4%   5.4%       1    0.408s
+─synthesize ----------------------------   0.0%   5.2%       1    0.396s
+─Glue.zrange_to_reflective_goal --------   3.0%   5.0%       1    0.384s
+─IntegrationTestTemporaryMiscCommon.do_r   0.1%   4.8%       1    0.364s
+─change G' -----------------------------   3.9%   3.9%       1    0.300s
+─rewrite H -----------------------------   3.0%   3.0%       1    0.232s
+─tac -----------------------------------   1.5%   2.3%       2    0.176s
+─Reify.transitivity_tt -----------------   0.0%   2.1%       2    0.092s
+─reflexivity ---------------------------   2.0%   2.0%       7    0.052s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  94.8%       1    7.220s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  85.0%       1    6.476s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  84.2%       1    6.416s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  50.3%       1    3.832s
+ │ │└Reify.Reify_rhs_gen ---------------   1.8%  49.4%       1    3.760s
+ │ │ ├─Reify.do_reify_abs_goal ---------  31.1%  31.4%       2    2.392s
+ │ │ │└Reify.do_reifyf_goal ------------  30.0%  30.3%      58    1.528s
+ │ │ │└eexact --------------------------   7.6%   7.6%      58    0.020s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   5.8%       1    0.444s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    5.4%   5.4%       1    0.408s
+ │ │ ├─rewrite H -----------------------   3.0%   3.0%       1    0.232s
+ │ │ ├─tac -----------------------------   1.5%   2.3%       1    0.176s
+ │ │ └─Reify.transitivity_tt -----------   0.0%   2.1%       2    0.092s
+ │ └─ReflectiveTactics.solve_post_reifie   0.5%  33.9%       1    2.584s
+ │   ├─UnifyAbstractReflexivity.unify_tr  22.1%  27.3%       7    0.600s
+ │   │└unify (constr) (constr) ---------   4.3%   4.3%       5    0.096s
+ │   └─ReflectiveTactics.unify_abstract_   3.9%   5.7%       1    0.432s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   9.8%       1    0.744s
+  â””Glue.zrange_to_reflective -----------   0.1%   6.8%       1    0.516s
+  â””Glue.zrange_to_reflective_goal ------   3.0%   5.0%       1    0.384s
+─synthesize ----------------------------   0.0%   5.2%       1    0.396s
+â””IntegrationTestTemporaryMiscCommon.do_r   0.1%   4.8%       1    0.364s
+â””change G' -----------------------------   3.9%   3.9%       1    0.300s
+
+src/Specific/X25519/C64/femul (real: 39.72, user: 36.32, sys: 0.26, mem: 825448 ko)
+COQC src/Specific/X25519/C64/feaddDisplay > src/Specific/X25519/C64/feaddDisplay.log
+COQC src/Specific/X25519/C64/fecarryDisplay > src/Specific/X25519/C64/fecarryDisplay.log
+COQC src/Specific/X25519/C64/fesub.v
+Finished transaction in 3.513 secs (3.211u,0.s) (successful)
+total time:      3.164s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.6%       1    3.088s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  74.1%       1    2.344s
+─ReflectiveTactics.solve_side_conditions   0.0%  72.9%       1    2.308s
+─ReflectiveTactics.do_reify ------------   0.0%  38.6%       1    1.220s
+─Reify.Reify_rhs_gen -------------------   1.5%  37.2%       1    1.176s
+─ReflectiveTactics.solve_post_reified_si   0.9%  34.4%       1    1.088s
+─UnifyAbstractReflexivity.unify_transfor  19.2%  23.9%       7    0.204s
+─Glue.refine_to_reflective_glue' -------   0.0%  23.5%       1    0.744s
+─Reify.do_reify_abs_goal ---------------  19.2%  19.5%       2    0.616s
+─Reify.do_reifyf_goal ------------------  18.0%  18.3%      16    0.580s
+─Glue.zrange_to_reflective -------------   0.1%  15.4%       1    0.488s
+─Glue.zrange_to_reflective_goal --------   6.8%  11.5%       1    0.364s
+─ReflectiveTactics.unify_abstract_cbv_in   6.2%   9.0%       1    0.284s
+─unify (constr) (constr) ---------------   5.9%   5.9%       6    0.080s
+─Glue.pattern_sig_sig_assoc ------------   0.0%   4.6%       1    0.144s
+─eexact --------------------------------   4.4%   4.4%      18    0.012s
+─Glue.pattern_proj1_sig_in_sig ---------   1.4%   4.3%       1    0.136s
+─prove_interp_compile_correct ----------   0.0%   3.9%       1    0.124s
+─rewrite H -----------------------------   3.8%   3.8%       1    0.120s
+─assert (H : is_bounded_by' bounds (map'   3.8%   3.8%       2    0.064s
+─rewrite ?EtaInterp.InterpExprEta ------   3.5%   3.5%       1    0.112s
+─pose proof  (pf   :   Interpretation.Bo   2.9%   2.9%       1    0.092s
+─Glue.split_BoundedWordToZ -------------   0.1%   2.8%       1    0.088s
+─tac -----------------------------------   1.9%   2.5%       2    0.080s
+─reflexivity ---------------------------   2.4%   2.4%       7    0.028s
+─synthesize ----------------------------   0.0%   2.4%       1    0.076s
+─destruct_sig --------------------------   0.0%   2.4%       4    0.040s
+─destruct x ----------------------------   2.4%   2.4%       4    0.032s
+─clearbody (ne_var_list) ---------------   2.3%   2.3%       4    0.060s
+─Reify.transitivity_tt -----------------   0.1%   2.3%       2    0.036s
+─transitivity --------------------------   2.1%   2.1%       5    0.032s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.6%       1    3.088s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  74.1%       1    2.344s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  72.9%       1    2.308s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  38.6%       1    1.220s
+ │ │└Reify.Reify_rhs_gen ---------------   1.5%  37.2%       1    1.176s
+ │ │ ├─Reify.do_reify_abs_goal ---------  19.2%  19.5%       2    0.616s
+ │ │ │└Reify.do_reifyf_goal ------------  18.0%  18.3%      16    0.580s
+ │ │ │└eexact --------------------------   3.9%   3.9%      16    0.012s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   3.9%       1    0.124s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    3.5%   3.5%       1    0.112s
+ │ │ ├─rewrite H -----------------------   3.8%   3.8%       1    0.120s
+ │ │ ├─tac -----------------------------   1.9%   2.5%       1    0.080s
+ │ │ └─Reify.transitivity_tt -----------   0.1%   2.3%       2    0.036s
+ │ │  └transitivity --------------------   2.0%   2.0%       4    0.032s
+ │ └─ReflectiveTactics.solve_post_reifie   0.9%  34.4%       1    1.088s
+ │   ├─UnifyAbstractReflexivity.unify_tr  19.2%  23.9%       7    0.204s
+ │   │└unify (constr) (constr) ---------   3.4%   3.4%       5    0.036s
+ │   └─ReflectiveTactics.unify_abstract_   6.2%   9.0%       1    0.284s
+ │    └unify (constr) (constr) ---------   2.5%   2.5%       1    0.080s
+ └─Glue.refine_to_reflective_glue' -----   0.0%  23.5%       1    0.744s
+   ├─Glue.zrange_to_reflective ---------   0.1%  15.4%       1    0.488s
+   │ ├─Glue.zrange_to_reflective_goal --   6.8%  11.5%       1    0.364s
+   │ │└pose proof  (pf   :   Interpretat   2.9%   2.9%       1    0.092s
+   │ └─assert (H : is_bounded_by' bounds   3.8%   3.8%       2    0.064s
+   ├─Glue.pattern_sig_sig_assoc --------   0.0%   4.6%       1    0.144s
+   │└Glue.pattern_proj1_sig_in_sig -----   1.4%   4.3%       1    0.136s
+   └─Glue.split_BoundedWordToZ ---------   0.1%   2.8%       1    0.088s
+    â””destruct_sig ----------------------   0.0%   2.4%       4    0.040s
+─synthesize ----------------------------   0.0%   2.4%       1    0.076s
+
+Finished transaction in 6.12 secs (5.64u,0.008s) (successful)
+Closed under the global context
+total time:      3.164s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.6%       1    3.088s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  74.1%       1    2.344s
+─ReflectiveTactics.solve_side_conditions   0.0%  72.9%       1    2.308s
+─ReflectiveTactics.do_reify ------------   0.0%  38.6%       1    1.220s
+─Reify.Reify_rhs_gen -------------------   1.5%  37.2%       1    1.176s
+─ReflectiveTactics.solve_post_reified_si   0.9%  34.4%       1    1.088s
+─UnifyAbstractReflexivity.unify_transfor  19.2%  23.9%       7    0.204s
+─Glue.refine_to_reflective_glue' -------   0.0%  23.5%       1    0.744s
+─Reify.do_reify_abs_goal ---------------  19.2%  19.5%       2    0.616s
+─Reify.do_reifyf_goal ------------------  18.0%  18.3%      16    0.580s
+─Glue.zrange_to_reflective -------------   0.1%  15.4%       1    0.488s
+─Glue.zrange_to_reflective_goal --------   6.8%  11.5%       1    0.364s
+─ReflectiveTactics.unify_abstract_cbv_in   6.2%   9.0%       1    0.284s
+─unify (constr) (constr) ---------------   5.9%   5.9%       6    0.080s
+─Glue.pattern_sig_sig_assoc ------------   0.0%   4.6%       1    0.144s
+─eexact --------------------------------   4.4%   4.4%      18    0.012s
+─Glue.pattern_proj1_sig_in_sig ---------   1.4%   4.3%       1    0.136s
+─prove_interp_compile_correct ----------   0.0%   3.9%       1    0.124s
+─rewrite H -----------------------------   3.8%   3.8%       1    0.120s
+─assert (H : is_bounded_by' bounds (map'   3.8%   3.8%       2    0.064s
+─rewrite ?EtaInterp.InterpExprEta ------   3.5%   3.5%       1    0.112s
+─pose proof  (pf   :   Interpretation.Bo   2.9%   2.9%       1    0.092s
+─Glue.split_BoundedWordToZ -------------   0.1%   2.8%       1    0.088s
+─tac -----------------------------------   1.9%   2.5%       2    0.080s
+─reflexivity ---------------------------   2.4%   2.4%       7    0.028s
+─synthesize ----------------------------   0.0%   2.4%       1    0.076s
+─destruct_sig --------------------------   0.0%   2.4%       4    0.040s
+─destruct x ----------------------------   2.4%   2.4%       4    0.032s
+─clearbody (ne_var_list) ---------------   2.3%   2.3%       4    0.060s
+─Reify.transitivity_tt -----------------   0.1%   2.3%       2    0.036s
+─transitivity --------------------------   2.1%   2.1%       5    0.032s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.6%       1    3.088s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  74.1%       1    2.344s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  72.9%       1    2.308s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  38.6%       1    1.220s
+ │ │└Reify.Reify_rhs_gen ---------------   1.5%  37.2%       1    1.176s
+ │ │ ├─Reify.do_reify_abs_goal ---------  19.2%  19.5%       2    0.616s
+ │ │ │└Reify.do_reifyf_goal ------------  18.0%  18.3%      16    0.580s
+ │ │ │└eexact --------------------------   3.9%   3.9%      16    0.012s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   3.9%       1    0.124s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    3.5%   3.5%       1    0.112s
+ │ │ ├─rewrite H -----------------------   3.8%   3.8%       1    0.120s
+ │ │ ├─tac -----------------------------   1.9%   2.5%       1    0.080s
+ │ │ └─Reify.transitivity_tt -----------   0.1%   2.3%       2    0.036s
+ │ │  └transitivity --------------------   2.0%   2.0%       4    0.032s
+ │ └─ReflectiveTactics.solve_post_reifie   0.9%  34.4%       1    1.088s
+ │   ├─UnifyAbstractReflexivity.unify_tr  19.2%  23.9%       7    0.204s
+ │   │└unify (constr) (constr) ---------   3.4%   3.4%       5    0.036s
+ │   └─ReflectiveTactics.unify_abstract_   6.2%   9.0%       1    0.284s
+ │    └unify (constr) (constr) ---------   2.5%   2.5%       1    0.080s
+ └─Glue.refine_to_reflective_glue' -----   0.0%  23.5%       1    0.744s
+   ├─Glue.zrange_to_reflective ---------   0.1%  15.4%       1    0.488s
+   │ ├─Glue.zrange_to_reflective_goal --   6.8%  11.5%       1    0.364s
+   │ │└pose proof  (pf   :   Interpretat   2.9%   2.9%       1    0.092s
+   │ └─assert (H : is_bounded_by' bounds   3.8%   3.8%       2    0.064s
+   ├─Glue.pattern_sig_sig_assoc --------   0.0%   4.6%       1    0.144s
+   │└Glue.pattern_proj1_sig_in_sig -----   1.4%   4.3%       1    0.136s
+   └─Glue.split_BoundedWordToZ ---------   0.1%   2.8%       1    0.088s
+    â””destruct_sig ----------------------   0.0%   2.4%       4    0.040s
+─synthesize ----------------------------   0.0%   2.4%       1    0.076s
+
+src/Specific/X25519/C64/fesub (real: 24.71, user: 22.65, sys: 0.24, mem: 778792 ko)
+COQC src/Specific/X25519/C64/fesquare.v
+Finished transaction in 6.132 secs (5.516u,0.012s) (successful)
+total time:      5.480s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize ----------------------------  -0.0% 100.0%       1    5.480s
+─Pipeline.refine_reflectively_gen ------   0.0%  95.7%       1    5.244s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  88.6%       1    4.856s
+─ReflectiveTactics.solve_side_conditions   0.0%  87.7%       1    4.804s
+─ReflectiveTactics.do_reify ------------   0.0%  53.3%       1    2.920s
+─Reify.Reify_rhs_gen -------------------   2.0%  52.5%       1    2.876s
+─ReflectiveTactics.solve_post_reified_si   0.6%  34.4%       1    1.884s
+─Reify.do_reify_abs_goal ---------------  33.2%  33.6%       2    1.844s
+─Reify.do_reifyf_goal ------------------  31.5%  32.0%      47    1.392s
+─UnifyAbstractReflexivity.unify_transfor  21.9%  26.6%       7    0.400s
+─eexact --------------------------------  10.0%  10.0%      49    0.028s
+─Glue.refine_to_reflective_glue' -------   0.0%   7.1%       1    0.388s
+─ReflectiveTactics.unify_abstract_cbv_in   5.0%   6.9%       1    0.380s
+─unify (constr) (constr) ---------------   5.8%   5.8%       6    0.104s
+─prove_interp_compile_correct ----------   0.0%   5.8%       1    0.316s
+─rewrite ?EtaInterp.InterpExprEta ------   5.3%   5.3%       1    0.288s
+─Glue.zrange_to_reflective -------------   0.1%   5.1%       1    0.280s
+─IntegrationTestTemporaryMiscCommon.do_r   0.1%   4.0%       1    0.220s
+─Glue.zrange_to_reflective_goal --------   3.1%   3.9%       1    0.212s
+─change G' -----------------------------   3.4%   3.4%       1    0.184s
+─tac -----------------------------------   2.0%   2.8%       2    0.156s
+─rewrite H -----------------------------   2.8%   2.8%       1    0.156s
+─reflexivity ---------------------------   2.8%   2.8%       7    0.064s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize ----------------------------  -0.0% 100.0%       1    5.480s
+ ├─Pipeline.refine_reflectively_gen ----   0.0%  95.7%       1    5.244s
+ │ ├─ReflectiveTactics.do_reflective_pip   0.0%  88.6%       1    4.856s
+ │ │└ReflectiveTactics.solve_side_condit   0.0%  87.7%       1    4.804s
+ │ │ ├─ReflectiveTactics.do_reify ------   0.0%  53.3%       1    2.920s
+ │ │ │└Reify.Reify_rhs_gen -------------   2.0%  52.5%       1    2.876s
+ │ │ │ ├─Reify.do_reify_abs_goal -------  33.2%  33.6%       2    1.844s
+ │ │ │ │└Reify.do_reifyf_goal ----------  31.5%  32.0%      47    1.392s
+ │ │ │ │└eexact ------------------------   9.1%   9.1%      47    0.024s
+ │ │ │ ├─prove_interp_compile_correct --   0.0%   5.8%       1    0.316s
+ │ │ │ │└rewrite ?EtaInterp.InterpExprEt   5.3%   5.3%       1    0.288s
+ │ │ │ ├─tac ---------------------------   2.0%   2.8%       1    0.156s
+ │ │ │ └─rewrite H ---------------------   2.8%   2.8%       1    0.156s
+ │ │ └─ReflectiveTactics.solve_post_reif   0.6%  34.4%       1    1.884s
+ │ │   ├─UnifyAbstractReflexivity.unify_  21.9%  26.6%       7    0.400s
+ │ │   │└unify (constr) (constr) -------   3.9%   3.9%       5    0.072s
+ │ │   └─ReflectiveTactics.unify_abstrac   5.0%   6.9%       1    0.380s
+ │ └─Glue.refine_to_reflective_glue' ---   0.0%   7.1%       1    0.388s
+ │  └Glue.zrange_to_reflective ---------   0.1%   5.1%       1    0.280s
+ │  └Glue.zrange_to_reflective_goal ----   3.1%   3.9%       1    0.212s
+ └─IntegrationTestTemporaryMiscCommon.do   0.1%   4.0%       1    0.220s
+  â””change G' ---------------------------   3.4%   3.4%       1    0.184s
+
+Finished transaction in 10.475 secs (9.728u,0.007s) (successful)
+Closed under the global context
+total time:      5.480s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize ----------------------------  -0.0% 100.0%       1    5.480s
+─Pipeline.refine_reflectively_gen ------   0.0%  95.7%       1    5.244s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  88.6%       1    4.856s
+─ReflectiveTactics.solve_side_conditions   0.0%  87.7%       1    4.804s
+─ReflectiveTactics.do_reify ------------   0.0%  53.3%       1    2.920s
+─Reify.Reify_rhs_gen -------------------   2.0%  52.5%       1    2.876s
+─ReflectiveTactics.solve_post_reified_si   0.6%  34.4%       1    1.884s
+─Reify.do_reify_abs_goal ---------------  33.2%  33.6%       2    1.844s
+─Reify.do_reifyf_goal ------------------  31.5%  32.0%      47    1.392s
+─UnifyAbstractReflexivity.unify_transfor  21.9%  26.6%       7    0.400s
+─eexact --------------------------------  10.0%  10.0%      49    0.028s
+─Glue.refine_to_reflective_glue' -------   0.0%   7.1%       1    0.388s
+─ReflectiveTactics.unify_abstract_cbv_in   5.0%   6.9%       1    0.380s
+─unify (constr) (constr) ---------------   5.8%   5.8%       6    0.104s
+─prove_interp_compile_correct ----------   0.0%   5.8%       1    0.316s
+─rewrite ?EtaInterp.InterpExprEta ------   5.3%   5.3%       1    0.288s
+─Glue.zrange_to_reflective -------------   0.1%   5.1%       1    0.280s
+─IntegrationTestTemporaryMiscCommon.do_r   0.1%   4.0%       1    0.220s
+─Glue.zrange_to_reflective_goal --------   3.1%   3.9%       1    0.212s
+─change G' -----------------------------   3.4%   3.4%       1    0.184s
+─tac -----------------------------------   2.0%   2.8%       2    0.156s
+─rewrite H -----------------------------   2.8%   2.8%       1    0.156s
+─reflexivity ---------------------------   2.8%   2.8%       7    0.064s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize ----------------------------  -0.0% 100.0%       1    5.480s
+ ├─Pipeline.refine_reflectively_gen ----   0.0%  95.7%       1    5.244s
+ │ ├─ReflectiveTactics.do_reflective_pip   0.0%  88.6%       1    4.856s
+ │ │└ReflectiveTactics.solve_side_condit   0.0%  87.7%       1    4.804s
+ │ │ ├─ReflectiveTactics.do_reify ------   0.0%  53.3%       1    2.920s
+ │ │ │└Reify.Reify_rhs_gen -------------   2.0%  52.5%       1    2.876s
+ │ │ │ ├─Reify.do_reify_abs_goal -------  33.2%  33.6%       2    1.844s
+ │ │ │ │└Reify.do_reifyf_goal ----------  31.5%  32.0%      47    1.392s
+ │ │ │ │└eexact ------------------------   9.1%   9.1%      47    0.024s
+ │ │ │ ├─prove_interp_compile_correct --   0.0%   5.8%       1    0.316s
+ │ │ │ │└rewrite ?EtaInterp.InterpExprEt   5.3%   5.3%       1    0.288s
+ │ │ │ ├─tac ---------------------------   2.0%   2.8%       1    0.156s
+ │ │ │ └─rewrite H ---------------------   2.8%   2.8%       1    0.156s
+ │ │ └─ReflectiveTactics.solve_post_reif   0.6%  34.4%       1    1.884s
+ │ │   ├─UnifyAbstractReflexivity.unify_  21.9%  26.6%       7    0.400s
+ │ │   │└unify (constr) (constr) -------   3.9%   3.9%       5    0.072s
+ │ │   └─ReflectiveTactics.unify_abstrac   5.0%   6.9%       1    0.380s
+ │ └─Glue.refine_to_reflective_glue' ---   0.0%   7.1%       1    0.388s
+ │  └Glue.zrange_to_reflective ---------   0.1%   5.1%       1    0.280s
+ │  └Glue.zrange_to_reflective_goal ----   3.1%   3.9%       1    0.212s
+ └─IntegrationTestTemporaryMiscCommon.do   0.1%   4.0%       1    0.220s
+  â””change G' ---------------------------   3.4%   3.4%       1    0.184s
+
+src/Specific/X25519/C64/fesquare (real: 33.08, user: 30.13, sys: 0.24, mem: 799620 ko)
+COQC src/Specific/X25519/C64/femulDisplay > src/Specific/X25519/C64/femulDisplay.log
+COQC src/Specific/X25519/C64/freeze.v
+Finished transaction in 7.307 secs (6.763u,0.011s) (successful)
+total time:      6.732s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_freeze ---------------------   0.0% 100.0%       1    6.732s
+─Pipeline.refine_reflectively_gen ------   0.0%  99.3%       1    6.684s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  92.8%       1    6.248s
+─ReflectiveTactics.solve_side_conditions   0.0%  92.0%       1    6.192s
+─ReflectiveTactics.do_reify ------------  -0.0%  60.3%       1    4.060s
+─Reify.Reify_rhs_gen -------------------   1.5%  59.6%       1    4.012s
+─Reify.do_reify_abs_goal ---------------  42.4%  42.7%       2    2.876s
+─Reify.do_reifyf_goal ------------------  41.3%  41.7%     129    2.804s
+─ReflectiveTactics.solve_post_reified_si   0.6%  31.7%       1    2.132s
+─UnifyAbstractReflexivity.unify_transfor  21.7%  25.8%       7    0.424s
+─eexact --------------------------------  13.7%  13.7%     131    0.036s
+─Glue.refine_to_reflective_glue' -------   0.0%   6.5%       1    0.436s
+─prove_interp_compile_correct ----------   0.0%   5.1%       1    0.344s
+─ReflectiveTactics.unify_abstract_cbv_in   3.4%   5.0%       1    0.336s
+─rewrite ?EtaInterp.InterpExprEta ------   4.7%   4.7%       1    0.316s
+─unify (constr) (constr) ---------------   4.6%   4.6%       6    0.100s
+─Glue.zrange_to_reflective -------------   0.0%   4.2%       1    0.280s
+─Glue.zrange_to_reflective_goal --------   2.4%   3.3%       1    0.220s
+─Reify.transitivity_tt -----------------   0.1%   2.6%       2    0.116s
+─rewrite H -----------------------------   2.6%   2.6%       1    0.172s
+─tac -----------------------------------   1.5%   2.3%       2    0.156s
+─reflexivity ---------------------------   2.3%   2.3%       7    0.052s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_freeze ---------------------   0.0% 100.0%       1    6.732s
+â””Pipeline.refine_reflectively_gen ------   0.0%  99.3%       1    6.684s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  92.8%       1    6.248s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  92.0%       1    6.192s
+ │ ├─ReflectiveTactics.do_reify --------  -0.0%  60.3%       1    4.060s
+ │ │└Reify.Reify_rhs_gen ---------------   1.5%  59.6%       1    4.012s
+ │ │ ├─Reify.do_reify_abs_goal ---------  42.4%  42.7%       2    2.876s
+ │ │ │└Reify.do_reifyf_goal ------------  41.3%  41.7%     129    2.804s
+ │ │ │└eexact --------------------------  13.0%  13.0%     129    0.036s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   5.1%       1    0.344s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    4.7%   4.7%       1    0.316s
+ │ │ ├─Reify.transitivity_tt -----------   0.1%   2.6%       2    0.116s
+ │ │ ├─rewrite H -----------------------   2.6%   2.6%       1    0.172s
+ │ │ └─tac -----------------------------   1.5%   2.3%       1    0.156s
+ │ └─ReflectiveTactics.solve_post_reifie   0.6%  31.7%       1    2.132s
+ │   ├─UnifyAbstractReflexivity.unify_tr  21.7%  25.8%       7    0.424s
+ │   │└unify (constr) (constr) ---------   3.1%   3.1%       5    0.084s
+ │   └─ReflectiveTactics.unify_abstract_   3.4%   5.0%       1    0.336s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   6.5%       1    0.436s
+  â””Glue.zrange_to_reflective -----------   0.0%   4.2%       1    0.280s
+  â””Glue.zrange_to_reflective_goal ------   2.4%   3.3%       1    0.220s
+
+Finished transaction in 10.495 secs (9.756u,0.s) (successful)
+Closed under the global context
+total time:      6.732s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_freeze ---------------------   0.0% 100.0%       1    6.732s
+─Pipeline.refine_reflectively_gen ------   0.0%  99.3%       1    6.684s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  92.8%       1    6.248s
+─ReflectiveTactics.solve_side_conditions   0.0%  92.0%       1    6.192s
+─ReflectiveTactics.do_reify ------------  -0.0%  60.3%       1    4.060s
+─Reify.Reify_rhs_gen -------------------   1.5%  59.6%       1    4.012s
+─Reify.do_reify_abs_goal ---------------  42.4%  42.7%       2    2.876s
+─Reify.do_reifyf_goal ------------------  41.3%  41.7%     129    2.804s
+─ReflectiveTactics.solve_post_reified_si   0.6%  31.7%       1    2.132s
+─UnifyAbstractReflexivity.unify_transfor  21.7%  25.8%       7    0.424s
+─eexact --------------------------------  13.7%  13.7%     131    0.036s
+─Glue.refine_to_reflective_glue' -------   0.0%   6.5%       1    0.436s
+─prove_interp_compile_correct ----------   0.0%   5.1%       1    0.344s
+─ReflectiveTactics.unify_abstract_cbv_in   3.4%   5.0%       1    0.336s
+─rewrite ?EtaInterp.InterpExprEta ------   4.7%   4.7%       1    0.316s
+─unify (constr) (constr) ---------------   4.6%   4.6%       6    0.100s
+─Glue.zrange_to_reflective -------------   0.0%   4.2%       1    0.280s
+─Glue.zrange_to_reflective_goal --------   2.4%   3.3%       1    0.220s
+─Reify.transitivity_tt -----------------   0.1%   2.6%       2    0.116s
+─rewrite H -----------------------------   2.6%   2.6%       1    0.172s
+─tac -----------------------------------   1.5%   2.3%       2    0.156s
+─reflexivity ---------------------------   2.3%   2.3%       7    0.052s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_freeze ---------------------   0.0% 100.0%       1    6.732s
+â””Pipeline.refine_reflectively_gen ------   0.0%  99.3%       1    6.684s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  92.8%       1    6.248s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  92.0%       1    6.192s
+ │ ├─ReflectiveTactics.do_reify --------  -0.0%  60.3%       1    4.060s
+ │ │└Reify.Reify_rhs_gen ---------------   1.5%  59.6%       1    4.012s
+ │ │ ├─Reify.do_reify_abs_goal ---------  42.4%  42.7%       2    2.876s
+ │ │ │└Reify.do_reifyf_goal ------------  41.3%  41.7%     129    2.804s
+ │ │ │└eexact --------------------------  13.0%  13.0%     129    0.036s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   5.1%       1    0.344s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    4.7%   4.7%       1    0.316s
+ │ │ ├─Reify.transitivity_tt -----------   0.1%   2.6%       2    0.116s
+ │ │ ├─rewrite H -----------------------   2.6%   2.6%       1    0.172s
+ │ │ └─tac -----------------------------   1.5%   2.3%       1    0.156s
+ │ └─ReflectiveTactics.solve_post_reifie   0.6%  31.7%       1    2.132s
+ │   ├─UnifyAbstractReflexivity.unify_tr  21.7%  25.8%       7    0.424s
+ │   │└unify (constr) (constr) ---------   3.1%   3.1%       5    0.084s
+ │   └─ReflectiveTactics.unify_abstract_   3.4%   5.0%       1    0.336s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   6.5%       1    0.436s
+  â””Glue.zrange_to_reflective -----------   0.0%   4.2%       1    0.280s
+  â””Glue.zrange_to_reflective_goal ------   2.4%   3.3%       1    0.220s
+
+src/Specific/X25519/C64/freeze (real: 34.35, user: 31.50, sys: 0.24, mem: 828104 ko)
+COQC src/Specific/NISTP256/AMD64/feadd.v
+Finished transaction in 8.784 secs (8.176u,0.011s) (successful)
+total time:      8.140s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  52.4%       1    4.268s
+─synthesize_montgomery -----------------   0.0%  47.6%       1    3.872s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  43.8%       1    3.568s
+─ReflectiveTactics.solve_side_conditions   0.0%  43.2%       1    3.520s
+─IntegrationTestTemporaryMiscCommon.fact   1.4%  23.6%       1    1.924s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  22.1%       1    1.796s
+─ReflectiveTactics.do_reify ------------   0.1%  21.7%       1    1.768s
+─ReflectiveTactics.solve_post_reified_si   0.6%  21.5%       1    1.752s
+─Reify.Reify_rhs_gen -------------------   1.0%  20.9%       1    1.704s
+─op_sig_side_conditions_t --------------   0.0%  20.0%       1    1.624s
+─DestructHyps.do_all_matches_then ------   0.0%  20.0%       8    0.244s
+─DestructHyps.do_one_match_then --------   0.7%  19.9%      44    0.052s
+─do_tac --------------------------------   0.0%  19.2%      36    0.052s
+─destruct H ----------------------------  19.2%  19.2%      36    0.052s
+─rewrite <- (lem : lemT) by by_tac ltac:   0.2%  17.3%       1    1.408s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  17.3%       1    1.408s
+─by_tac --------------------------------   0.0%  17.1%       4    0.504s
+─rewrite <- (ZRange.is_bounded_by_None_r  16.7%  16.7%       8    0.344s
+─UnifyAbstractReflexivity.unify_transfor  13.3%  16.1%       7    0.360s
+─Reify.do_reify_abs_goal ---------------   9.9%  10.1%       2    0.820s
+─Reify.do_reifyf_goal ------------------   9.1%   9.3%      93    0.748s
+─Glue.refine_to_reflective_glue' -------   0.0%   8.6%       1    0.700s
+─Glue.zrange_to_reflective -------------   0.0%   5.3%       1    0.432s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   4.8%       1    0.388s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.9%   4.6%       3    0.368s
+─ReflectiveTactics.unify_abstract_cbv_in   3.3%   4.5%       1    0.368s
+─Glue.zrange_to_reflective_goal --------   2.6%   4.0%       1    0.324s
+─k -------------------------------------   3.5%   3.6%       1    0.296s
+─unify (constr) (constr) ---------------   3.3%   3.3%       8    0.092s
+─rewrite H -----------------------------   2.6%   2.6%       2    0.196s
+─eexact --------------------------------   2.6%   2.6%      95    0.024s
+─prove_interp_compile_correct ----------   0.0%   2.5%       1    0.204s
+─apply  (fun f =>   MapProjections.proj2   2.4%   2.4%       2    0.120s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  52.4%       1    4.268s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  43.8%       1    3.568s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  43.2%       1    3.520s
+ │ ├─ReflectiveTactics.do_reify --------   0.1%  21.7%       1    1.768s
+ │ │└Reify.Reify_rhs_gen ---------------   1.0%  20.9%       1    1.704s
+ │ │ ├─Reify.do_reify_abs_goal ---------   9.9%  10.1%       2    0.820s
+ │ │ │└Reify.do_reifyf_goal ------------   9.1%   9.3%      93    0.748s
+ │ │ │└eexact --------------------------   2.3%   2.3%      93    0.024s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   2.5%       1    0.204s
+ │ │ └─rewrite H -----------------------   2.4%   2.4%       1    0.196s
+ │ └─ReflectiveTactics.solve_post_reifie   0.6%  21.5%       1    1.752s
+ │   ├─UnifyAbstractReflexivity.unify_tr  13.3%  16.1%       7    0.360s
+ │   │└unify (constr) (constr) ---------   2.2%   2.2%       5    0.064s
+ │   └─ReflectiveTactics.unify_abstract_   3.3%   4.5%       1    0.368s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   8.6%       1    0.700s
+  â””Glue.zrange_to_reflective -----------   0.0%   5.3%       1    0.432s
+  â””Glue.zrange_to_reflective_goal ------   2.6%   4.0%       1    0.324s
+─synthesize_montgomery -----------------   0.0%  47.6%       1    3.872s
+ ├─IntegrationTestTemporaryMiscCommon.fa   1.4%  23.6%       1    1.924s
+ │└op_sig_side_conditions_t ------------   0.0%  20.0%       1    1.624s
+ │ ├─DestructHyps.do_all_matches_then --   0.0%  11.4%       4    0.244s
+ │ │└DestructHyps.do_one_match_then ----   0.3%  11.4%      24    0.052s
+ │ │└do_tac ----------------------------   0.0%  11.1%      20    0.052s
+ │ │└destruct H ------------------------  11.1%  11.1%      20    0.052s
+ │ └─rewrite <- (ZRange.is_bounded_by_No   8.4%   8.4%       4    0.328s
+ └─IntegrationTestTemporaryMiscCommon.do   0.0%  22.1%       1    1.796s
+   ├─IntegrationTestTemporaryMiscCommon.   0.0%  17.3%       1    1.408s
+   │└rewrite <- (lem : lemT) by by_tac l   0.2%  17.3%       1    1.408s
+   │└by_tac ----------------------------   0.0%  17.1%       4    0.504s
+   │ ├─DestructHyps.do_all_matches_then    0.0%   8.6%       4    0.184s
+   │ │└DestructHyps.do_one_match_then --   0.3%   8.5%      20    0.052s
+   │ │└do_tac --------------------------   0.0%   8.2%      16    0.052s
+   │ │└destruct H ----------------------   8.2%   8.2%      16    0.052s
+   │ └─rewrite <- (ZRange.is_bounded_by_   8.3%   8.3%       4    0.344s
+   └─IntegrationTestTemporaryMiscCommon.   0.0%   4.8%       1    0.388s
+    â””<Crypto.Util.Tactics.MoveLetIn.with   0.9%   4.6%       3    0.368s
+    â””k ---------------------------------   3.5%   3.6%       1    0.296s
+
+Finished transaction in 13.363 secs (12.516u,0.008s) (successful)
+Closed under the global context
+total time:      8.140s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  52.4%       1    4.268s
+─synthesize_montgomery -----------------   0.0%  47.6%       1    3.872s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  43.8%       1    3.568s
+─ReflectiveTactics.solve_side_conditions   0.0%  43.2%       1    3.520s
+─IntegrationTestTemporaryMiscCommon.fact   1.4%  23.6%       1    1.924s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  22.1%       1    1.796s
+─ReflectiveTactics.do_reify ------------   0.1%  21.7%       1    1.768s
+─ReflectiveTactics.solve_post_reified_si   0.6%  21.5%       1    1.752s
+─Reify.Reify_rhs_gen -------------------   1.0%  20.9%       1    1.704s
+─op_sig_side_conditions_t --------------   0.0%  20.0%       1    1.624s
+─DestructHyps.do_all_matches_then ------   0.0%  20.0%       8    0.244s
+─DestructHyps.do_one_match_then --------   0.7%  19.9%      44    0.052s
+─do_tac --------------------------------   0.0%  19.2%      36    0.052s
+─destruct H ----------------------------  19.2%  19.2%      36    0.052s
+─rewrite <- (lem : lemT) by by_tac ltac:   0.2%  17.3%       1    1.408s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  17.3%       1    1.408s
+─by_tac --------------------------------   0.0%  17.1%       4    0.504s
+─rewrite <- (ZRange.is_bounded_by_None_r  16.7%  16.7%       8    0.344s
+─UnifyAbstractReflexivity.unify_transfor  13.3%  16.1%       7    0.360s
+─Reify.do_reify_abs_goal ---------------   9.9%  10.1%       2    0.820s
+─Reify.do_reifyf_goal ------------------   9.1%   9.3%      93    0.748s
+─Glue.refine_to_reflective_glue' -------   0.0%   8.6%       1    0.700s
+─Glue.zrange_to_reflective -------------   0.0%   5.3%       1    0.432s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   4.8%       1    0.388s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.9%   4.6%       3    0.368s
+─ReflectiveTactics.unify_abstract_cbv_in   3.3%   4.5%       1    0.368s
+─Glue.zrange_to_reflective_goal --------   2.6%   4.0%       1    0.324s
+─k -------------------------------------   3.5%   3.6%       1    0.296s
+─unify (constr) (constr) ---------------   3.3%   3.3%       8    0.092s
+─rewrite H -----------------------------   2.6%   2.6%       2    0.196s
+─eexact --------------------------------   2.6%   2.6%      95    0.024s
+─prove_interp_compile_correct ----------   0.0%   2.5%       1    0.204s
+─apply  (fun f =>   MapProjections.proj2   2.4%   2.4%       2    0.120s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  52.4%       1    4.268s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  43.8%       1    3.568s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  43.2%       1    3.520s
+ │ ├─ReflectiveTactics.do_reify --------   0.1%  21.7%       1    1.768s
+ │ │└Reify.Reify_rhs_gen ---------------   1.0%  20.9%       1    1.704s
+ │ │ ├─Reify.do_reify_abs_goal ---------   9.9%  10.1%       2    0.820s
+ │ │ │└Reify.do_reifyf_goal ------------   9.1%   9.3%      93    0.748s
+ │ │ │└eexact --------------------------   2.3%   2.3%      93    0.024s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   2.5%       1    0.204s
+ │ │ └─rewrite H -----------------------   2.4%   2.4%       1    0.196s
+ │ └─ReflectiveTactics.solve_post_reifie   0.6%  21.5%       1    1.752s
+ │   ├─UnifyAbstractReflexivity.unify_tr  13.3%  16.1%       7    0.360s
+ │   │└unify (constr) (constr) ---------   2.2%   2.2%       5    0.064s
+ │   └─ReflectiveTactics.unify_abstract_   3.3%   4.5%       1    0.368s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   8.6%       1    0.700s
+  â””Glue.zrange_to_reflective -----------   0.0%   5.3%       1    0.432s
+  â””Glue.zrange_to_reflective_goal ------   2.6%   4.0%       1    0.324s
+─synthesize_montgomery -----------------   0.0%  47.6%       1    3.872s
+ ├─IntegrationTestTemporaryMiscCommon.fa   1.4%  23.6%       1    1.924s
+ │└op_sig_side_conditions_t ------------   0.0%  20.0%       1    1.624s
+ │ ├─DestructHyps.do_all_matches_then --   0.0%  11.4%       4    0.244s
+ │ │└DestructHyps.do_one_match_then ----   0.3%  11.4%      24    0.052s
+ │ │└do_tac ----------------------------   0.0%  11.1%      20    0.052s
+ │ │└destruct H ------------------------  11.1%  11.1%      20    0.052s
+ │ └─rewrite <- (ZRange.is_bounded_by_No   8.4%   8.4%       4    0.328s
+ └─IntegrationTestTemporaryMiscCommon.do   0.0%  22.1%       1    1.796s
+   ├─IntegrationTestTemporaryMiscCommon.   0.0%  17.3%       1    1.408s
+   │└rewrite <- (lem : lemT) by by_tac l   0.2%  17.3%       1    1.408s
+   │└by_tac ----------------------------   0.0%  17.1%       4    0.504s
+   │ ├─DestructHyps.do_all_matches_then    0.0%   8.6%       4    0.184s
+   │ │└DestructHyps.do_one_match_then --   0.3%   8.5%      20    0.052s
+   │ │└do_tac --------------------------   0.0%   8.2%      16    0.052s
+   │ │└destruct H ----------------------   8.2%   8.2%      16    0.052s
+   │ └─rewrite <- (ZRange.is_bounded_by_   8.3%   8.3%       4    0.344s
+   └─IntegrationTestTemporaryMiscCommon.   0.0%   4.8%       1    0.388s
+    â””<Crypto.Util.Tactics.MoveLetIn.with   0.9%   4.6%       3    0.368s
+    â””k ---------------------------------   3.5%   3.6%       1    0.296s
+
+src/Specific/NISTP256/AMD64/feadd (real: 38.19, user: 35.40, sys: 0.30, mem: 799216 ko)
+COQC src/Specific/NISTP256/AMD64/fenz.v
+Finished transaction in 6.356 secs (5.82u,0.004s) (successful)
+total time:      5.800s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_nonzero --------------------   0.0% 100.0%       1    5.800s
+─IntegrationTestTemporaryMiscCommon.nonz   0.2%  85.5%       1    4.960s
+─destruct (Decidable.dec x), (Decidable.  37.4%  37.4%       1    2.168s
+─destruct (Decidable.dec x) as [H| H] --  22.0%  22.0%       1    1.276s
+─Pipeline.refine_reflectively_gen ------   0.0%  14.5%       1    0.840s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  10.9%       1    0.632s
+─ReflectiveTactics.solve_side_conditions   0.0%  10.6%       1    0.612s
+─ReflectiveTactics.solve_post_reified_si   0.3%   8.5%       1    0.492s
+─IntegrationTestTemporaryMiscCommon.op_s   0.1%   8.1%       2    0.368s
+─rewrite <- (ZRange.is_bounded_by_None_r   5.2%   5.2%       2    0.288s
+─UnifyAbstractReflexivity.unify_transfor   3.4%   4.3%       7    0.076s
+─ReflectiveTactics.unify_abstract_cbv_in   2.8%   3.8%       1    0.220s
+─Glue.refine_to_reflective_glue' -------   0.1%   3.6%       1    0.208s
+─rewrite H' ----------------------------   3.4%   3.4%       1    0.200s
+─generalize dependent (constr) ---------   3.0%   3.0%       4    0.060s
+─congruence ----------------------------   2.8%   2.8%       1    0.160s
+─do_tac --------------------------------   0.0%   2.6%       4    0.044s
+─destruct H ----------------------------   2.6%   2.6%       4    0.044s
+─IntegrationTestTemporaryMiscCommon.do_s   0.1%   2.6%       1    0.152s
+─DestructHyps.do_one_match_then --------   0.0%   2.6%       6    0.044s
+─DestructHyps.do_all_matches_then ------   0.0%   2.6%       2    0.076s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.4%   2.5%       3    0.140s
+─Glue.zrange_to_reflective -------------   0.0%   2.2%       1    0.128s
+─rewrite H -----------------------------   1.9%   2.1%       3    0.112s
+─ReflectiveTactics.do_reify ------------   0.0%   2.1%       1    0.120s
+─k -------------------------------------   1.9%   2.0%       1    0.116s
+─Reify.Reify_rhs_gen -------------------   0.1%   2.0%       1    0.116s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_nonzero --------------------   0.0% 100.0%       1    5.800s
+ ├─IntegrationTestTemporaryMiscCommon.no   0.2%  85.5%       1    4.960s
+ │ ├─destruct (Decidable.dec x), (Decida  37.4%  37.4%       1    2.168s
+ │ ├─destruct (Decidable.dec x) as [H| H  22.0%  22.0%       1    1.276s
+ │ ├─IntegrationTestTemporaryMiscCommon.   0.1%   8.1%       2    0.368s
+ │ │ ├─rewrite <- (ZRange.is_bounded_by_   5.2%   5.2%       2    0.288s
+ │ │ └─DestructHyps.do_all_matches_then    0.0%   2.6%       2    0.076s
+ │ │  └DestructHyps.do_one_match_then --   0.0%   2.6%       6    0.044s
+ │ │  └do_tac --------------------------   0.0%   2.6%       4    0.044s
+ │ │  └destruct H ----------------------   2.6%   2.6%       4    0.044s
+ │ ├─rewrite H' ------------------------   3.4%   3.4%       1    0.200s
+ │ ├─generalize dependent (constr) -----   3.0%   3.0%       4    0.060s
+ │ ├─congruence ------------------------   2.8%   2.8%       1    0.160s
+ │ ├─IntegrationTestTemporaryMiscCommon.   0.1%   2.6%       1    0.152s
+ │ │└<Crypto.Util.Tactics.MoveLetIn.with   0.4%   2.5%       3    0.140s
+ │ │└k ---------------------------------   1.9%   2.0%       1    0.116s
+ │ └─rewrite H -------------------------   1.7%   2.0%       2    0.112s
+ └─Pipeline.refine_reflectively_gen ----   0.0%  14.5%       1    0.840s
+   ├─ReflectiveTactics.do_reflective_pip   0.0%  10.9%       1    0.632s
+   │└ReflectiveTactics.solve_side_condit   0.0%  10.6%       1    0.612s
+   │ ├─ReflectiveTactics.solve_post_reif   0.3%   8.5%       1    0.492s
+   │ │ ├─UnifyAbstractReflexivity.unify_   3.4%   4.3%       7    0.076s
+   │ │ └─ReflectiveTactics.unify_abstrac   2.8%   3.8%       1    0.220s
+   │ └─ReflectiveTactics.do_reify ------   0.0%   2.1%       1    0.120s
+   │  └Reify.Reify_rhs_gen -------------   0.1%   2.0%       1    0.116s
+   └─Glue.refine_to_reflective_glue' ---   0.1%   3.6%       1    0.208s
+    â””Glue.zrange_to_reflective ---------   0.0%   2.2%       1    0.128s
+
+Finished transaction in 6.657 secs (6.299u,0.s) (successful)
+Closed under the global context
+total time:      5.800s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_nonzero --------------------   0.0% 100.0%       1    5.800s
+─IntegrationTestTemporaryMiscCommon.nonz   0.2%  85.5%       1    4.960s
+─destruct (Decidable.dec x), (Decidable.  37.4%  37.4%       1    2.168s
+─destruct (Decidable.dec x) as [H| H] --  22.0%  22.0%       1    1.276s
+─Pipeline.refine_reflectively_gen ------   0.0%  14.5%       1    0.840s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  10.9%       1    0.632s
+─ReflectiveTactics.solve_side_conditions   0.0%  10.6%       1    0.612s
+─ReflectiveTactics.solve_post_reified_si   0.3%   8.5%       1    0.492s
+─IntegrationTestTemporaryMiscCommon.op_s   0.1%   8.1%       2    0.368s
+─rewrite <- (ZRange.is_bounded_by_None_r   5.2%   5.2%       2    0.288s
+─UnifyAbstractReflexivity.unify_transfor   3.4%   4.3%       7    0.076s
+─ReflectiveTactics.unify_abstract_cbv_in   2.8%   3.8%       1    0.220s
+─Glue.refine_to_reflective_glue' -------   0.1%   3.6%       1    0.208s
+─rewrite H' ----------------------------   3.4%   3.4%       1    0.200s
+─generalize dependent (constr) ---------   3.0%   3.0%       4    0.060s
+─congruence ----------------------------   2.8%   2.8%       1    0.160s
+─do_tac --------------------------------   0.0%   2.6%       4    0.044s
+─destruct H ----------------------------   2.6%   2.6%       4    0.044s
+─IntegrationTestTemporaryMiscCommon.do_s   0.1%   2.6%       1    0.152s
+─DestructHyps.do_one_match_then --------   0.0%   2.6%       6    0.044s
+─DestructHyps.do_all_matches_then ------   0.0%   2.6%       2    0.076s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.4%   2.5%       3    0.140s
+─Glue.zrange_to_reflective -------------   0.0%   2.2%       1    0.128s
+─rewrite H -----------------------------   1.9%   2.1%       3    0.112s
+─ReflectiveTactics.do_reify ------------   0.0%   2.1%       1    0.120s
+─k -------------------------------------   1.9%   2.0%       1    0.116s
+─Reify.Reify_rhs_gen -------------------   0.1%   2.0%       1    0.116s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_nonzero --------------------   0.0% 100.0%       1    5.800s
+ ├─IntegrationTestTemporaryMiscCommon.no   0.2%  85.5%       1    4.960s
+ │ ├─destruct (Decidable.dec x), (Decida  37.4%  37.4%       1    2.168s
+ │ ├─destruct (Decidable.dec x) as [H| H  22.0%  22.0%       1    1.276s
+ │ ├─IntegrationTestTemporaryMiscCommon.   0.1%   8.1%       2    0.368s
+ │ │ ├─rewrite <- (ZRange.is_bounded_by_   5.2%   5.2%       2    0.288s
+ │ │ └─DestructHyps.do_all_matches_then    0.0%   2.6%       2    0.076s
+ │ │  └DestructHyps.do_one_match_then --   0.0%   2.6%       6    0.044s
+ │ │  └do_tac --------------------------   0.0%   2.6%       4    0.044s
+ │ │  └destruct H ----------------------   2.6%   2.6%       4    0.044s
+ │ ├─rewrite H' ------------------------   3.4%   3.4%       1    0.200s
+ │ ├─generalize dependent (constr) -----   3.0%   3.0%       4    0.060s
+ │ ├─congruence ------------------------   2.8%   2.8%       1    0.160s
+ │ ├─IntegrationTestTemporaryMiscCommon.   0.1%   2.6%       1    0.152s
+ │ │└<Crypto.Util.Tactics.MoveLetIn.with   0.4%   2.5%       3    0.140s
+ │ │└k ---------------------------------   1.9%   2.0%       1    0.116s
+ │ └─rewrite H -------------------------   1.7%   2.0%       2    0.112s
+ └─Pipeline.refine_reflectively_gen ----   0.0%  14.5%       1    0.840s
+   ├─ReflectiveTactics.do_reflective_pip   0.0%  10.9%       1    0.632s
+   │└ReflectiveTactics.solve_side_condit   0.0%  10.6%       1    0.612s
+   │ ├─ReflectiveTactics.solve_post_reif   0.3%   8.5%       1    0.492s
+   │ │ ├─UnifyAbstractReflexivity.unify_   3.4%   4.3%       7    0.076s
+   │ │ └─ReflectiveTactics.unify_abstrac   2.8%   3.8%       1    0.220s
+   │ └─ReflectiveTactics.do_reify ------   0.0%   2.1%       1    0.120s
+   │  └Reify.Reify_rhs_gen -------------   0.1%   2.0%       1    0.116s
+   └─Glue.refine_to_reflective_glue' ---   0.1%   3.6%       1    0.208s
+    â””Glue.zrange_to_reflective ---------   0.0%   2.2%       1    0.128s
+
+src/Specific/NISTP256/AMD64/fenz (real: 27.81, user: 25.50, sys: 0.22, mem: 756080 ko)
+COQC src/Specific/NISTP256/AMD64/feopp.v
+Finished transaction in 7.73 secs (7.112u,0.008s) (successful)
+total time:      7.072s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  62.5%       1    4.420s
+─IntegrationTestTemporaryMiscCommon.fact  18.7%  51.6%       1    3.648s
+─Pipeline.refine_reflectively_gen ------   0.0%  37.5%       1    2.652s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  32.6%       1    2.308s
+─ReflectiveTactics.solve_side_conditions   0.0%  32.2%       1    2.276s
+─reflexivity ---------------------------  24.8%  24.8%       8    1.700s
+─ReflectiveTactics.solve_post_reified_si   0.5%  18.5%       1    1.308s
+─ReflectiveTactics.do_reify ------------   0.0%  13.7%       1    0.968s
+─UnifyAbstractReflexivity.unify_transfor  11.2%  13.6%       7    0.284s
+─Reify.Reify_rhs_gen -------------------   0.6%  13.4%       1    0.948s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   9.7%       1    0.684s
+─rewrite <- (ZRange.is_bounded_by_None_r   9.0%   9.0%       4    0.328s
+─op_sig_side_conditions_t --------------   0.0%   7.8%       1    0.552s
+─rewrite <- (lem : lemT) by by_tac ltac:   0.1%   7.4%       1    0.520s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   7.4%       1    0.520s
+─by_tac --------------------------------   0.0%   7.2%       2    0.404s
+─Reify.do_reify_abs_goal ---------------   7.1%   7.2%       2    0.512s
+─Reify.do_reifyf_goal ------------------   6.6%   6.7%      62    0.472s
+─DestructHyps.do_one_match_then --------   0.2%   5.8%      14    0.048s
+─DestructHyps.do_all_matches_then ------   0.0%   5.8%       4    0.124s
+─do_tac --------------------------------   0.0%   5.6%      10    0.048s
+─destruct H ----------------------------   5.6%   5.6%      10    0.048s
+─Glue.refine_to_reflective_glue' -------   0.0%   4.9%       1    0.344s
+─ReflectiveTactics.unify_abstract_cbv_in   2.9%   4.2%       1    0.300s
+─Glue.zrange_to_reflective -------------   0.0%   3.3%       1    0.232s
+─unify (constr) (constr) ---------------   3.2%   3.2%       7    0.088s
+─Glue.zrange_to_reflective_goal --------   1.9%   2.6%       1    0.184s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   2.3%       1    0.164s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.4%   2.2%       3    0.152s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  62.5%       1    4.420s
+ ├─IntegrationTestTemporaryMiscCommon.fa  18.7%  51.6%       1    3.648s
+ │ ├─reflexivity -----------------------  24.0%  24.0%       1    1.700s
+ │ └─op_sig_side_conditions_t ----------   0.0%   7.8%       1    0.552s
+ │   ├─rewrite <- (ZRange.is_bounded_by_   4.2%   4.2%       2    0.284s
+ │   └─DestructHyps.do_all_matches_then    0.0%   3.5%       2    0.124s
+ │    └DestructHyps.do_one_match_then --   0.2%   3.5%       8    0.044s
+ │    └do_tac --------------------------   0.0%   3.3%       6    0.040s
+ │    └destruct H ----------------------   3.3%   3.3%       6    0.040s
+ └─IntegrationTestTemporaryMiscCommon.do   0.0%   9.7%       1    0.684s
+   ├─IntegrationTestTemporaryMiscCommon.   0.0%   7.4%       1    0.520s
+   │└rewrite <- (lem : lemT) by by_tac l   0.1%   7.4%       1    0.520s
+   │└by_tac ----------------------------   0.0%   7.2%       2    0.404s
+   │ ├─rewrite <- (ZRange.is_bounded_by_   4.8%   4.8%       2    0.328s
+   │ └─DestructHyps.do_all_matches_then    0.0%   2.3%       2    0.088s
+   │  └DestructHyps.do_one_match_then --   0.0%   2.3%       6    0.048s
+   │  └do_tac --------------------------   0.0%   2.3%       4    0.048s
+   │  └destruct H ----------------------   2.3%   2.3%       4    0.048s
+   └─IntegrationTestTemporaryMiscCommon.   0.0%   2.3%       1    0.164s
+    â””<Crypto.Util.Tactics.MoveLetIn.with   0.4%   2.2%       3    0.152s
+─Pipeline.refine_reflectively_gen ------   0.0%  37.5%       1    2.652s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  32.6%       1    2.308s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  32.2%       1    2.276s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.5%  18.5%       1    1.308s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  11.2%  13.6%       7    0.284s
+ │ │ └─ReflectiveTactics.unify_abstract_   2.9%   4.2%       1    0.300s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  13.7%       1    0.968s
+ │  └Reify.Reify_rhs_gen ---------------   0.6%  13.4%       1    0.948s
+ │  └Reify.do_reify_abs_goal -----------   7.1%   7.2%       2    0.512s
+ │  └Reify.do_reifyf_goal --------------   6.6%   6.7%      62    0.472s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   4.9%       1    0.344s
+  â””Glue.zrange_to_reflective -----------   0.0%   3.3%       1    0.232s
+  â””Glue.zrange_to_reflective_goal ------   1.9%   2.6%       1    0.184s
+
+Finished transaction in 7.732 secs (7.1u,0.003s) (successful)
+Closed under the global context
+total time:      7.072s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  62.5%       1    4.420s
+─IntegrationTestTemporaryMiscCommon.fact  18.7%  51.6%       1    3.648s
+─Pipeline.refine_reflectively_gen ------   0.0%  37.5%       1    2.652s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  32.6%       1    2.308s
+─ReflectiveTactics.solve_side_conditions   0.0%  32.2%       1    2.276s
+─reflexivity ---------------------------  24.8%  24.8%       8    1.700s
+─ReflectiveTactics.solve_post_reified_si   0.5%  18.5%       1    1.308s
+─ReflectiveTactics.do_reify ------------   0.0%  13.7%       1    0.968s
+─UnifyAbstractReflexivity.unify_transfor  11.2%  13.6%       7    0.284s
+─Reify.Reify_rhs_gen -------------------   0.6%  13.4%       1    0.948s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   9.7%       1    0.684s
+─rewrite <- (ZRange.is_bounded_by_None_r   9.0%   9.0%       4    0.328s
+─op_sig_side_conditions_t --------------   0.0%   7.8%       1    0.552s
+─rewrite <- (lem : lemT) by by_tac ltac:   0.1%   7.4%       1    0.520s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   7.4%       1    0.520s
+─by_tac --------------------------------   0.0%   7.2%       2    0.404s
+─Reify.do_reify_abs_goal ---------------   7.1%   7.2%       2    0.512s
+─Reify.do_reifyf_goal ------------------   6.6%   6.7%      62    0.472s
+─DestructHyps.do_one_match_then --------   0.2%   5.8%      14    0.048s
+─DestructHyps.do_all_matches_then ------   0.0%   5.8%       4    0.124s
+─do_tac --------------------------------   0.0%   5.6%      10    0.048s
+─destruct H ----------------------------   5.6%   5.6%      10    0.048s
+─Glue.refine_to_reflective_glue' -------   0.0%   4.9%       1    0.344s
+─ReflectiveTactics.unify_abstract_cbv_in   2.9%   4.2%       1    0.300s
+─Glue.zrange_to_reflective -------------   0.0%   3.3%       1    0.232s
+─unify (constr) (constr) ---------------   3.2%   3.2%       7    0.088s
+─Glue.zrange_to_reflective_goal --------   1.9%   2.6%       1    0.184s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   2.3%       1    0.164s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.4%   2.2%       3    0.152s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  62.5%       1    4.420s
+ ├─IntegrationTestTemporaryMiscCommon.fa  18.7%  51.6%       1    3.648s
+ │ ├─reflexivity -----------------------  24.0%  24.0%       1    1.700s
+ │ └─op_sig_side_conditions_t ----------   0.0%   7.8%       1    0.552s
+ │   ├─rewrite <- (ZRange.is_bounded_by_   4.2%   4.2%       2    0.284s
+ │   └─DestructHyps.do_all_matches_then    0.0%   3.5%       2    0.124s
+ │    └DestructHyps.do_one_match_then --   0.2%   3.5%       8    0.044s
+ │    └do_tac --------------------------   0.0%   3.3%       6    0.040s
+ │    └destruct H ----------------------   3.3%   3.3%       6    0.040s
+ └─IntegrationTestTemporaryMiscCommon.do   0.0%   9.7%       1    0.684s
+   ├─IntegrationTestTemporaryMiscCommon.   0.0%   7.4%       1    0.520s
+   │└rewrite <- (lem : lemT) by by_tac l   0.1%   7.4%       1    0.520s
+   │└by_tac ----------------------------   0.0%   7.2%       2    0.404s
+   │ ├─rewrite <- (ZRange.is_bounded_by_   4.8%   4.8%       2    0.328s
+   │ └─DestructHyps.do_all_matches_then    0.0%   2.3%       2    0.088s
+   │  └DestructHyps.do_one_match_then --   0.0%   2.3%       6    0.048s
+   │  └do_tac --------------------------   0.0%   2.3%       4    0.048s
+   │  └destruct H ----------------------   2.3%   2.3%       4    0.048s
+   └─IntegrationTestTemporaryMiscCommon.   0.0%   2.3%       1    0.164s
+    â””<Crypto.Util.Tactics.MoveLetIn.with   0.4%   2.2%       3    0.152s
+─Pipeline.refine_reflectively_gen ------   0.0%  37.5%       1    2.652s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  32.6%       1    2.308s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  32.2%       1    2.276s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.5%  18.5%       1    1.308s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  11.2%  13.6%       7    0.284s
+ │ │ └─ReflectiveTactics.unify_abstract_   2.9%   4.2%       1    0.300s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  13.7%       1    0.968s
+ │  └Reify.Reify_rhs_gen ---------------   0.6%  13.4%       1    0.948s
+ │  └Reify.do_reify_abs_goal -----------   7.1%   7.2%       2    0.512s
+ │  └Reify.do_reifyf_goal --------------   6.6%   6.7%      62    0.472s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   4.9%       1    0.344s
+  â””Glue.zrange_to_reflective -----------   0.0%   3.3%       1    0.232s
+  â””Glue.zrange_to_reflective_goal ------   1.9%   2.6%       1    0.184s
+
+src/Specific/NISTP256/AMD64/feopp (real: 31.00, user: 28.51, sys: 0.20, mem: 765208 ko)
+COQC src/Specific/NISTP256/AMD64/fesub.v
+Finished transaction in 12.996 secs (12.091u,0.004s) (successful)
+total time:     12.048s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  66.1%       1    7.964s
+─IntegrationTestTemporaryMiscCommon.fact  16.2%  50.9%       1    6.128s
+─Pipeline.refine_reflectively_gen ------   0.0%  33.9%       1    4.084s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  28.3%       1    3.404s
+─ReflectiveTactics.solve_side_conditions   0.0%  27.8%       1    3.352s
+─reflexivity ---------------------------  21.7%  21.7%       8    2.480s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  14.1%       1    1.704s
+─ReflectiveTactics.solve_post_reified_si   0.4%  14.1%       1    1.696s
+─ReflectiveTactics.do_reify ------------   0.0%  13.7%       1    1.656s
+─Reify.Reify_rhs_gen -------------------   0.9%  13.2%       1    1.592s
+─DestructHyps.do_all_matches_then ------   0.0%  12.9%       8    0.232s
+─DestructHyps.do_one_match_then --------   0.6%  12.9%      44    0.052s
+─op_sig_side_conditions_t --------------   0.0%  12.7%       1    1.528s
+─do_tac --------------------------------   0.0%  12.3%      36    0.048s
+─destruct H ----------------------------  12.3%  12.3%      36    0.048s
+─rewrite <- (lem : lemT) by by_tac ltac:   0.1%  11.2%       1    1.352s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  11.2%       1    1.352s
+─by_tac --------------------------------   0.0%  11.1%       4    0.476s
+─UnifyAbstractReflexivity.unify_transfor   8.8%  10.6%       7    0.344s
+─rewrite <- (ZRange.is_bounded_by_None_r  10.5%  10.5%       8    0.316s
+─Reify.do_reify_abs_goal ---------------   6.0%   6.1%       2    0.732s
+─Glue.refine_to_reflective_glue' -------   0.0%   5.6%       1    0.680s
+─Reify.do_reifyf_goal ------------------   5.4%   5.5%      80    0.660s
+─Glue.zrange_to_reflective -------------   0.0%   3.6%       1    0.428s
+─ReflectiveTactics.unify_abstract_cbv_in   2.2%   3.0%       1    0.360s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   2.9%       1    0.348s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.5%   2.8%       3    0.332s
+─Glue.zrange_to_reflective_goal --------   1.7%   2.6%       1    0.316s
+─k -------------------------------------   2.1%   2.2%       1    0.268s
+─unify (constr) (constr) ---------------   2.1%   2.1%       8    0.092s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  66.1%       1    7.964s
+ ├─IntegrationTestTemporaryMiscCommon.fa  16.2%  50.9%       1    6.128s
+ │ ├─reflexivity -----------------------  20.6%  20.6%       1    2.480s
+ │ └─op_sig_side_conditions_t ----------   0.0%  12.7%       1    1.528s
+ │   ├─DestructHyps.do_all_matches_then    0.0%   7.3%       4    0.232s
+ │   │└DestructHyps.do_one_match_then --   0.3%   7.3%      24    0.052s
+ │   │└do_tac --------------------------   0.0%   7.0%      20    0.048s
+ │   │└destruct H ----------------------   6.9%   6.9%      20    0.048s
+ │   └─rewrite <- (ZRange.is_bounded_by_   5.2%   5.2%       4    0.300s
+ └─IntegrationTestTemporaryMiscCommon.do   0.0%  14.1%       1    1.704s
+   ├─IntegrationTestTemporaryMiscCommon.   0.0%  11.2%       1    1.352s
+   │└rewrite <- (lem : lemT) by by_tac l   0.1%  11.2%       1    1.352s
+   │└by_tac ----------------------------   0.0%  11.1%       4    0.476s
+   │ ├─DestructHyps.do_all_matches_then    0.0%   5.6%       4    0.176s
+   │ │└DestructHyps.do_one_match_then --   0.2%   5.6%      20    0.052s
+   │ │└do_tac --------------------------   0.0%   5.3%      16    0.048s
+   │ │└destruct H ----------------------   5.3%   5.3%      16    0.048s
+   │ └─rewrite <- (ZRange.is_bounded_by_   5.3%   5.3%       4    0.316s
+   └─IntegrationTestTemporaryMiscCommon.   0.0%   2.9%       1    0.348s
+    â””<Crypto.Util.Tactics.MoveLetIn.with   0.5%   2.8%       3    0.332s
+    â””k ---------------------------------   2.1%   2.2%       1    0.268s
+─Pipeline.refine_reflectively_gen ------   0.0%  33.9%       1    4.084s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  28.3%       1    3.404s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  27.8%       1    3.352s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.4%  14.1%       1    1.696s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr   8.8%  10.6%       7    0.344s
+ │ │ └─ReflectiveTactics.unify_abstract_   2.2%   3.0%       1    0.360s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  13.7%       1    1.656s
+ │  └Reify.Reify_rhs_gen ---------------   0.9%  13.2%       1    1.592s
+ │  └Reify.do_reify_abs_goal -----------   6.0%   6.1%       2    0.732s
+ │  └Reify.do_reifyf_goal --------------   5.4%   5.5%      80    0.660s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   5.6%       1    0.680s
+  â””Glue.zrange_to_reflective -----------   0.0%   3.6%       1    0.428s
+  â””Glue.zrange_to_reflective_goal ------   1.7%   2.6%       1    0.316s
+
+Finished transaction in 13.895 secs (12.78u,0.02s) (successful)
+Closed under the global context
+total time:     12.048s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  66.1%       1    7.964s
+─IntegrationTestTemporaryMiscCommon.fact  16.2%  50.9%       1    6.128s
+─Pipeline.refine_reflectively_gen ------   0.0%  33.9%       1    4.084s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  28.3%       1    3.404s
+─ReflectiveTactics.solve_side_conditions   0.0%  27.8%       1    3.352s
+─reflexivity ---------------------------  21.7%  21.7%       8    2.480s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  14.1%       1    1.704s
+─ReflectiveTactics.solve_post_reified_si   0.4%  14.1%       1    1.696s
+─ReflectiveTactics.do_reify ------------   0.0%  13.7%       1    1.656s
+─Reify.Reify_rhs_gen -------------------   0.9%  13.2%       1    1.592s
+─DestructHyps.do_all_matches_then ------   0.0%  12.9%       8    0.232s
+─DestructHyps.do_one_match_then --------   0.6%  12.9%      44    0.052s
+─op_sig_side_conditions_t --------------   0.0%  12.7%       1    1.528s
+─do_tac --------------------------------   0.0%  12.3%      36    0.048s
+─destruct H ----------------------------  12.3%  12.3%      36    0.048s
+─rewrite <- (lem : lemT) by by_tac ltac:   0.1%  11.2%       1    1.352s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%  11.2%       1    1.352s
+─by_tac --------------------------------   0.0%  11.1%       4    0.476s
+─UnifyAbstractReflexivity.unify_transfor   8.8%  10.6%       7    0.344s
+─rewrite <- (ZRange.is_bounded_by_None_r  10.5%  10.5%       8    0.316s
+─Reify.do_reify_abs_goal ---------------   6.0%   6.1%       2    0.732s
+─Glue.refine_to_reflective_glue' -------   0.0%   5.6%       1    0.680s
+─Reify.do_reifyf_goal ------------------   5.4%   5.5%      80    0.660s
+─Glue.zrange_to_reflective -------------   0.0%   3.6%       1    0.428s
+─ReflectiveTactics.unify_abstract_cbv_in   2.2%   3.0%       1    0.360s
+─IntegrationTestTemporaryMiscCommon.do_s   0.0%   2.9%       1    0.348s
+─<Crypto.Util.Tactics.MoveLetIn.with_uco   0.5%   2.8%       3    0.332s
+─Glue.zrange_to_reflective_goal --------   1.7%   2.6%       1    0.316s
+─k -------------------------------------   2.1%   2.2%       1    0.268s
+─unify (constr) (constr) ---------------   2.1%   2.1%       8    0.092s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_montgomery -----------------   0.0%  66.1%       1    7.964s
+ ├─IntegrationTestTemporaryMiscCommon.fa  16.2%  50.9%       1    6.128s
+ │ ├─reflexivity -----------------------  20.6%  20.6%       1    2.480s
+ │ └─op_sig_side_conditions_t ----------   0.0%  12.7%       1    1.528s
+ │   ├─DestructHyps.do_all_matches_then    0.0%   7.3%       4    0.232s
+ │   │└DestructHyps.do_one_match_then --   0.3%   7.3%      24    0.052s
+ │   │└do_tac --------------------------   0.0%   7.0%      20    0.048s
+ │   │└destruct H ----------------------   6.9%   6.9%      20    0.048s
+ │   └─rewrite <- (ZRange.is_bounded_by_   5.2%   5.2%       4    0.300s
+ └─IntegrationTestTemporaryMiscCommon.do   0.0%  14.1%       1    1.704s
+   ├─IntegrationTestTemporaryMiscCommon.   0.0%  11.2%       1    1.352s
+   │└rewrite <- (lem : lemT) by by_tac l   0.1%  11.2%       1    1.352s
+   │└by_tac ----------------------------   0.0%  11.1%       4    0.476s
+   │ ├─DestructHyps.do_all_matches_then    0.0%   5.6%       4    0.176s
+   │ │└DestructHyps.do_one_match_then --   0.2%   5.6%      20    0.052s
+   │ │└do_tac --------------------------   0.0%   5.3%      16    0.048s
+   │ │└destruct H ----------------------   5.3%   5.3%      16    0.048s
+   │ └─rewrite <- (ZRange.is_bounded_by_   5.3%   5.3%       4    0.316s
+   └─IntegrationTestTemporaryMiscCommon.   0.0%   2.9%       1    0.348s
+    â””<Crypto.Util.Tactics.MoveLetIn.with   0.5%   2.8%       3    0.332s
+    â””k ---------------------------------   2.1%   2.2%       1    0.268s
+─Pipeline.refine_reflectively_gen ------   0.0%  33.9%       1    4.084s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  28.3%       1    3.404s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  27.8%       1    3.352s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.4%  14.1%       1    1.696s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr   8.8%  10.6%       7    0.344s
+ │ │ └─ReflectiveTactics.unify_abstract_   2.2%   3.0%       1    0.360s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  13.7%       1    1.656s
+ │  └Reify.Reify_rhs_gen ---------------   0.9%  13.2%       1    1.592s
+ │  └Reify.do_reify_abs_goal -----------   6.0%   6.1%       2    0.732s
+ │  └Reify.do_reifyf_goal --------------   5.4%   5.5%      80    0.660s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   5.6%       1    0.680s
+  â””Glue.zrange_to_reflective -----------   0.0%   3.6%       1    0.428s
+  â””Glue.zrange_to_reflective_goal ------   1.7%   2.6%       1    0.316s
+
+src/Specific/NISTP256/AMD64/fesub (real: 43.34, user: 39.59, sys: 0.26, mem: 793376 ko)
+COQC src/Specific/NISTP256/AMD64/feaddDisplay > src/Specific/NISTP256/AMD64/feaddDisplay.log
+COQC src/Specific/NISTP256/AMD64/fenzDisplay > src/Specific/NISTP256/AMD64/fenzDisplay.log
+COQC src/Specific/solinas32_2e255m765_12limbs/femul.v
+Finished transaction in 50.426 secs (46.528u,0.072s) (successful)
+total time:     46.544s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------  -0.0%  94.9%       1   44.164s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  87.1%       1   40.552s
+─ReflectiveTactics.solve_side_conditions   0.0%  86.7%       1   40.372s
+─ReflectiveTactics.do_reify ------------   0.0%  59.6%       1   27.740s
+─Reify.Reify_rhs_gen -------------------   1.6%  58.9%       1   27.432s
+─Reify.do_reify_abs_goal ---------------  43.3%  43.6%       2   20.312s
+─Reify.do_reifyf_goal ------------------  42.5%  42.8%     108   10.328s
+─ReflectiveTactics.solve_post_reified_si   0.1%  27.1%       1   12.632s
+─UnifyAbstractReflexivity.unify_transfor  18.6%  23.5%       7    3.552s
+─eexact --------------------------------  13.7%  13.7%     110    0.136s
+─Glue.refine_to_reflective_glue' -------   0.0%   7.8%       1    3.612s
+─Glue.zrange_to_reflective -------------   0.0%   7.2%       1    3.332s
+─Glue.zrange_to_reflective_goal --------   1.7%   5.5%       1    2.544s
+─synthesize ----------------------------   0.0%   5.1%       1    2.380s
+─unify (constr) (constr) ---------------   5.1%   5.1%       6    1.068s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   5.0%       1    2.320s
+─change G' -----------------------------   4.8%   4.8%       1    2.252s
+─rewrite H -----------------------------   3.8%   3.8%       1    1.748s
+─pose proof  (pf   :   Interpretation.Bo   3.6%   3.6%       1    1.664s
+─prove_interp_compile_correct ----------   0.0%   3.5%       1    1.616s
+─rewrite ?EtaInterp.InterpExprEta ------   3.2%   3.2%       1    1.468s
+─ReflectiveTactics.unify_abstract_cbv_in   1.6%   2.4%       1    1.124s
+─reflexivity ---------------------------   2.1%   2.1%       7    0.396s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------  -0.0%  94.9%       1   44.164s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  87.1%       1   40.552s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  86.7%       1   40.372s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  59.6%       1   27.740s
+ │ │└Reify.Reify_rhs_gen ---------------   1.6%  58.9%       1   27.432s
+ │ │ ├─Reify.do_reify_abs_goal ---------  43.3%  43.6%       2   20.312s
+ │ │ │└Reify.do_reifyf_goal ------------  42.5%  42.8%     108   10.328s
+ │ │ │└eexact --------------------------  13.2%  13.2%     108    0.072s
+ │ │ ├─rewrite H -----------------------   3.8%   3.8%       1    1.748s
+ │ │ └─prove_interp_compile_correct ----   0.0%   3.5%       1    1.616s
+ │ │  └rewrite ?EtaInterp.InterpExprEta    3.2%   3.2%       1    1.468s
+ │ └─ReflectiveTactics.solve_post_reifie   0.1%  27.1%       1   12.632s
+ │   ├─UnifyAbstractReflexivity.unify_tr  18.6%  23.5%       7    3.552s
+ │   │└unify (constr) (constr) ---------   4.3%   4.3%       5    1.068s
+ │   └─ReflectiveTactics.unify_abstract_   1.6%   2.4%       1    1.124s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   7.8%       1    3.612s
+  â””Glue.zrange_to_reflective -----------   0.0%   7.2%       1    3.332s
+  â””Glue.zrange_to_reflective_goal ------   1.7%   5.5%       1    2.544s
+  â””pose proof  (pf   :   Interpretation.   3.6%   3.6%       1    1.664s
+─synthesize ----------------------------   0.0%   5.1%       1    2.380s
+â””IntegrationTestTemporaryMiscCommon.do_r   0.0%   5.0%       1    2.320s
+â””change G' -----------------------------   4.8%   4.8%       1    2.252s
+
+Finished transaction in 80.129 secs (74.068u,0.024s) (successful)
+Closed under the global context
+total time:     46.544s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------  -0.0%  94.9%       1   44.164s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  87.1%       1   40.552s
+─ReflectiveTactics.solve_side_conditions   0.0%  86.7%       1   40.372s
+─ReflectiveTactics.do_reify ------------   0.0%  59.6%       1   27.740s
+─Reify.Reify_rhs_gen -------------------   1.6%  58.9%       1   27.432s
+─Reify.do_reify_abs_goal ---------------  43.3%  43.6%       2   20.312s
+─Reify.do_reifyf_goal ------------------  42.5%  42.8%     108   10.328s
+─ReflectiveTactics.solve_post_reified_si   0.1%  27.1%       1   12.632s
+─UnifyAbstractReflexivity.unify_transfor  18.6%  23.5%       7    3.552s
+─eexact --------------------------------  13.7%  13.7%     110    0.136s
+─Glue.refine_to_reflective_glue' -------   0.0%   7.8%       1    3.612s
+─Glue.zrange_to_reflective -------------   0.0%   7.2%       1    3.332s
+─Glue.zrange_to_reflective_goal --------   1.7%   5.5%       1    2.544s
+─synthesize ----------------------------   0.0%   5.1%       1    2.380s
+─unify (constr) (constr) ---------------   5.1%   5.1%       6    1.068s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   5.0%       1    2.320s
+─change G' -----------------------------   4.8%   4.8%       1    2.252s
+─rewrite H -----------------------------   3.8%   3.8%       1    1.748s
+─pose proof  (pf   :   Interpretation.Bo   3.6%   3.6%       1    1.664s
+─prove_interp_compile_correct ----------   0.0%   3.5%       1    1.616s
+─rewrite ?EtaInterp.InterpExprEta ------   3.2%   3.2%       1    1.468s
+─ReflectiveTactics.unify_abstract_cbv_in   1.6%   2.4%       1    1.124s
+─reflexivity ---------------------------   2.1%   2.1%       7    0.396s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------  -0.0%  94.9%       1   44.164s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  87.1%       1   40.552s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  86.7%       1   40.372s
+ │ ├─ReflectiveTactics.do_reify --------   0.0%  59.6%       1   27.740s
+ │ │└Reify.Reify_rhs_gen ---------------   1.6%  58.9%       1   27.432s
+ │ │ ├─Reify.do_reify_abs_goal ---------  43.3%  43.6%       2   20.312s
+ │ │ │└Reify.do_reifyf_goal ------------  42.5%  42.8%     108   10.328s
+ │ │ │└eexact --------------------------  13.2%  13.2%     108    0.072s
+ │ │ ├─rewrite H -----------------------   3.8%   3.8%       1    1.748s
+ │ │ └─prove_interp_compile_correct ----   0.0%   3.5%       1    1.616s
+ │ │  └rewrite ?EtaInterp.InterpExprEta    3.2%   3.2%       1    1.468s
+ │ └─ReflectiveTactics.solve_post_reifie   0.1%  27.1%       1   12.632s
+ │   ├─UnifyAbstractReflexivity.unify_tr  18.6%  23.5%       7    3.552s
+ │   │└unify (constr) (constr) ---------   4.3%   4.3%       5    1.068s
+ │   └─ReflectiveTactics.unify_abstract_   1.6%   2.4%       1    1.124s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   7.8%       1    3.612s
+  â””Glue.zrange_to_reflective -----------   0.0%   7.2%       1    3.332s
+  â””Glue.zrange_to_reflective_goal ------   1.7%   5.5%       1    2.544s
+  â””pose proof  (pf   :   Interpretation.   3.6%   3.6%       1    1.664s
+─synthesize ----------------------------   0.0%   5.1%       1    2.380s
+â””IntegrationTestTemporaryMiscCommon.do_r   0.0%   5.0%       1    2.320s
+â””change G' -----------------------------   4.8%   4.8%       1    2.252s
+
+src/Specific/solinas32_2e255m765_12limbs/femul (real: 155.79, user: 143.70, sys: 0.32, mem: 1454696 ko)
+COQC src/Specific/NISTP256/AMD64/feoppDisplay > src/Specific/NISTP256/AMD64/feoppDisplay.log
+COQC src/Specific/NISTP256/AMD64/fesubDisplay > src/Specific/NISTP256/AMD64/fesubDisplay.log
+COQC src/Specific/X25519/C64/fesquareDisplay > src/Specific/X25519/C64/fesquareDisplay.log
+COQC src/Specific/X25519/C64/fesubDisplay > src/Specific/X25519/C64/fesubDisplay.log
+COQC src/Specific/X25519/C64/freezeDisplay > src/Specific/X25519/C64/freezeDisplay.log
+COQC src/Specific/solinas32_2e255m765_13limbs/femul.v
+Finished transaction in 61.854 secs (57.328u,0.079s) (successful)
+total time:     57.348s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  94.6%       1   54.224s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  86.2%       1   49.452s
+─ReflectiveTactics.solve_side_conditions   0.0%  85.9%       1   49.264s
+─ReflectiveTactics.do_reify ------------  -0.0%  57.6%       1   33.004s
+─Reify.Reify_rhs_gen -------------------   1.3%  56.9%       1   32.608s
+─Reify.do_reify_abs_goal ---------------  43.1%  43.3%       2   24.840s
+─Reify.do_reifyf_goal ------------------  42.3%  42.6%     117   12.704s
+─ReflectiveTactics.solve_post_reified_si   0.1%  28.4%       1   16.260s
+─UnifyAbstractReflexivity.unify_transfor  19.6%  25.0%       7    4.824s
+─eexact --------------------------------  13.9%  13.9%     119    0.144s
+─Glue.refine_to_reflective_glue' -------   0.0%   8.3%       1    4.772s
+─Glue.zrange_to_reflective -------------   0.0%   7.8%       1    4.484s
+─Glue.zrange_to_reflective_goal --------   1.7%   6.0%       1    3.464s
+─synthesize ----------------------------   0.0%   5.4%       1    3.124s
+─unify (constr) (constr) ---------------   5.4%   5.4%       6    1.540s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   5.3%       1    3.040s
+─change G' -----------------------------   5.2%   5.2%       1    2.964s
+─pose proof  (pf   :   Interpretation.Bo   4.2%   4.2%       1    2.416s
+─prove_interp_compile_correct ----------   0.0%   3.3%       1    1.904s
+─rewrite H -----------------------------   3.3%   3.3%       1    1.896s
+─rewrite ?EtaInterp.InterpExprEta ------   3.0%   3.0%       1    1.732s
+─ReflectiveTactics.unify_abstract_cbv_in   1.4%   2.1%       1    1.212s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  94.6%       1   54.224s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  86.2%       1   49.452s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  85.9%       1   49.264s
+ │ ├─ReflectiveTactics.do_reify --------  -0.0%  57.6%       1   33.004s
+ │ │└Reify.Reify_rhs_gen ---------------   1.3%  56.9%       1   32.608s
+ │ │ ├─Reify.do_reify_abs_goal ---------  43.1%  43.3%       2   24.840s
+ │ │ │└Reify.do_reifyf_goal ------------  42.3%  42.6%     117   12.704s
+ │ │ │└eexact --------------------------  13.4%  13.4%     117    0.084s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   3.3%       1    1.904s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    3.0%   3.0%       1    1.732s
+ │ │ └─rewrite H -----------------------   3.3%   3.3%       1    1.896s
+ │ └─ReflectiveTactics.solve_post_reifie   0.1%  28.4%       1   16.260s
+ │   ├─UnifyAbstractReflexivity.unify_tr  19.6%  25.0%       7    4.824s
+ │   │└unify (constr) (constr) ---------   4.8%   4.8%       5    1.540s
+ │   └─ReflectiveTactics.unify_abstract_   1.4%   2.1%       1    1.212s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   8.3%       1    4.772s
+  â””Glue.zrange_to_reflective -----------   0.0%   7.8%       1    4.484s
+  â””Glue.zrange_to_reflective_goal ------   1.7%   6.0%       1    3.464s
+  â””pose proof  (pf   :   Interpretation.   4.2%   4.2%       1    2.416s
+─synthesize ----------------------------   0.0%   5.4%       1    3.124s
+â””IntegrationTestTemporaryMiscCommon.do_r   0.0%   5.3%       1    3.040s
+â””change G' -----------------------------   5.2%   5.2%       1    2.964s
+
+Finished transaction in 94.432 secs (86.96u,0.02s) (successful)
+Closed under the global context
+total time:     57.348s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  94.6%       1   54.224s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  86.2%       1   49.452s
+─ReflectiveTactics.solve_side_conditions   0.0%  85.9%       1   49.264s
+─ReflectiveTactics.do_reify ------------  -0.0%  57.6%       1   33.004s
+─Reify.Reify_rhs_gen -------------------   1.3%  56.9%       1   32.608s
+─Reify.do_reify_abs_goal ---------------  43.1%  43.3%       2   24.840s
+─Reify.do_reifyf_goal ------------------  42.3%  42.6%     117   12.704s
+─ReflectiveTactics.solve_post_reified_si   0.1%  28.4%       1   16.260s
+─UnifyAbstractReflexivity.unify_transfor  19.6%  25.0%       7    4.824s
+─eexact --------------------------------  13.9%  13.9%     119    0.144s
+─Glue.refine_to_reflective_glue' -------   0.0%   8.3%       1    4.772s
+─Glue.zrange_to_reflective -------------   0.0%   7.8%       1    4.484s
+─Glue.zrange_to_reflective_goal --------   1.7%   6.0%       1    3.464s
+─synthesize ----------------------------   0.0%   5.4%       1    3.124s
+─unify (constr) (constr) ---------------   5.4%   5.4%       6    1.540s
+─IntegrationTestTemporaryMiscCommon.do_r   0.0%   5.3%       1    3.040s
+─change G' -----------------------------   5.2%   5.2%       1    2.964s
+─pose proof  (pf   :   Interpretation.Bo   4.2%   4.2%       1    2.416s
+─prove_interp_compile_correct ----------   0.0%   3.3%       1    1.904s
+─rewrite H -----------------------------   3.3%   3.3%       1    1.896s
+─rewrite ?EtaInterp.InterpExprEta ------   3.0%   3.0%       1    1.732s
+─ReflectiveTactics.unify_abstract_cbv_in   1.4%   2.1%       1    1.212s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  94.6%       1   54.224s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  86.2%       1   49.452s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  85.9%       1   49.264s
+ │ ├─ReflectiveTactics.do_reify --------  -0.0%  57.6%       1   33.004s
+ │ │└Reify.Reify_rhs_gen ---------------   1.3%  56.9%       1   32.608s
+ │ │ ├─Reify.do_reify_abs_goal ---------  43.1%  43.3%       2   24.840s
+ │ │ │└Reify.do_reifyf_goal ------------  42.3%  42.6%     117   12.704s
+ │ │ │└eexact --------------------------  13.4%  13.4%     117    0.084s
+ │ │ ├─prove_interp_compile_correct ----   0.0%   3.3%       1    1.904s
+ │ │ │└rewrite ?EtaInterp.InterpExprEta    3.0%   3.0%       1    1.732s
+ │ │ └─rewrite H -----------------------   3.3%   3.3%       1    1.896s
+ │ └─ReflectiveTactics.solve_post_reifie   0.1%  28.4%       1   16.260s
+ │   ├─UnifyAbstractReflexivity.unify_tr  19.6%  25.0%       7    4.824s
+ │   │└unify (constr) (constr) ---------   4.8%   4.8%       5    1.540s
+ │   └─ReflectiveTactics.unify_abstract_   1.4%   2.1%       1    1.212s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   8.3%       1    4.772s
+  â””Glue.zrange_to_reflective -----------   0.0%   7.8%       1    4.484s
+  â””Glue.zrange_to_reflective_goal ------   1.7%   6.0%       1    3.464s
+  â””pose proof  (pf   :   Interpretation.   4.2%   4.2%       1    2.416s
+─synthesize ----------------------------   0.0%   5.4%       1    3.124s
+â””IntegrationTestTemporaryMiscCommon.do_r   0.0%   5.3%       1    3.040s
+â””change G' -----------------------------   5.2%   5.2%       1    2.964s
+
+src/Specific/solinas32_2e255m765_13limbs/femul (real: 181.77, user: 168.52, sys: 0.40, mem: 1589516 ko)
+COQC src/Specific/NISTP256/AMD64/femul.v
+Finished transaction in 119.257 secs (109.936u,0.256s) (successful)
+total time:    110.140s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.1%       1  106.964s
+─ReflectiveTactics.do_reflective_pipelin  -0.0%  96.4%       1  106.196s
+─ReflectiveTactics.solve_side_conditions   0.0%  96.2%       1  105.992s
+─ReflectiveTactics.do_reify ------------  -0.0%  83.7%       1   92.208s
+─Reify.Reify_rhs_gen -------------------   0.7%  83.5%       1   91.960s
+─Reify.do_reify_abs_goal ---------------  77.7%  77.8%       2   85.708s
+─Reify.do_reifyf_goal ------------------  77.4%  77.5%     901   85.364s
+─eexact --------------------------------  17.9%  17.9%     903    0.136s
+─ReflectiveTactics.solve_post_reified_si   0.3%  12.5%       1   13.784s
+─UnifyAbstractReflexivity.unify_transfor   9.8%  11.2%       7    3.356s
+─synthesize_montgomery -----------------   0.0%   2.9%       1    3.176s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.1%       1  106.964s
+â””ReflectiveTactics.do_reflective_pipelin  -0.0%  96.4%       1  106.196s
+â””ReflectiveTactics.solve_side_conditions   0.0%  96.2%       1  105.992s
+ ├─ReflectiveTactics.do_reify ----------  -0.0%  83.7%       1   92.208s
+ │└Reify.Reify_rhs_gen -----------------   0.7%  83.5%       1   91.960s
+ │└Reify.do_reify_abs_goal -------------  77.7%  77.8%       2   85.708s
+ │└Reify.do_reifyf_goal ----------------  77.4%  77.5%     901   85.364s
+ │└eexact ------------------------------  17.7%  17.7%     901    0.136s
+ └─ReflectiveTactics.solve_post_reified_   0.3%  12.5%       1   13.784s
+  â””UnifyAbstractReflexivity.unify_transf   9.8%  11.2%       7    3.356s
+─synthesize_montgomery -----------------   0.0%   2.9%       1    3.176s
+
+Finished transaction in 61.452 secs (58.503u,0.055s) (successful)
+Closed under the global context
+total time:    110.140s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.1%       1  106.964s
+─ReflectiveTactics.do_reflective_pipelin  -0.0%  96.4%       1  106.196s
+─ReflectiveTactics.solve_side_conditions   0.0%  96.2%       1  105.992s
+─ReflectiveTactics.do_reify ------------  -0.0%  83.7%       1   92.208s
+─Reify.Reify_rhs_gen -------------------   0.7%  83.5%       1   91.960s
+─Reify.do_reify_abs_goal ---------------  77.7%  77.8%       2   85.708s
+─Reify.do_reifyf_goal ------------------  77.4%  77.5%     901   85.364s
+─eexact --------------------------------  17.9%  17.9%     903    0.136s
+─ReflectiveTactics.solve_post_reified_si   0.3%  12.5%       1   13.784s
+─UnifyAbstractReflexivity.unify_transfor   9.8%  11.2%       7    3.356s
+─synthesize_montgomery -----------------   0.0%   2.9%       1    3.176s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─Pipeline.refine_reflectively_gen ------   0.0%  97.1%       1  106.964s
+â””ReflectiveTactics.do_reflective_pipelin  -0.0%  96.4%       1  106.196s
+â””ReflectiveTactics.solve_side_conditions   0.0%  96.2%       1  105.992s
+ ├─ReflectiveTactics.do_reify ----------  -0.0%  83.7%       1   92.208s
+ │└Reify.Reify_rhs_gen -----------------   0.7%  83.5%       1   91.960s
+ │└Reify.do_reify_abs_goal -------------  77.7%  77.8%       2   85.708s
+ │└Reify.do_reifyf_goal ----------------  77.4%  77.5%     901   85.364s
+ │└eexact ------------------------------  17.7%  17.7%     901    0.136s
+ └─ReflectiveTactics.solve_post_reified_   0.3%  12.5%       1   13.784s
+  â””UnifyAbstractReflexivity.unify_transf   9.8%  11.2%       7    3.356s
+─synthesize_montgomery -----------------   0.0%   2.9%       1    3.176s
+
+src/Specific/NISTP256/AMD64/femul (real: 202.96, user: 189.62, sys: 0.64, mem: 3302508 ko)
+COQC src/Specific/NISTP256/AMD64/femulDisplay > src/Specific/NISTP256/AMD64/femulDisplay.log
+COQC src/Specific/X25519/C64/ladderstep.v
+total time:     52.080s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_xzladderstep ---------------   0.0% 100.0%       1   52.080s
+─Pipeline.refine_reflectively_gen ------   0.0%  98.5%       1   51.320s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  93.8%       1   48.872s
+─ReflectiveTactics.solve_side_conditions   0.0%  93.7%       1   48.776s
+─ReflectiveTactics.solve_post_reified_si   0.2%  56.5%       1   29.412s
+─UnifyAbstractReflexivity.unify_transfor  44.7%  49.1%       7    6.968s
+─ReflectiveTactics.do_reify ------------   0.0%  37.2%       1   19.364s
+─Reify.Reify_rhs_gen -------------------   2.1%  23.4%       1   12.200s
+─Reify.do_reifyf_goal ------------------  11.2%  11.3%     138    1.884s
+─Compilers.Reify.reify_context_variables   0.1%   9.2%       1    4.808s
+─rewrite H -----------------------------   7.3%   7.3%       1    3.816s
+─ReflectiveTactics.unify_abstract_cbv_in   4.7%   6.4%       1    3.336s
+─Glue.refine_to_reflective_glue' -------   0.0%   4.7%       1    2.448s
+─Glue.zrange_to_reflective -------------   0.0%   4.0%       1    2.068s
+─Reify.transitivity_tt -----------------   0.1%   3.7%       2    0.984s
+─transitivity --------------------------   3.5%   3.5%      10    0.880s
+─reflexivity ---------------------------   3.4%   3.4%      11    0.772s
+─Glue.zrange_to_reflective_goal --------   2.4%   3.3%       1    1.728s
+─eexact --------------------------------   3.2%   3.2%     140    0.032s
+─unify (constr) (constr) ---------------   3.1%   3.1%       6    0.852s
+─clear (var_list) ----------------------   3.1%   3.1%      98    0.584s
+─UnfoldArg.unfold_second_arg -----------   0.4%   3.0%       2    1.576s
+─tac -----------------------------------   2.1%   3.0%       2    1.564s
+─ClearAll.clear_all --------------------   0.2%   2.8%       7    0.584s
+─ChangeInAll.change_with_compute_in_all    0.0%   2.6%     221    0.012s
+─change c with c' in * -----------------   2.5%   2.5%     221    0.012s
+─Reify.do_reify_abs_goal ---------------   2.4%   2.5%       2    1.276s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_xzladderstep ---------------   0.0% 100.0%       1   52.080s
+â””Pipeline.refine_reflectively_gen ------   0.0%  98.5%       1   51.320s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  93.8%       1   48.872s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  93.7%       1   48.776s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.2%  56.5%       1   29.412s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  44.7%  49.1%       7    6.968s
+ │ │ │└ClearAll.clear_all --------------   0.2%   2.8%       7    0.584s
+ │ │ │└clear (var_list) ----------------   2.7%   2.7%      65    0.584s
+ │ │ └─ReflectiveTactics.unify_abstract_   4.7%   6.4%       1    3.336s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  37.2%       1   19.364s
+ │   ├─Reify.Reify_rhs_gen -------------   2.1%  23.4%       1   12.200s
+ │   │ ├─rewrite H ---------------------   7.3%   7.3%       1    3.816s
+ │   │ ├─Reify.transitivity_tt ---------   0.1%   3.7%       2    0.984s
+ │   │ │└transitivity ------------------   3.4%   3.4%       4    0.880s
+ │   │ ├─tac ---------------------------   2.1%   3.0%       1    1.564s
+ │   │ └─Reify.do_reify_abs_goal -------   2.4%   2.5%       2    1.276s
+ │   │  └Reify.do_reifyf_goal ----------   2.2%   2.2%      25    1.148s
+ │   ├─Compilers.Reify.reify_context_var   0.1%   9.2%       1    4.808s
+ │   │└Reify.do_reifyf_goal ------------   9.0%   9.1%     113    1.884s
+ │   │└eexact --------------------------   2.4%   2.4%     113    0.032s
+ │   └─UnfoldArg.unfold_second_arg -----   0.4%   3.0%       2    1.576s
+ │    └ChangeInAll.change_with_compute_i   0.0%   2.6%     221    0.012s
+ │    └change c with c' in * -----------   2.5%   2.5%     221    0.012s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   4.7%       1    2.448s
+  â””Glue.zrange_to_reflective -----------   0.0%   4.0%       1    2.068s
+  â””Glue.zrange_to_reflective_goal ------   2.4%   3.3%       1    1.728s
+
+Finished transaction in 171.122 secs (161.392u,0.039s) (successful)
+Closed under the global context
+total time:     52.080s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_xzladderstep ---------------   0.0% 100.0%       1   52.080s
+─Pipeline.refine_reflectively_gen ------   0.0%  98.5%       1   51.320s
+─ReflectiveTactics.do_reflective_pipelin   0.0%  93.8%       1   48.872s
+─ReflectiveTactics.solve_side_conditions   0.0%  93.7%       1   48.776s
+─ReflectiveTactics.solve_post_reified_si   0.2%  56.5%       1   29.412s
+─UnifyAbstractReflexivity.unify_transfor  44.7%  49.1%       7    6.968s
+─ReflectiveTactics.do_reify ------------   0.0%  37.2%       1   19.364s
+─Reify.Reify_rhs_gen -------------------   2.1%  23.4%       1   12.200s
+─Reify.do_reifyf_goal ------------------  11.2%  11.3%     138    1.884s
+─Compilers.Reify.reify_context_variables   0.1%   9.2%       1    4.808s
+─rewrite H -----------------------------   7.3%   7.3%       1    3.816s
+─ReflectiveTactics.unify_abstract_cbv_in   4.7%   6.4%       1    3.336s
+─Glue.refine_to_reflective_glue' -------   0.0%   4.7%       1    2.448s
+─Glue.zrange_to_reflective -------------   0.0%   4.0%       1    2.068s
+─Reify.transitivity_tt -----------------   0.1%   3.7%       2    0.984s
+─transitivity --------------------------   3.5%   3.5%      10    0.880s
+─reflexivity ---------------------------   3.4%   3.4%      11    0.772s
+─Glue.zrange_to_reflective_goal --------   2.4%   3.3%       1    1.728s
+─eexact --------------------------------   3.2%   3.2%     140    0.032s
+─unify (constr) (constr) ---------------   3.1%   3.1%       6    0.852s
+─clear (var_list) ----------------------   3.1%   3.1%      98    0.584s
+─UnfoldArg.unfold_second_arg -----------   0.4%   3.0%       2    1.576s
+─tac -----------------------------------   2.1%   3.0%       2    1.564s
+─ClearAll.clear_all --------------------   0.2%   2.8%       7    0.584s
+─ChangeInAll.change_with_compute_in_all    0.0%   2.6%     221    0.012s
+─change c with c' in * -----------------   2.5%   2.5%     221    0.012s
+─Reify.do_reify_abs_goal ---------------   2.4%   2.5%       2    1.276s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─synthesize_xzladderstep ---------------   0.0% 100.0%       1   52.080s
+â””Pipeline.refine_reflectively_gen ------   0.0%  98.5%       1   51.320s
+ ├─ReflectiveTactics.do_reflective_pipel   0.0%  93.8%       1   48.872s
+ │└ReflectiveTactics.solve_side_conditio   0.0%  93.7%       1   48.776s
+ │ ├─ReflectiveTactics.solve_post_reifie   0.2%  56.5%       1   29.412s
+ │ │ ├─UnifyAbstractReflexivity.unify_tr  44.7%  49.1%       7    6.968s
+ │ │ │└ClearAll.clear_all --------------   0.2%   2.8%       7    0.584s
+ │ │ │└clear (var_list) ----------------   2.7%   2.7%      65    0.584s
+ │ │ └─ReflectiveTactics.unify_abstract_   4.7%   6.4%       1    3.336s
+ │ └─ReflectiveTactics.do_reify --------   0.0%  37.2%       1   19.364s
+ │   ├─Reify.Reify_rhs_gen -------------   2.1%  23.4%       1   12.200s
+ │   │ ├─rewrite H ---------------------   7.3%   7.3%       1    3.816s
+ │   │ ├─Reify.transitivity_tt ---------   0.1%   3.7%       2    0.984s
+ │   │ │└transitivity ------------------   3.4%   3.4%       4    0.880s
+ │   │ ├─tac ---------------------------   2.1%   3.0%       1    1.564s
+ │   │ └─Reify.do_reify_abs_goal -------   2.4%   2.5%       2    1.276s
+ │   │  └Reify.do_reifyf_goal ----------   2.2%   2.2%      25    1.148s
+ │   ├─Compilers.Reify.reify_context_var   0.1%   9.2%       1    4.808s
+ │   │└Reify.do_reifyf_goal ------------   9.0%   9.1%     113    1.884s
+ │   │└eexact --------------------------   2.4%   2.4%     113    0.032s
+ │   └─UnfoldArg.unfold_second_arg -----   0.4%   3.0%       2    1.576s
+ │    └ChangeInAll.change_with_compute_i   0.0%   2.6%     221    0.012s
+ │    └change c with c' in * -----------   2.5%   2.5%     221    0.012s
+ └─Glue.refine_to_reflective_glue' -----   0.0%   4.7%       1    2.448s
+  â””Glue.zrange_to_reflective -----------   0.0%   4.0%       1    2.068s
+  â””Glue.zrange_to_reflective_goal ------   2.4%   3.3%       1    1.728s
+
+src/Specific/X25519/C64/ladderstep (real: 256.77, user: 241.34, sys: 0.45, mem: 1617000 ko)
+COQC src/Specific/X25519/C64/ladderstepDisplay > src/Specific/X25519/C64/ladderstepDisplay.log
diff --git a/test-suite/coq-makefile/timing/precomputed-time-tests/run.sh b/test-suite/coq-makefile/timing/precomputed-time-tests/run.sh
new file mode 100755
index 000000000..a918cceb6
--- /dev/null
+++ b/test-suite/coq-makefile/timing/precomputed-time-tests/run.sh
@@ -0,0 +1,10 @@
+#!/usr/bin/env bash
+
+set -x
+set -e
+
+cd "$(dirname "${BASH_SOURCE[0]}")"
+export COQLIB="$(cd ../../../.. && pwd)"
+
+./001-correct-diff-sorting-order/run.sh || exit $?
+./002-single-file-sorting/run.sh || exit $?
diff --git a/test-suite/coq-makefile/timing/run.sh b/test-suite/coq-makefile/timing/run.sh
index 9786af10a..aa6b0a9a4 100755
--- a/test-suite/coq-makefile/timing/run.sh
+++ b/test-suite/coq-makefile/timing/run.sh
@@ -3,9 +3,12 @@
 #set -x
 set -e
 
-. ../template/init.sh
+. ../template/path-init.sh
 
-cd error
+cd precomputed-time-tests
+./run.sh || exit $?
+
+cd ../error
 coq_makefile -f _CoqProject -o Makefile
 make cleanall
 if make pretty-timed TGTS="all" -j1; then
@@ -28,16 +31,42 @@ coq_makefile -f _CoqProject -o Makefile
 make cleanall
 make make-pretty-timed-after TGTS="all" -j1 || exit $?
 rm -f time-of-build-before.log
-make print-pretty-timed-diff TIME_OF_BUILD_BEFORE_FILE=../before/time-of-build-before.log
+make print-pretty-timed-diff TIMING_SORT_BY=diff TIME_OF_BUILD_BEFORE_FILE=../before/time-of-build-before.log
 cp ../before/time-of-build-before.log ./
-make print-pretty-timed-diff || exit $?
+make print-pretty-timed-diff TIMING_SORT_BY=diff || exit $?
+
+INFINITY="∞"
+INFINITY_REPLACEMENT="+.%" # assume that if the before time is zero, we expected the time to increase
+
+TO_SED_IN_BOTH=(
+    -e s"/${INFINITY}/${INFINITY_REPLACEMENT}/g" # Whether or not something shows up as ∞ depends on whether a time registers as 0.s or as 0.001s, so we can't rely on this being consistent
+    -e s":|\s*N/A\s*$:| ${INFINITY_REPLACEMENT}:g" # Whether or not something shows up as N/A depends on whether a time registers as 0.s or as 0.001s, so we can't rely on this being consistent
+    -e s'/ *$//g' # the number of trailing spaces depends on how many digits percentages end up being; since this varies across runs, we remove trailing spaces
+    -e s'/[0-9]*\.[0-9]*//g' # the precise timing numbers vary, so we strip them out
+    -e s'/^-*$/------/g' # When none of the numbers get over 100 (or 1000, in per-file), the width of the table is different, so we normalize the number of dashes for table separators
+)
+
+TO_SED_IN_PER_FILE=(
+    -e s'/[0-9]//g' # unclear whether this is actually needed above and beyond s'/[0-9]*\.[0-9]*//g'; it's been here from the start
+    -e s'/  */ /g' # unclear whether this is actually needed for per-file timing; it's been here from the start
+    -e s'/\(Total.*\)-\(.*\)-/\1+\2+/g' # Overall time in the per-file timing diff should be around 0; if it comes out negative, we remove the sign
+)
+
+TO_SED_IN_PER_LINE=(
+    -e s'/0//g' # unclear whether this is actually needed above and beyond s'/[0-9]*\.[0-9]*//g'; it's been here from the start
+    -e s'/  */ /g' # Sometimes 0 will show up as 0m00.s, sometimes it'll end up being more like 0m00.001s; we must strip out the spaces that result from left-aligning numbers of different widths based on how many digits Coq's [-time] gives
+    -e s'/+/-/g' # some code lines don't really change, but this can show up as either -0m00.01s or +0m00.01s, so we need to normalize the signs
+    )
 
 for ext in "" .desired; do
     for file in time-of-build-before.log time-of-build-after.log time-of-build-both.log; do
-	cat ${file}${ext} | grep -v 'warning: undefined variable' | sed s'/[0-9]//g' | sed s'/ *$//g' | sed s'/^-*$/------/g' | sed s'/  */ /g' | sed s'/\(Total.*\)-\(.*\)-/\1+\2+/g' > ${file}${ext}.processed
+        cat ${file}${ext} | grep -v 'warning: undefined variable' | sed "${TO_SED_IN_BOTH[@]}" "${TO_SED_IN_PER_FILE[@]}" > ${file}${ext}.processed
     done
 done
 for file in time-of-build-before.log time-of-build-after.log time-of-build-both.log; do
+    echo "cat $file"
+    cat "$file"
+    echo
     diff -u $file.desired.processed $file.processed || exit $?
 done
 
@@ -53,12 +82,19 @@ make all TIMING=after -j2 || exit $?
 
 find ../per-file-before/ -name "*.before-timing" -exec 'cp' '{}' './' ';'
 make all.timing.diff -j2 || exit $?
+echo "cat A.v.before-timing"
+cat A.v.before-timing
+echo
+echo "cat A.v.after-timing"
+cat A.v.after-timing
+echo
+echo "cat A.v.timing.diff"
 cat A.v.timing.diff
 echo
 
 for ext in "" .desired; do
     for file in A.v.timing.diff; do
-	cat ${file}${ext} | sed s'/[0-9]*\.[0-9]*//g' | sed s'/0//g' | sed s'/  */ /g' | sed s'/+/-/g' | sort > ${file}${ext}.processed
+        cat ${file}${ext} | sed "${TO_SED_IN_BOTH[@]}" "${TO_SED_IN_PER_LINE[@]}" | sort > ${file}${ext}.processed
     done
 done
 for file in A.v.timing.diff; do
diff --git a/test-suite/coq-makefile/vio2vo/_CoqProject b/test-suite/coq-makefile/vio2vo/_CoqProject
new file mode 100644
index 000000000..69f47302e
--- /dev/null
+++ b/test-suite/coq-makefile/vio2vo/_CoqProject
@@ -0,0 +1,10 @@
+-R src test
+-R theories test
+-I src
+
+src/test_plugin.mlpack
+src/test.ml4
+src/test.mli
+src/test_aux.ml
+src/test_aux.mli
+theories/test.v
diff --git a/test-suite/coq-makefile/vio2vo/run.sh b/test-suite/coq-makefile/vio2vo/run.sh
new file mode 100755
index 000000000..85656da41
--- /dev/null
+++ b/test-suite/coq-makefile/vio2vo/run.sh
@@ -0,0 +1,13 @@
+#!/usr/bin/env bash
+a=`uname`
+
+. ../template/init.sh
+
+coq_makefile -f _CoqProject -o Makefile
+make quick
+# vio2vo is broken on Windows (#6720)
+if [ "$a" = "Darwin" -o "$a" = "Linux" ]; then
+    make vio2vo J=2
+    test -f theories/test.vo
+    make validate
+fi
diff --git a/test-suite/coqchk/cumulativity.v b/test-suite/coqchk/cumulativity.v
index 7906a5b15..d63a3548e 100644
--- a/test-suite/coqchk/cumulativity.v
+++ b/test-suite/coqchk/cumulativity.v
@@ -64,4 +64,4 @@ I disable these tests because cqochk can't process them when compiled with
 
 (*   Inductive TP2 := tp2 : Type@{i} -> Type@{j} -> TP2. *)
 
-(* End subtyping_test. *)
\ No newline at end of file
+(* End subtyping_test. *)
diff --git a/test-suite/coqchk/include.v b/test-suite/coqchk/include.v
new file mode 100644
index 000000000..6232c1b80
--- /dev/null
+++ b/test-suite/coqchk/include.v
@@ -0,0 +1,11 @@
+(* See https://github.com/coq/coq/issues/5747 *)
+Module Type S.
+End S.
+
+Module N.
+Inductive I := .
+End N.
+
+Module M : S.
+  Include N.
+End M.
diff --git a/test-suite/coqchk/primproj2.v b/test-suite/coqchk/primproj2.v
new file mode 100644
index 000000000..f73c627ee
--- /dev/null
+++ b/test-suite/coqchk/primproj2.v
@@ -0,0 +1,10 @@
+Set Primitive Projections.
+
+Record Pack (A : Type) := pack { unpack : A }.
+
+Definition p : Pack bool.
+Proof.
+refine (pack _ true).
+Qed.
+
+Definition boom : unpack bool p = let u := unpack _ in u p := eq_refl.
diff --git a/test-suite/coqdoc/bug5648.html.out b/test-suite/coqdoc/bug5648.html.out
index 06789c1c1..5c5a2dc29 100644
--- a/test-suite/coqdoc/bug5648.html.out
+++ b/test-suite/coqdoc/bug5648.html.out
@@ -2,7 +2,7 @@
 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
 <html xmlns="http://www.w3.org/1999/xhtml">
 <head>
-<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
 <link href="coqdoc.css" rel="stylesheet" type="text/css" />
 <title>Coqdoc.bug5648</title>
 </head>
@@ -31,14 +31,14 @@
 <br/>
 <span class="id" title="keyword">Definition</span> <a name="d"><span class="id" title="definition">d</span></a> <span class="id" title="var">x</span> :=<br/>
 &nbsp;&nbsp;<span class="id" title="keyword">match</span> <a class="idref" href="Coqdoc.bug5648.html#x"><span class="id" title="variable">x</span></a> <span class="id" title="keyword">with</span><br/>
-&nbsp;&nbsp;| <a class="idref" href="Coqdoc.bug5648.html#A"><span class="id" title="constructor">A</span></a> =&gt; 0<br/>
-&nbsp;&nbsp;| <a class="idref" href="Coqdoc.bug5648.html#Add"><span class="id" title="constructor">Add</span></a> =&gt; 1<br/>
-&nbsp;&nbsp;| <a class="idref" href="Coqdoc.bug5648.html#G"><span class="id" title="constructor">G</span></a> =&gt; 2<br/>
-&nbsp;&nbsp;| <a class="idref" href="Coqdoc.bug5648.html#Goal"><span class="id" title="constructor">Goal</span></a> =&gt; 3<br/>
-&nbsp;&nbsp;| <a class="idref" href="Coqdoc.bug5648.html#L"><span class="id" title="constructor">L</span></a> =&gt; 4<br/>
-&nbsp;&nbsp;| <a class="idref" href="Coqdoc.bug5648.html#Lemma"><span class="id" title="constructor">Lemma</span></a> =&gt; 5<br/>
-&nbsp;&nbsp;| <a class="idref" href="Coqdoc.bug5648.html#P"><span class="id" title="constructor">P</span></a> =&gt; 6<br/>
-&nbsp;&nbsp;| <a class="idref" href="Coqdoc.bug5648.html#Proof"><span class="id" title="constructor">Proof</span></a> =&gt; 7<br/>
+&nbsp;&nbsp;| <a class="idref" href="Coqdoc.bug5648.html#A"><span class="id" title="constructor">A</span></a> ⇒ 0<br/>
+&nbsp;&nbsp;| <a class="idref" href="Coqdoc.bug5648.html#Add"><span class="id" title="constructor">Add</span></a> ⇒ 1<br/>
+&nbsp;&nbsp;| <a class="idref" href="Coqdoc.bug5648.html#G"><span class="id" title="constructor">G</span></a> ⇒ 2<br/>
+&nbsp;&nbsp;| <a class="idref" href="Coqdoc.bug5648.html#Goal"><span class="id" title="constructor">Goal</span></a> ⇒ 3<br/>
+&nbsp;&nbsp;| <a class="idref" href="Coqdoc.bug5648.html#L"><span class="id" title="constructor">L</span></a> ⇒ 4<br/>
+&nbsp;&nbsp;| <a class="idref" href="Coqdoc.bug5648.html#Lemma"><span class="id" title="constructor">Lemma</span></a> ⇒ 5<br/>
+&nbsp;&nbsp;| <a class="idref" href="Coqdoc.bug5648.html#P"><span class="id" title="constructor">P</span></a> ⇒ 6<br/>
+&nbsp;&nbsp;| <a class="idref" href="Coqdoc.bug5648.html#Proof"><span class="id" title="constructor">Proof</span></a> ⇒ 7<br/>
 &nbsp;&nbsp;<span class="id" title="keyword">end</span>.<br/>
 </div>
 </div>
diff --git a/test-suite/coqdoc/bug5648.tex.out b/test-suite/coqdoc/bug5648.tex.out
index b0b732eff..82f7da230 100644
--- a/test-suite/coqdoc/bug5648.tex.out
+++ b/test-suite/coqdoc/bug5648.tex.out
@@ -1,5 +1,15 @@
 \documentclass[12pt]{report}
-\usepackage[]{inputenc}
+\usepackage[utf8x]{inputenc}
+
+%Warning: tipa declares many non-standard macros used by utf8x to
+%interpret utf8 characters but extra packages might have to be added
+%such as "textgreek" for Greek letters not already in tipa
+%or "stmaryrd" for mathematical symbols.
+%Utf8 codes missing a LaTeX interpretation can be defined by using
+%\DeclareUnicodeCharacter{code}{interpretation}.
+%Use coqdoc's option -p to add new packages or declarations.
+\usepackage{tipa}
+
 \usepackage[T1]{fontenc}
 \usepackage{fullpage}
 \usepackage{coqdoc}
diff --git a/test-suite/coqdoc/bug5700.html.out b/test-suite/coqdoc/bug5700.html.out
new file mode 100644
index 000000000..b96fc6281
--- /dev/null
+++ b/test-suite/coqdoc/bug5700.html.out
@@ -0,0 +1,50 @@
+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
+"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
+<html xmlns="http://www.w3.org/1999/xhtml">
+<head>
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
+<link href="coqdoc.css" rel="stylesheet" type="text/css" />
+<title>Coqdoc.bug5700</title>
+</head>
+
+<body>
+
+<div id="page">
+
+<div id="header">
+</div>
+
+<div id="main">
+
+<h1 class="libtitle">Library Coqdoc.bug5700</h1>
+
+<div class="code">
+</div>
+
+<div class="doc">
+<pre>foo (* bar *) </pre>
+ 
+</div>
+<div class="code">
+<span class="id" title="keyword">Definition</span> <a name="const1"><span class="id" title="definition">const1</span></a> := 1.<br/>
+
+<br/>
+</div>
+
+<div class="doc">
+<pre>more (* nested (* comments *) within verbatim *) </pre>
+ 
+</div>
+<div class="code">
+<span class="id" title="keyword">Definition</span> <a name="const2"><span class="id" title="definition">const2</span></a> := 2.<br/>
+</div>
+</div>
+
+<div id="footer">
+<hr/><a href="index.html">Index</a><hr/>This page has been generated by <a href="http://coq.inria.fr/">coqdoc</a>
+</div>
+
+</div>
+
+</body>
+</html>
\ No newline at end of file
diff --git a/test-suite/coqdoc/bug5700.tex.out b/test-suite/coqdoc/bug5700.tex.out
new file mode 100644
index 000000000..1a1af5dfd
--- /dev/null
+++ b/test-suite/coqdoc/bug5700.tex.out
@@ -0,0 +1,34 @@
+\documentclass[12pt]{report}
+\usepackage[utf8x]{inputenc}
+
+%Warning: tipa declares many non-standard macros used by utf8x to
+%interpret utf8 characters but extra packages might have to be added
+%such as "textgreek" for Greek letters not already in tipa
+%or "stmaryrd" for mathematical symbols.
+%Utf8 codes missing a LaTeX interpretation can be defined by using
+%\DeclareUnicodeCharacter{code}{interpretation}.
+%Use coqdoc's option -p to add new packages or declarations.
+\usepackage{tipa}
+
+\usepackage[T1]{fontenc}
+\usepackage{fullpage}
+\usepackage{coqdoc}
+\usepackage{amsmath,amssymb}
+\usepackage{url}
+\begin{document}
+\coqlibrary{Coqdoc.bug5700}{Library }{Coqdoc.bug5700}
+
+\begin{coqdoccode}
+\end{coqdoccode}
+\begin{verbatim}foo (* bar *) \end{verbatim}
+ \begin{coqdoccode}
+\coqdocnoindent
+\coqdockw{Definition} \coqdef{Coqdoc.bug5700.const1}{const1}{\coqdocdefinition{const1}} := 1.\coqdoceol
+\coqdocemptyline
+\end{coqdoccode}
+\begin{verbatim}more (* nested (* comments *) within verbatim *) \end{verbatim}
+ \begin{coqdoccode}
+\coqdocnoindent
+\coqdockw{Definition} \coqdef{Coqdoc.bug5700.const2}{const2}{\coqdocdefinition{const2}} := 2.\coqdoceol
+\end{coqdoccode}
+\end{document}
diff --git a/test-suite/coqdoc/bug5700.v b/test-suite/coqdoc/bug5700.v
new file mode 100644
index 000000000..839034a48
--- /dev/null
+++ b/test-suite/coqdoc/bug5700.v
@@ -0,0 +1,5 @@
+(** << foo (* bar *) >> *)
+Definition const1 := 1.
+
+(** << more (* nested (* comments *) within verbatim *) >> *)
+Definition const2 := 2.
diff --git a/test-suite/coqdoc/links.html.out b/test-suite/coqdoc/links.html.out
index 7d7d01c1b..5e4b676c2 100644
--- a/test-suite/coqdoc/links.html.out
+++ b/test-suite/coqdoc/links.html.out
@@ -2,7 +2,7 @@
 "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
 <html xmlns="http://www.w3.org/1999/xhtml">
 <head>
-<meta http-equiv="Content-Type" content="text/html; charset=iso-8859-1" />
+<meta http-equiv="Content-Type" content="text/html; charset=utf-8" />
 <link href="coqdoc.css" rel="stylesheet" type="text/css" />
 <title>Coqdoc.links</title>
 </head>
@@ -57,7 +57,7 @@ Various checks for coqdoc
 <span class="id" title="keyword">Definition</span> <a name="a"><span class="id" title="definition">a</span></a> (<span class="id" title="var">b</span>: <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>) := <a class="idref" href="Coqdoc.links.html#b"><span class="id" title="variable">b</span></a>.<br/>
 
 <br/>
-<span class="id" title="keyword">Definition</span> <a name="f"><span class="id" title="definition">f</span></a> := <span class="id" title="keyword">forall</span> <span class="id" title="var">C</span>:<span class="id" title="keyword">Prop</span>, <a class="idref" href="Coqdoc.links.html#C"><span class="id" title="variable">C</span></a>.<br/>
+<span class="id" title="keyword">Definition</span> <a name="f"><span class="id" title="definition">f</span></a> := <span class="id" title="keyword">∀</span> <span class="id" title="var">C</span>:<span class="id" title="keyword">Prop</span>, <a class="idref" href="Coqdoc.links.html#C"><span class="id" title="variable">C</span></a>.<br/>
 
 <br/>
 <span class="id" title="keyword">Notation</span> <a name="1a1c7f13320341c3638e9edcc3e6389d"><span class="id" title="notation">&quot;</span></a>n ++ m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>).<br/>
@@ -74,9 +74,9 @@ Various checks for coqdoc
 <span class="id" title="keyword">Notation</span> <a name="347f39a83bf7d45676cff54fd7e8966f"><span class="id" title="notation">&quot;</span></a>n '_' ++ 'x' m" := (<a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Peano.html#plus"><span class="id" title="abbreviation">plus</span></a> <span class="id" title="var">n</span> <span class="id" title="var">m</span>) (<span class="id" title="tactic">at</span> <span class="id" title="keyword">level</span> 3).<br/>
 
 <br/>
-<span class="id" title="keyword">Inductive</span> <a name="eq"><span class="id" title="inductive">eq</span></a> (<span class="id" title="var">A</span>:<span class="id" title="keyword">Type</span>) (<span class="id" title="var">x</span>:<a class="idref" href="Coqdoc.links.html#A"><span class="id" title="variable">A</span></a>) : <span class="id" title="var">A</span> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#d43e996736952df71ebeeae74d10a287"><span class="id" title="notation">-&gt;</span></a> <span class="id" title="keyword">Prop</span> := <a name="eq_refl"><span class="id" title="constructor">eq_refl</span></a> : <a class="idref" href="Coqdoc.links.html#x"><span class="id" title="variable">x</span></a> <a class="idref" href="Coqdoc.links.html#8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">=</span></a> <a class="idref" href="Coqdoc.links.html#x"><span class="id" title="variable">x</span></a> <a class="idref" href="Coqdoc.links.html#8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">:&gt;</span></a><a class="idref" href="Coqdoc.links.html#A"><span class="id" title="variable">A</span></a><br/>
+<span class="id" title="keyword">Inductive</span> <a name="eq"><span class="id" title="inductive">eq</span></a> (<span class="id" title="var">A</span>:<span class="id" title="keyword">Type</span>) (<span class="id" title="var">x</span>:<a class="idref" href="Coqdoc.links.html#A"><span class="id" title="variable">A</span></a>) : <span class="id" title="var">A</span> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Logic.html#d43e996736952df71ebeeae74d10a287"><span class="id" title="notation">→</span></a> <span class="id" title="keyword">Prop</span> := <a name="eq_refl"><span class="id" title="constructor">eq_refl</span></a> : <a class="idref" href="Coqdoc.links.html#x"><span class="id" title="variable">x</span></a> <a class="idref" href="Coqdoc.links.html#8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">=</span></a> <a class="idref" href="Coqdoc.links.html#x"><span class="id" title="variable">x</span></a> <a class="idref" href="Coqdoc.links.html#8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">:&gt;</span></a><a class="idref" href="Coqdoc.links.html#A"><span class="id" title="variable">A</span></a><br/>
 <br/>
-<span class="id" title="keyword">where</span> <a name="8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">&quot;</span></a>x = y :&gt; A" := (@<a class="idref" href="Coqdoc.links.html#eq"><span class="id" title="variable">eq</span></a> <span class="id" title="var">A</span> <span class="id" title="var">x</span> <span class="id" title="var">y</span>) : <span class="id" title="var">type_scope</span>.<br/>
+<span class="id" title="keyword">where</span> <a name="8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">&quot;</span></a>x = y :&gt; A" := (@<a class="idref" href="Coqdoc.links.html#eq"><span class="id" title="inductive">eq</span></a> <span class="id" title="var">A</span> <span class="id" title="var">x</span> <span class="id" title="var">y</span>) : <span class="id" title="var">type_scope</span>.<br/>
 
 <br/>
 <span class="id" title="keyword">Definition</span> <a name="eq0"><span class="id" title="definition">eq0</span></a> := 0 <a class="idref" href="Coqdoc.links.html#8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">=</span></a> 0 <a class="idref" href="Coqdoc.links.html#8f9364556521ebb498093f28eea2240f"><span class="id" title="notation">:&gt;</span></a> <a class="idref" href="http://coq.inria.fr/stdlib/Coq.Init.Datatypes.html#nat"><span class="id" title="inductive">nat</span></a>.<br/>
diff --git a/test-suite/coqdoc/links.tex.out b/test-suite/coqdoc/links.tex.out
index 844fb3031..f42db99dc 100644
--- a/test-suite/coqdoc/links.tex.out
+++ b/test-suite/coqdoc/links.tex.out
@@ -1,5 +1,15 @@
 \documentclass[12pt]{report}
-\usepackage[]{inputenc}
+\usepackage[utf8x]{inputenc}
+
+%Warning: tipa declares many non-standard macros used by utf8x to
+%interpret utf8 characters but extra packages might have to be added
+%such as "textgreek" for Greek letters not already in tipa
+%or "stmaryrd" for mathematical symbols.
+%Utf8 codes missing a LaTeX interpretation can be defined by using
+%\DeclareUnicodeCharacter{code}{interpretation}.
+%Use coqdoc's option -p to add new packages or declarations.
+\usepackage{tipa}
+
 \usepackage[T1]{fontenc}
 \usepackage{fullpage}
 \usepackage{coqdoc}
@@ -59,7 +69,7 @@ Various checks for coqdoc
 \coqdocnoindent
 \coqdoceol
 \coqdocnoindent
-\coqdockw{where} \coqdef{Coqdoc.links.:type scope:x '=' x ':>' x}{"}{"}x = y :> A" := (@\coqdocvariable{eq} \coqdocvar{A} \coqdocvar{x} \coqdocvar{y}) : \coqdocvar{type\_scope}.\coqdoceol
+\coqdockw{where} \coqdef{Coqdoc.links.:type scope:x '=' x ':>' x}{"}{"}x = y :> A" := (@\coqref{Coqdoc.links.eq}{\coqdocinductive{eq}} \coqdocvar{A} \coqdocvar{x} \coqdocvar{y}) : \coqdocvar{type\_scope}.\coqdoceol
 \coqdocemptyline
 \coqdocnoindent
 \coqdockw{Definition} \coqdef{Coqdoc.links.eq0}{eq0}{\coqdocdefinition{eq0}} := 0 \coqref{Coqdoc.links.:type scope:x '=' x ':>' x}{\coqdocnotation{=}} 0 \coqref{Coqdoc.links.:type scope:x '=' x ':>' x}{\coqdocnotation{:>}} \coqexternalref{nat}{http://coq.inria.fr/stdlib/Coq.Init.Datatypes}{\coqdocinductive{nat}}.\coqdoceol
diff --git a/test-suite/coqwc/BZ5637.out b/test-suite/coqwc/BZ5637.out
new file mode 100644
index 000000000..f0b5e4f7e
--- /dev/null
+++ b/test-suite/coqwc/BZ5637.out
@@ -0,0 +1,2 @@
+     spec    proof comments
+        5        0        0 coqwc/BZ5637.v
diff --git a/test-suite/coqwc/BZ5637.v b/test-suite/coqwc/BZ5637.v
new file mode 100644
index 000000000..6428b10ff
--- /dev/null
+++ b/test-suite/coqwc/BZ5637.v
@@ -0,0 +1,5 @@
+Local Obligation Tactic := idtac.
+Definition a := 1.
+Definition b := 1.
+Definition c := 1.
+Definition d := 1.
diff --git a/test-suite/coqwc/BZ5756.out b/test-suite/coqwc/BZ5756.out
new file mode 100644
index 000000000..039d1e500
--- /dev/null
+++ b/test-suite/coqwc/BZ5756.out
@@ -0,0 +1,2 @@
+     spec    proof comments
+        3        0        2 coqwc/BZ5756.v
diff --git a/test-suite/coqwc/BZ5756.v b/test-suite/coqwc/BZ5756.v
new file mode 100644
index 000000000..ccb12076a
--- /dev/null
+++ b/test-suite/coqwc/BZ5756.v
@@ -0,0 +1,3 @@
+Definition myNextValue := 0. (* OK *)
+Definition x := myNextValue. (* not OK *)
+Definition y := 0.
diff --git a/test-suite/coqwc/false.out b/test-suite/coqwc/false.out
new file mode 100644
index 000000000..14c5713f6
--- /dev/null
+++ b/test-suite/coqwc/false.out
@@ -0,0 +1,2 @@
+     spec    proof comments
+        3        3        1 coqwc/false.v
diff --git a/test-suite/coqwc/false.v b/test-suite/coqwc/false.v
new file mode 100644
index 000000000..640f9ea7f
--- /dev/null
+++ b/test-suite/coqwc/false.v
@@ -0,0 +1,8 @@
+Axiom x : nat.
+
+Definition foo (x : nat) := x + 1.
+
+Lemma bar : False.
+ idtac.
+ idtac. (* truth is overrated *)
+Admitted.
diff --git a/test-suite/coqwc/next-obligation.out b/test-suite/coqwc/next-obligation.out
new file mode 100644
index 000000000..7a0fd777c
--- /dev/null
+++ b/test-suite/coqwc/next-obligation.out
@@ -0,0 +1,2 @@
+     spec    proof comments
+        1        7        0 coqwc/next-obligation.v
diff --git a/test-suite/coqwc/next-obligation.v b/test-suite/coqwc/next-obligation.v
new file mode 100644
index 000000000..786df9891
--- /dev/null
+++ b/test-suite/coqwc/next-obligation.v
@@ -0,0 +1,10 @@
+(* make sure all proof lines are counted *)
+
+Goal True. 
+  Next Obligation.
+  idtac.
+  Next Obligation.
+  idtac.
+  Next Obligation.
+  idtac.
+Qed.  
diff --git a/test-suite/coqwc/theorem.out b/test-suite/coqwc/theorem.out
new file mode 100644
index 000000000..d01507bf7
--- /dev/null
+++ b/test-suite/coqwc/theorem.out
@@ -0,0 +1,2 @@
+     spec    proof comments
+        1        9        2 coqwc/theorem.v
diff --git a/test-suite/coqwc/theorem.v b/test-suite/coqwc/theorem.v
new file mode 100644
index 000000000..901c9074f
--- /dev/null
+++ b/test-suite/coqwc/theorem.v
@@ -0,0 +1,10 @@
+Theorem foo : True.
+Proof.
+  idtac. (* comment *)
+  idtac.
+  idtac.
+  idtac. (* comment *)
+  idtac.
+  idtac.
+  auto.
+Qed.
diff --git a/test-suite/failure/circular_subtyping.v b/test-suite/failure/circular_subtyping.v
index ceccd4607..9eb7e3bc2 100644
--- a/test-suite/failure/circular_subtyping.v
+++ b/test-suite/failure/circular_subtyping.v
@@ -7,4 +7,4 @@ Module NN <: T. Module M:=N. End NN.
 Fail Module P <: T with Module M:=NN := NN.
 
 Module F (X:S) (Y:T with Module M:=X). End F.
-Fail Module G := F N N.
\ No newline at end of file
+Fail Module G := F N N.
diff --git a/test-suite/failure/cofixpoint.v b/test-suite/failure/cofixpoint.v
index cb39893f4..d193dc484 100644
--- a/test-suite/failure/cofixpoint.v
+++ b/test-suite/failure/cofixpoint.v
@@ -12,4 +12,4 @@ Fail CoFixpoint loop : CoFalse :=
   (cofix f := I with g := loop for g).
 
 Fail CoFixpoint loop : CoFalse :=
-  (cofix f := loop with g := I for f).
\ No newline at end of file
+  (cofix f := loop with g := I for f).
diff --git a/test-suite/failure/guard-cofix.v b/test-suite/failure/guard-cofix.v
index eda4a1867..3ae877054 100644
--- a/test-suite/failure/guard-cofix.v
+++ b/test-suite/failure/guard-cofix.v
@@ -40,4 +40,4 @@ Fail CoFixpoint loop' : CoFalse :=
     Omega match eq_sym H in _ = T return T with eq_refl => loop' end
   end.
 
-Fail Definition ff' : False := match loop' with CF _ t => t end.
\ No newline at end of file
+Fail Definition ff' : False := match loop' with CF _ t => t end.
diff --git a/test-suite/failure/sortelim.v b/test-suite/failure/sortelim.v
index 2b3cf1066..3d2eef6a9 100644
--- a/test-suite/failure/sortelim.v
+++ b/test-suite/failure/sortelim.v
@@ -146,4 +146,4 @@ Qed.
 
 Print Assumptions pandora.
 
-*)
\ No newline at end of file
+*)
diff --git a/test-suite/ideal-features/complexity/evars_subst.v b/test-suite/ideal-features/complexity/evars_subst.v
index b3dfb33cd..b9c359888 100644
--- a/test-suite/ideal-features/complexity/evars_subst.v
+++ b/test-suite/ideal-features/complexity/evars_subst.v
@@ -1,4 +1,4 @@
-(* Bug report #932 *)
+(* BZ#932 *)
 (* Expected time < 1.00s *)
 
 (* Let n be the number of let-in. The complexity comes from the fact
diff --git a/test-suite/ideal-features/evars_subst.v b/test-suite/ideal-features/evars_subst.v
index b3dfb33cd..b9c359888 100644
--- a/test-suite/ideal-features/evars_subst.v
+++ b/test-suite/ideal-features/evars_subst.v
@@ -1,4 +1,4 @@
-(* Bug report #932 *)
+(* BZ#932 *)
 (* Expected time < 1.00s *)
 
 (* Let n be the number of let-in. The complexity comes from the fact
diff --git a/test-suite/ideal-features/implicit_binders.v b/test-suite/ideal-features/implicit_binders.v
index 2ec727808..d75620c25 100644
--- a/test-suite/ideal-features/implicit_binders.v
+++ b/test-suite/ideal-features/implicit_binders.v
@@ -121,4 +121,4 @@ Definition qux� {( F : `(SomeStruct a) )} : nat := 0.
 (** *** Questions
    - Autres propositions de syntaxe ?
    - Réactions sur la construction ?
-   *)
\ No newline at end of file
+   *)
diff --git a/test-suite/interactive/Back.v b/test-suite/interactive/Back.v
index b813a79ab..22364254d 100644
--- a/test-suite/interactive/Back.v
+++ b/test-suite/interactive/Back.v
@@ -1,5 +1,5 @@
 (* Check that reset remains synchronised with the compilation unit cache *)
-(* See bug #1030 *)
+(* See BZ#1030 *)
 
 Section multiset_defs.
   Require Import Plus.
diff --git a/test-suite/interactive/ParalITP.v b/test-suite/interactive/ParalITP.v
index a96d4a5c7..7fab2a58e 100644
--- a/test-suite/interactive/ParalITP.v
+++ b/test-suite/interactive/ParalITP.v
@@ -44,4 +44,4 @@ split.
 exact a.
 Qed.
 
-End Demo.
\ No newline at end of file
+End Demo.
diff --git a/test-suite/interactive/proof_block.v b/test-suite/interactive/proof_block.v
index 31e349376..a865632e8 100644
--- a/test-suite/interactive/proof_block.v
+++ b/test-suite/interactive/proof_block.v
@@ -63,4 +63,4 @@ split. split. split.
  - solve [ trivial ].
  - solve [ trivial ].
  - exact 6.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/misc/deps-utf8.sh b/test-suite/misc/deps-utf8.sh
new file mode 100755
index 000000000..13e264c09
--- /dev/null
+++ b/test-suite/misc/deps-utf8.sh
@@ -0,0 +1,17 @@
+# Check reading directories matching non pure ascii idents
+# See bug #5715 (utf-8 working on macos X and linux)
+# Windows is still not compliant
+a=`uname`
+if [ "$a" = "Darwin" -o "$a" = "Linux" ]; then
+rm -f misc/deps/théorèmes/*.v
+tmpoutput=`mktemp /tmp/coqcheck.XXXXXX`
+$coqc -R misc/deps AlphaBêta misc/deps/αβ/γδ.v
+R=$?
+$coqtop -R misc/deps AlphaBêta -load-vernac-source misc/deps/αβ/εζ.v
+S=$?
+if [ $R = 0 -a $S = 0 ]; then
+    exit 0
+else
+    exit 1
+fi
+fi
diff --git a/test-suite/misc/deps/αβ/γδ.v b/test-suite/misc/deps/αβ/γδ.v
new file mode 100644
index 000000000..f43a2d657
--- /dev/null
+++ b/test-suite/misc/deps/αβ/γδ.v
@@ -0,0 +1,4 @@
+Theorem simple : forall A, A -> A.
+Proof.
+auto.
+Qed.
diff --git a/test-suite/misc/deps/αβ/εζ.v b/test-suite/misc/deps/αβ/εζ.v
new file mode 100644
index 000000000..e7fd25c0d
--- /dev/null
+++ b/test-suite/misc/deps/αβ/εζ.v
@@ -0,0 +1 @@
+Require Import γδ.
diff --git a/test-suite/modules/Demo.v b/test-suite/modules/Demo.v
index 1f27fe1ba..820fda172 100644
--- a/test-suite/modules/Demo.v
+++ b/test-suite/modules/Demo.v
@@ -52,4 +52,4 @@ Print N'''.x.
 
 Import N'''.
 
-Print t.
\ No newline at end of file
+Print t.
diff --git a/test-suite/modules/Nat.v b/test-suite/modules/Nat.v
index 57878a5f1..d2116d218 100644
--- a/test-suite/modules/Nat.v
+++ b/test-suite/modules/Nat.v
@@ -16,4 +16,4 @@ Qed.
 
 Lemma le_antis : forall n m : nat, le n m -> le m n -> n = m.
    eauto with arith.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/modules/PO.v b/test-suite/modules/PO.v
index 6198f29a0..8ba8525c6 100644
--- a/test-suite/modules/PO.v
+++ b/test-suite/modules/PO.v
@@ -54,4 +54,4 @@ Module NN := Pair Nat Nat.
 
 Lemma zz_min : forall p : NN.T, NN.le (0, 0) p.
   info auto with arith.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/modules/SeveralWith.v b/test-suite/modules/SeveralWith.v
new file mode 100644
index 000000000..bbf72a764
--- /dev/null
+++ b/test-suite/modules/SeveralWith.v
@@ -0,0 +1,12 @@
+Module Type S.
+Parameter A : Type.
+End S.
+
+Module Type ES.
+Parameter A : Type.
+Parameter eq : A -> A -> Type.
+End ES.
+
+Module Make
+  (AX : S)
+  (X : ES with Definition A := AX.A with Definition eq := @eq AX.A).
diff --git a/test-suite/modules/Tescik.v b/test-suite/modules/Tescik.v
index 1d1b1e0ab..ea4955394 100644
--- a/test-suite/modules/Tescik.v
+++ b/test-suite/modules/Tescik.v
@@ -27,4 +27,4 @@ Module List (X: ELEM).
 
 End List.
 
-Module N := List Nat.
\ No newline at end of file
+Module N := List Nat.
diff --git a/test-suite/modules/cumpoly.v b/test-suite/modules/cumpoly.v
new file mode 100644
index 000000000..654b86cb4
--- /dev/null
+++ b/test-suite/modules/cumpoly.v
@@ -0,0 +1,19 @@
+Set Universe Polymorphism.
+
+(** Check that variance subtyping is respected. The signature T is asking for
+    invariance, while M provide an irrelevant implementation, which is deemed
+    legit.
+
+    There is currently no way to go the other way around, so it's not possible
+    to generate a counter-example that should fail with the wrong subtyping.
+*)
+
+Module Type T.
+Parameter t@{i|Set <= i} : Type@{i}.
+Cumulative Inductive I@{i|Set <= i} : Type@{i} := C : t@{i} -> I.
+End T.
+
+Module M : T.
+Definition t@{i|Set <= i} : Type@{i} := nat.
+Cumulative Inductive I@{i|Set <= i} : Type@{i} := C : t@{i} -> I.
+End M.
diff --git a/test-suite/modules/grammar.v b/test-suite/modules/grammar.v
index 9657c685d..11ad205e4 100644
--- a/test-suite/modules/grammar.v
+++ b/test-suite/modules/grammar.v
@@ -12,4 +12,4 @@ Check (f 0 0).
 Check (f 0 0).
 Import M.
 Check (f 0 0).
-Check (N.f 0 0).
\ No newline at end of file
+Check (N.f 0 0).
diff --git a/test-suite/modules/injection_discriminate_inversion.v b/test-suite/modules/injection_discriminate_inversion.v
index d4ac7b3a2..8b5969dd7 100644
--- a/test-suite/modules/injection_discriminate_inversion.v
+++ b/test-suite/modules/injection_discriminate_inversion.v
@@ -31,4 +31,4 @@ Goal forall x,  M.C x = M1.C 0 -> x = 0.
      par des modules differents
      *)
   inversion H. reflexivity.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/modules/modeq.v b/test-suite/modules/modeq.v
index 1238ee9de..c8129eec5 100644
--- a/test-suite/modules/modeq.v
+++ b/test-suite/modules/modeq.v
@@ -19,4 +19,4 @@ Module Z.
   Module N := M.
 End Z.
 
-Module A : SIG := Z.
\ No newline at end of file
+Module A : SIG := Z.
diff --git a/test-suite/modules/objects2.v b/test-suite/modules/objects2.v
index 220e2b369..0a6b1f06d 100644
--- a/test-suite/modules/objects2.v
+++ b/test-suite/modules/objects2.v
@@ -2,7 +2,7 @@
    the logical objects in the environment
 *)
 
-(* Bug #1118 (simplified version), submitted by Evelyne Contejean
+(* BZ#1118 (simplified version), submitted by Evelyne Contejean
   (used to failed in pre-V8.1 trunk because of a call to lookup_mind
    for structure objects)
 *)
diff --git a/test-suite/modules/pliczek.v b/test-suite/modules/pliczek.v
index f806a7c41..51f5f4007 100644
--- a/test-suite/modules/pliczek.v
+++ b/test-suite/modules/pliczek.v
@@ -1,3 +1,3 @@
 Require Export plik.
 
-Definition tutu (X : Set) := toto X.
\ No newline at end of file
+Definition tutu (X : Set) := toto X.
diff --git a/test-suite/modules/plik.v b/test-suite/modules/plik.v
index 50bfd9604..c2f0fe3ce 100644
--- a/test-suite/modules/plik.v
+++ b/test-suite/modules/plik.v
@@ -1,3 +1,3 @@
 Definition toto (x : Set) := x.
 
-(* <Warning> : Grammar is replaced by Notation *)
\ No newline at end of file
+(* <Warning> : Grammar is replaced by Notation *)
diff --git a/test-suite/modules/pseudo_circular_with.v b/test-suite/modules/pseudo_circular_with.v
index 9e46d17ed..6bf067fd1 100644
--- a/test-suite/modules/pseudo_circular_with.v
+++ b/test-suite/modules/pseudo_circular_with.v
@@ -3,4 +3,4 @@ Module Type T. Declare Module M:S. End T.
 Module N:S. End N.
 
 Module NN:T. Module M:=N. End NN.
-Module Type U := T with Module M:=NN.
\ No newline at end of file
+Module Type U := T with Module M:=NN.
diff --git a/test-suite/modules/sig.v b/test-suite/modules/sig.v
index da5d25fa2..fc936a515 100644
--- a/test-suite/modules/sig.v
+++ b/test-suite/modules/sig.v
@@ -26,4 +26,4 @@ Module Type SIG.
   Parameter x : T.
 End SIG.
 
-Module J : SIG := M.N.
\ No newline at end of file
+Module J : SIG := M.N.
diff --git a/test-suite/output-modulo-time/ltacprof.out b/test-suite/output-modulo-time/ltacprof.out
index cc04c2c9b..5553e1b38 100644
--- a/test-suite/output-modulo-time/ltacprof.out
+++ b/test-suite/output-modulo-time/ltacprof.out
@@ -1,12 +1,15 @@
-total time:      1.528s
+total time:      1.032s
 
- tactic                                   local  total   calls       max
+ tactic                                   local  total   calls       max 
 ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
-─sleep' -------------------------------- 100.0% 100.0%       1    1.528s
+─sleep' -------------------------------- 100.0% 100.0%       1    1.032s
+─sleep ---------------------------------   0.0%   0.0%       0    0.000s
 ─constructor ---------------------------   0.0%   0.0%       1    0.000s
 
- tactic                                   local  total   calls       max
+ tactic                                   local  total   calls       max 
 ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
-─sleep' -------------------------------- 100.0% 100.0%       1    1.528s
+─sleep' -------------------------------- 100.0% 100.0%       1    1.032s
+─sleep ---------------------------------   0.0%   0.0%       0    0.000s
+â””sleep' --------------------------------   0.0%   0.0%       0    0.000s
 ─constructor ---------------------------   0.0%   0.0%       1    0.000s
 
diff --git a/test-suite/output-modulo-time/ltacprof_abstract.out b/test-suite/output-modulo-time/ltacprof_abstract.out
new file mode 100644
index 000000000..fef4fa248
--- /dev/null
+++ b/test-suite/output-modulo-time/ltacprof_abstract.out
@@ -0,0 +1,17 @@
+total time:      0.922s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─abstract (sleep; constructor) ---------   0.0% 100.0%       1    0.922s
+─sleep' -------------------------------- 100.0% 100.0%       1    0.922s
+─constructor ---------------------------   0.0%   0.0%       1    0.000s
+─sleep ---------------------------------   0.0%   0.0%       0    0.000s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─abstract (sleep; constructor) ---------   0.0% 100.0%       1    0.922s
+ ├─sleep' ------------------------------ 100.0% 100.0%       1    0.922s
+ ├─constructor -------------------------   0.0%   0.0%       1    0.000s
+ └─sleep -------------------------------   0.0%   0.0%       0    0.000s
+  â””sleep' ------------------------------   0.0%   0.0%       0    0.000s
+
diff --git a/test-suite/output-modulo-time/ltacprof_abstract.v b/test-suite/output-modulo-time/ltacprof_abstract.v
new file mode 100644
index 000000000..10a76309e
--- /dev/null
+++ b/test-suite/output-modulo-time/ltacprof_abstract.v
@@ -0,0 +1,8 @@
+(* -*- coq-prog-args: ("-profile-ltac-cutoff" "0.0") -*- *)
+Ltac sleep' := do 100 (do 100 (do 100 idtac)).
+Ltac sleep := sleep'.
+
+Theorem x : True.
+Proof.
+  idtac. idtac. abstract (sleep; constructor).
+Defined.
diff --git a/test-suite/output-modulo-time/ltacprof_cutoff.out b/test-suite/output-modulo-time/ltacprof_cutoff.out
index 0cd5777cc..d91a38bb5 100644
--- a/test-suite/output-modulo-time/ltacprof_cutoff.out
+++ b/test-suite/output-modulo-time/ltacprof_cutoff.out
@@ -1,31 +1,37 @@
-total time:      1.584s
+total time:      1.632s
 
  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
+─sleep --------------------------------- 100.0% 100.0%       3    0.584s
+─foo2 ----------------------------------   0.0% 100.0%       1    1.632s
+─foo1 ----------------------------------   0.0%  64.2%       1    1.048s
 
  tactic                                   local  total   calls       max 
 ────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
-─foo2 ----------------------------------   0.0% 100.0%       1    1.584s
-â””foo1 ----------------------------------   0.0%  63.9%       1    1.012s
+─foo2 ----------------------------------   0.0% 100.0%       1    1.632s
+â””foo1 ----------------------------------   0.0%  64.2%       1    1.048s
 
-total time:      1.584s
+total time:      0.520s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─foo2 ----------------------------------   0.0% 100.0%       1    0.520s
+─sleep ---------------------------------  99.2%  99.2%      52    0.016s
+─foo1 ----------------------------------   0.0%  97.7%       1    0.508s
+─foo0 ----------------------------------   0.8%  96.2%       1    0.500s
+
+ tactic                                   local  total   calls       max 
+────────────────────────────────────────┴──────┴──────┴───────┴─────────┘
+─foo2 ----------------------------------   0.0% 100.0%       1    0.520s
+â””foo1 ----------------------------------   0.0%  97.7%       1    0.508s
+â””foo0 ----------------------------------   0.8%  96.2%       1    0.500s
+â””sleep ---------------------------------  95.4%  95.4%      50    0.016s
+
+total time:      0.000s
 
  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
index 3dad6271a..ae5d51bae 100644
--- a/test-suite/output-modulo-time/ltacprof_cutoff.v
+++ b/test-suite/output-modulo-time/ltacprof_cutoff.v
@@ -1,12 +1,28 @@
 (* -*- coq-prog-args: ("-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).
+Module WithIdTac.
+  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.
+  Ltac foo0 := idtac; sleep.
+  Ltac foo1 := sleep; foo0.
+  Ltac foo2 := sleep; foo1.
+  Goal True.
+    foo2.
+    Show Ltac Profile CutOff 47.
+    constructor.
+  Qed.
+End WithIdTac.
+
+Module TestEval.
+  Ltac sleep := let sleep := (eval vm_compute in Coq.ZArith.BinInt.Z.div_eucl) in idtac.
+
+  Ltac foo0 := idtac; do 50 (idtac; sleep).
+  Ltac foo1 := sleep; foo0.
+  Ltac foo2 := sleep; foo1.
+  Goal True.
+    Reset Ltac Profile.
+    foo2.
+    Show Ltac Profile CutOff 47.
+    constructor.
+  Qed.
+End TestEval.
diff --git a/test-suite/output/Cases.out b/test-suite/output/Cases.out
index 97fa8e254..419dcadb4 100644
--- a/test-suite/output/Cases.out
+++ b/test-suite/output/Cases.out
@@ -95,8 +95,7 @@ fun dd : nat * nat => let (bb, cc) as aa return (aa = aa) := dd in eq_refl
   
   x : nat
   n, n0 := match x + 0 with
-           | 0 => 0
-           | S _ => 0
+           | 0 | S _ => 0
            end : nat
   e,
   e0 := match x + 0 as y return (y = y) with
@@ -104,8 +103,7 @@ fun dd : nat * nat => let (bb, cc) as aa return (aa = aa) := dd in eq_refl
         | S n => eq_refl
         end : x + 0 = x + 0
   n1, n2 := match x with
-            | 0 => 0
-            | S _ => 0
+            | 0 | S _ => 0
             end : nat
   e1, e2 := match x return (x = x) with
             | 0 => eq_refl
@@ -126,3 +124,48 @@ fun dd : nat * nat => let (bb, cc) as aa return (aa = aa) := dd in eq_refl
         end : p = p /\ p = p
   ============================
   eq_refl = eq_refl
+fun x : comparison => match x with
+                      | Eq => 1
+                      | _ => 0
+                      end
+     : comparison -> nat
+fun x : comparison => match x with
+                      | Eq => 1
+                      | Lt => 0
+                      | Gt => 0
+                      end
+     : comparison -> nat
+fun x : comparison => match x with
+                      | Eq => 1
+                      | Lt | Gt => 0
+                      end
+     : comparison -> nat
+fun x : comparison =>
+match x return nat with
+| Eq => S O
+| Lt => O
+| Gt => O
+end
+     : forall _ : comparison, nat
+fun x : K => match x with
+             | a3 | a4 => 3
+             | _ => 2
+             end
+     : K -> nat
+fun x : K => match x with
+             | a1 | a2 => 4
+             | a3 => 3
+             | _ => 2
+             end
+     : K -> nat
+fun x : K => match x with
+             | a1 | a2 => 4
+             | a4 => 3
+             | _ => 2
+             end
+     : K -> nat
+fun x : K => match x with
+             | a1 | a3 | a4 => 3
+             | _ => 2
+             end
+     : K -> nat
diff --git a/test-suite/output/Cases.v b/test-suite/output/Cases.v
index 17fee3303..caf3b2870 100644
--- a/test-suite/output/Cases.v
+++ b/test-suite/output/Cases.v
@@ -1,5 +1,7 @@
 (* Cases with let-in in constructors types *)
 
+Unset Printing Allow Match Default Clause.
+
 Inductive t : Set :=
     k : let x := t in x -> x.
 
@@ -184,3 +186,33 @@ let p := fresh "p" in
   |- eq_refl ?p = _ => pose (match eq_refl p in _ = z return p=p /\ z=z with eq_refl => conj eq_refl eq_refl end)
   end.
 Show.
+
+Set Printing Allow Match Default Clause.
+
+(***************************************************)
+(* Testing strategy for factorizing cases branches *)
+
+(* Factorization + default clause *)
+Check fun x => match x with Eq => 1 | _ => 0 end.
+
+(* No factorization *)
+Unset Printing Factorizable Match Patterns.
+Check fun x => match x with Eq => 1 | _ => 0 end.
+Set Printing Factorizable Match Patterns.
+
+(* Factorization but no default clause *)
+Unset Printing Allow Match Default Clause.
+Check fun x => match x with Eq => 1 | _ => 0 end.
+Set Printing Allow Match Default Clause.
+
+(* No factorization in printing all mode *)
+Set Printing All.
+Check fun x => match x with Eq => 1 | _ => 0 end.
+Unset Printing All.
+
+(* Several clauses *)
+Inductive K := a1|a2|a3|a4|a5|a6.
+Check fun x => match x with a3 | a4 => 3 | _ => 2 end.
+Check fun x => match x with a3 => 3 | a2 | a1 => 4 | _ => 2 end.
+Check fun x => match x with a4 => 3 | a2 | a1 => 4 | _ => 2 end.
+Check fun x => match x with a3 | a4 | a1 => 3 | _ => 2 end.
diff --git a/test-suite/output/CompactContexts.v b/test-suite/output/CompactContexts.v
index 07588d34f..c409c0ee4 100644
--- a/test-suite/output/CompactContexts.v
+++ b/test-suite/output/CompactContexts.v
@@ -2,4 +2,4 @@ Set Printing Compact Contexts.
 
 Lemma f (hP1:True) (a:nat) (b:list nat) (h:forall (x:nat) , { y:nat | y > x}) (h2:True): False.
 Show.
-Abort.
\ No newline at end of file
+Abort.
diff --git a/test-suite/output/ErrorInCanonicalStructures.out b/test-suite/output/ErrorInCanonicalStructures.out
new file mode 100644
index 000000000..73da4f44f
--- /dev/null
+++ b/test-suite/output/ErrorInCanonicalStructures.out
@@ -0,0 +1,5 @@
+File "stdin", line 3, characters 0-24:
+Error:
+Could not declare a canonical structure Foo.
+Expected an instance of a record or structure.
+
diff --git a/test-suite/output/ErrorInCanonicalStructures.v b/test-suite/output/ErrorInCanonicalStructures.v
new file mode 100644
index 000000000..49597df6f
--- /dev/null
+++ b/test-suite/output/ErrorInCanonicalStructures.v
@@ -0,0 +1,3 @@
+Record Foo := MkFoo { field1 : nat; field2 : nat -> nat }.
+
+Canonical Structure Foo.
diff --git a/test-suite/output/ErrorInCanonicalStructures2.out b/test-suite/output/ErrorInCanonicalStructures2.out
new file mode 100644
index 000000000..63a2871b8
--- /dev/null
+++ b/test-suite/output/ErrorInCanonicalStructures2.out
@@ -0,0 +1,5 @@
+File "stdin", line 3, characters 0-24:
+Error:
+Could not declare a canonical structure bar.
+Expected an instance of a record or structure.
+
diff --git a/test-suite/output/ErrorInCanonicalStructures2.v b/test-suite/output/ErrorInCanonicalStructures2.v
new file mode 100644
index 000000000..10ee177aa
--- /dev/null
+++ b/test-suite/output/ErrorInCanonicalStructures2.v
@@ -0,0 +1,3 @@
+Definition bar := 99.
+
+Canonical Structure bar.
diff --git a/test-suite/output/Extraction_infix.out b/test-suite/output/Extraction_infix.out
new file mode 100644
index 000000000..29d50775a
--- /dev/null
+++ b/test-suite/output/Extraction_infix.out
@@ -0,0 +1,20 @@
+(** val test : foo **)
+
+let test =
+  (fun (b, p) -> bar) (True, False)
+(** val test : foo **)
+
+let test =
+  True@@?False
+(** val test : foo **)
+
+let test =
+  True#^^False
+(** val test : foo **)
+
+let test =
+  True@?:::False
+(** val test : foo **)
+
+let test =
+  True  @?:::  False
diff --git a/test-suite/output/Extraction_infix.v b/test-suite/output/Extraction_infix.v
new file mode 100644
index 000000000..fe5926a36
--- /dev/null
+++ b/test-suite/output/Extraction_infix.v
@@ -0,0 +1,26 @@
+(* @herbelin's example for issue #6212 *)
+
+Require Import Extraction.
+Inductive I := C : bool -> bool -> I.
+Definition test := C true false.
+
+(* the parentheses around the function wrong signalled an infix operator *)
+
+Extract Inductive I => "foo" [ "(fun (b, p) -> bar)" ].
+Extraction test.
+
+(* some bonafide infix operators *)
+
+Extract Inductive I => "foo" [ "(@@?)" ].
+Extraction test.
+
+Extract Inductive I => "foo" [ "(#^^)" ].
+Extraction test.
+
+Extract Inductive I => "foo" [ "(@?:::)" ].
+Extraction test.
+
+(* allow whitespace around infix operator *)
+
+Extract Inductive I => "foo" [ "(  @?:::  )" ].
+Extraction test.
diff --git a/test-suite/output/Fixpoint.v b/test-suite/output/Fixpoint.v
index fafb478ba..61ae4edbd 100644
--- a/test-suite/output/Fixpoint.v
+++ b/test-suite/output/Fixpoint.v
@@ -7,7 +7,7 @@ Check
              | a :: l => f a :: F _ _ f l
              end).
 
-(* V8 printing of this term used to failed in V8.0 and V8.0pl1 (cf bug #860) *)
+(* V8 printing of this term used to failed in V8.0 and V8.0pl1 (cf BZ#860) *)
 Check
   let fix f (m : nat) : nat :=
     match m with
diff --git a/test-suite/output/Implicit.v b/test-suite/output/Implicit.v
index 7c9b89f9d..306532c0d 100644
--- a/test-suite/output/Implicit.v
+++ b/test-suite/output/Implicit.v
@@ -1,7 +1,7 @@
 Set Implicit Arguments.
 Unset Strict Implicit.
 
-(* Suggested by Pierre Casteran (bug #169) *)
+(* Suggested by Pierre Casteran (BZ#169) *)
 (* Argument 3 is needed to typecheck and should be printed *)
 Definition compose (A B C : Set) (f : A -> B) (g : B -> C) (x : A) := g (f x).
 Check (compose (C:=nat) S).
diff --git a/test-suite/output/Inductive.out b/test-suite/output/Inductive.out
index e912003f0..af202ea01 100644
--- a/test-suite/output/Inductive.out
+++ b/test-suite/output/Inductive.out
@@ -1,3 +1,7 @@
 The command has indeed failed with message:
 Last occurrence of "list'" must have "A" as 1st argument in
  "A -> list' A -> list' (A * A)%type".
+Inductive foo (A : Type) (x : A) (y : A := x) : Prop :=  Foo : foo A x
+
+For foo: Argument scopes are [type_scope _]
+For Foo: Argument scopes are [type_scope _]
diff --git a/test-suite/output/Inductive.v b/test-suite/output/Inductive.v
index 8db8956e3..8ff91268a 100644
--- a/test-suite/output/Inductive.v
+++ b/test-suite/output/Inductive.v
@@ -1,3 +1,7 @@
 Fail Inductive list' (A:Set) : Set :=
 | nil' : list' A
 | cons' : A -> list' A -> list' (A*A).
+
+(* Check printing of let-ins *)
+Inductive foo (A : Type) (x : A) (y := x) := Foo.
+Print foo.
diff --git a/test-suite/output/InvalidDisjunctiveIntro.out b/test-suite/output/InvalidDisjunctiveIntro.out
new file mode 100644
index 000000000..25a306b45
--- /dev/null
+++ b/test-suite/output/InvalidDisjunctiveIntro.out
@@ -0,0 +1,16 @@
+The command has indeed failed with message:
+Cannot coerce to a disjunctive/conjunctive pattern.
+The command has indeed failed with message:
+Disjunctive/conjunctive introduction pattern expected.
+The command has indeed failed with message:
+Cannot coerce to a disjunctive/conjunctive pattern.
+The command has indeed failed with message:
+Cannot coerce to a disjunctive/conjunctive pattern.
+The command has indeed failed with message:
+Ltac variable H is bound to <tactic closure> which cannot be coerced to
+an introduction pattern.
+The command has indeed failed with message:
+Disjunctive/conjunctive introduction pattern expected.
+The command has indeed failed with message:
+Ltac variable H' is bound to <tactic closure> which cannot be coerced to
+an introduction pattern.
diff --git a/test-suite/output/InvalidDisjunctiveIntro.v b/test-suite/output/InvalidDisjunctiveIntro.v
new file mode 100644
index 000000000..4febdf034
--- /dev/null
+++ b/test-suite/output/InvalidDisjunctiveIntro.v
@@ -0,0 +1,18 @@
+Theorem test (A:Prop) : A \/ A -> A.
+  Fail intros H; destruct H as H.
+  (* Cannot coerce to a disjunctive/conjunctive pattern. *)
+  Fail intro H; destruct H as H.
+  (* Disjunctive/conjunctive introduction pattern expected. *)
+  Fail let H := fresh in intro H; destruct H as H.
+  (* Cannot coerce to a disjunctive/conjunctive pattern. *)
+  Fail let H := fresh in intros H; destruct H as H.
+  (* Cannot coerce to a disjunctive/conjunctive pattern. *)
+  Fail let H := idtac in intros H; destruct H as H.
+  (* Ltac variable H is bound to <tactic closure> which cannot be
+coerced to an introduction pattern. *)
+  Fail let H := idtac in intros H; destruct H as H'.
+  (* Disjunctive/conjunctive introduction pattern expected. *)
+  Fail let H' := idtac in intros H; destruct H as H'.
+(* Ltac variable H' is bound to <tactic closure> which cannot
+be coerced to an introduction pattern. *)
+Abort.
diff --git a/test-suite/output/MExtraction.v b/test-suite/output/MExtraction.v
new file mode 100644
index 000000000..352e422cf
--- /dev/null
+++ b/test-suite/output/MExtraction.v
@@ -0,0 +1,12 @@
+Require Import micromega.MExtraction.
+Require Import RingMicromega.
+Require Import QArith.
+Require Import VarMap.
+Require Import ZMicromega.
+Require Import QMicromega.
+Require Import RMicromega.
+
+Recursive Extraction
+  List.map RingMicromega.simpl_cone (*map_cone  indexes*)
+  denorm Qpower vm_add
+  n_of_Z N.of_nat ZTautoChecker ZWeakChecker QTautoChecker RTautoChecker find.
diff --git a/test-suite/output/Notations.out b/test-suite/output/Notations.out
index 9d106d2da..891296b0a 100644
--- a/test-suite/output/Notations.out
+++ b/test-suite/output/Notations.out
@@ -41,7 +41,7 @@ fun x : nat => ifn x is succ n then n else 0
 -4
      : Z
 The command has indeed failed with message:
-x should not be bound in a recursive pattern of the right-hand side.
+Cannot find where the recursive pattern starts.
 The command has indeed failed with message:
 in the right-hand side, y and z should appear in
 term position as part of a recursive pattern.
@@ -64,7 +64,7 @@ The command has indeed failed with message:
 Cannot find where the recursive pattern starts.
 The command has indeed failed with message:
 Both ends of the recursive pattern are the same.
-SUM (nat * nat) nat
+(nat * nat + nat)%type
      : Set
 FST (0; 1)
      : Z
@@ -72,7 +72,7 @@ Nil
      : forall A : Type, list A
 NIL : list nat
      : list nat
-(false && I 3)%bool /\ I 6
+(false && I 3)%bool /\ (I 6)%bool
      : Prop
 [|1, 2, 3; 4, 5, 6|]
      : Z * Z * Z * (Z * Z * Z)
@@ -133,3 +133,5 @@ fun (x : nat) (p : x = x) => match p with
                              | 1 => 1
                              end = p
      : forall x : nat, x = x -> Prop
+bar  0
+     : nat
diff --git a/test-suite/output/Notations.v b/test-suite/output/Notations.v
index b9985a594..413812ee1 100644
--- a/test-suite/output/Notations.v
+++ b/test-suite/output/Notations.v
@@ -30,7 +30,7 @@ Check (decomp (true,true) as t, u in (t,u)).
 
 Section A.
 
-Notation "! A" := (forall _:nat, A) (at level 60).
+Notation "! A" := (forall _:nat, A) (at level 60) : type_scope.
 
 Check ! (0=0).
 Check forall n, n=0.
@@ -194,9 +194,9 @@ Open Scope nat_scope.
 
 Coercion is_true := fun b => b=true.
 Coercion of_nat n := match n with 0 => true | _ => false end.
-Notation "'I' x" := (of_nat (S x) || true)%bool (at level 10).
+Notation "'I' x" := (of_nat (S x) || true)%bool (at level 10) : bool_scope.
 
-Check (false && I 3)%bool /\ I 6.
+Check (false && I 3)%bool /\ (I 6)%bool.
 
 (**********************************************************************)
 (* Check notations with several recursive patterns                    *)
@@ -291,3 +291,11 @@ Check fun (x:nat) (p : x=x) => match p with ONE => ONE end = p.
 Notation "1" := eq_refl.
 Check fun (x:nat) (p : x=x) => match p with 1 => 1 end = p.
 
+(* Check bug 5693 *)
+
+Module M.
+Definition A := 0.
+Definition bar (a b : nat) := plus a b.
+Notation "" := A (format "", only printing).
+Check (bar A 0).
+End M.
diff --git a/test-suite/output/Notations2.out b/test-suite/output/Notations2.out
index 1ec701ae8..6ffe56e11 100644
--- a/test-suite/output/Notations2.out
+++ b/test-suite/output/Notations2.out
@@ -17,10 +17,9 @@ fun (P : nat -> nat -> Prop) (x : nat) => exists y, P x y
 ∃ n p : nat, n + p = 0
      : Prop
 let a := 0 in
-∃ x y : nat,
-let b := 1 in
-let c := b in
-let d := 2 in ∃ z : nat, let e := 3 in let f := 4 in x + y = z + d
+∃ (x y : nat) (b := 1) (c := b) (d := 2) (z : nat), 
+let e := 3 in
+let f := 4 in x + y = z + d
      : Prop
 ∀ n p : nat, n + p = 0
      : Prop
@@ -37,11 +36,22 @@ let' f (x y : nat) (a := 0) (z : nat) (_ : bool) := x + y + z + 1 in f 0 1 2
 λ (f : nat -> nat) (x : nat), f(x) + S(x)
      : (nat -> nat) -> nat -> nat
 Notation plus2 n := (S(S(n)))
+λ n : list(nat), match n with
+                 | 1 :: nil => 0
+                 | _ => 2
+                 end
+     : list(nat) -> nat
+λ n : list(nat),
+match n with
+| 1 :: nil => 0
+| nil | 0 :: _ | 1 :: _ :: _ | plus2 _ :: _ => 2
+end
+     : list(nat) -> nat
 λ n : list(nat),
 match n with
 | nil => 2
 | 0 :: _ => 2
-| list1 => 0
+| 1 :: nil => 0
 | 1 :: _ :: _ => 2
 | plus2 _ :: _ => 2
 end
@@ -84,3 +94,9 @@ a≡
      : Set
 .α
      : Set
+# a : .α =>
+# b : .α =>
+let res := 0 in
+for i from 0 to a updating (res)
+{{for j from 0 to b updating (res) {{S res}};; res}};; res
+     : .α -> .α -> .α
diff --git a/test-suite/output/Notations2.v b/test-suite/output/Notations2.v
index ceb29d1b9..923caedac 100644
--- a/test-suite/output/Notations2.v
+++ b/test-suite/output/Notations2.v
@@ -36,8 +36,9 @@ Check fun P:nat->nat->Prop => fun x:nat => ex (P x).
 
 (* Test notations with binders *)
 
-Notation "∃  x .. y , P":= (ex (fun x => .. (ex (fun y => P)) ..))
-  (x binder, y binder, at level 200, right associativity).
+Notation "∃ x .. y , P":= (ex (fun x => .. (ex (fun y => P)) ..))
+  (x binder, y binder, at level 200, right associativity,
+  format "'[  ' ∃  x  ..  y ']' ,  P").
 
 Check (∃ n p, n+p=0).
 
@@ -70,6 +71,7 @@ Check let' f x y (a:=0) z (b:bool) := x+y+z+1 in f 0 1 2.
 (* Note: does not work for pattern *)
 Module A.
 Notation "f ( x )" := (f x) (at level 10, format "f ( x )").
+Open Scope nat_scope.
 Check fun f x => f x + S x.
 
 Open Scope list_scope.
@@ -78,6 +80,13 @@ Notation plus2 n := (S (S n)).
 (* plus2 was not correctly printed in the two following tests in 8.3pl1 *)
 Print plus2.
 Check fun n => match n with list1 => 0 | _ => 2 end.
+Unset Printing Allow Match Default Clause.
+Check fun n => match n with list1 => 0 | _ => 2 end.
+Unset Printing Factorizable Match Patterns.
+Check fun n => match n with list1 => 0 | _ => 2 end.
+Set Printing Allow Match Default Clause.
+Set Printing Factorizable Match Patterns.
+
 End A.
 
 (* This one is not fully satisfactory because binders in the same type
@@ -145,3 +154,24 @@ Check .a≡.
 Notation ".α" := nat.
 Check nat.
 Check .α.
+
+(* A test for #6304 *)
+
+Module M6304.
+Notation "'for' m 'from' 0 'to' N 'updating' ( s1 )  {{ b }} ;; rest" :=
+  (let s1 :=
+    (fix rec(n: nat) := match n with
+     | 0 => s1
+     | S m => let s1 := rec m in b
+     end) N
+  in rest)
+  (at level 20).
+
+Check fun (a b : nat) =>
+  let res := 0 in
+  for i from 0 to a updating (res) {{
+    for j from 0 to b updating (res) {{ S res }};;
+    res
+  }};; res.
+
+End M6304.
diff --git a/test-suite/output/Notations3.out b/test-suite/output/Notations3.out
index e5dbfcb4b..e6a6e0288 100644
--- a/test-suite/output/Notations3.out
+++ b/test-suite/output/Notations3.out
@@ -122,3 +122,116 @@ return (1, 2, 3, 4)
      : nat * nat * nat * nat
 {{ 1 | 1 // 1 }}
      : nat
+!!! _ _ : nat, True
+     : (nat -> Prop) * ((nat -> Prop) * Prop)
+((*1).2).3
+     : nat
+*(1.2)
+     : nat
+[{0; 0}]
+     : list (list nat)
+[{1; 2; 3};
+ {4; 5; 6};
+ {7; 8; 9}]
+     : list (list nat)
+amatch = mmatch 0 (with 0 => 1| 1 => 2 end)
+     : unit
+alist = [0; 1; 2]
+     : list nat
+! '{{x, y}}, x + y = 0
+     : Prop
+exists x : nat,
+  nat ->
+  exists y : nat,
+    nat ->
+    exists '{{u, t}}, forall z1 : nat, z1 = 0 /\ x + y = 0 /\ u + t = 0
+     : Prop
+exists x : nat,
+  nat ->
+  exists y : nat,
+    nat ->
+    exists '{{z, t}}, forall z2 : nat, z2 = 0 /\ x + y = 0 /\ z + t = 0
+     : Prop
+exists_true '{{x, y}} (u := 0) '{{z, t}}, x + y = 0 /\ z + t = 0
+     : Prop
+exists_true (A : Type) (R : A -> A -> Prop) (_ : Reflexive R),
+(forall x : A, R x x)
+     : Prop
+exists_true (x : nat) (A : Type) (R : A -> A -> Prop) 
+(_ : Reflexive R) (y : nat), x + y = 0 -> forall z : A, R z z
+     : Prop
+{{{{True, nat -> True}}, nat -> True}}
+     : Prop * Prop * Prop
+{{D 1, 2}}
+     : nat * nat * (nat * nat * (nat * nat))
+! a b : nat # True #
+     : Prop * (Prop * Prop)
+!!!! a b : nat # True #
+     : Prop * Prop * (Prop * Prop * Prop)
+@@ a b : nat # a = b # b = a #
+     : Prop * Prop
+exists_non_null x y z t : nat , x = y /\ z = t
+     : Prop
+forall_non_null x y z t : nat , x = y /\ z = t
+     : Prop
+{{RL 1, 2}}
+     : nat * (nat * nat)
+{{RR 1, 2}}
+     : nat * nat * nat
+@pair nat (prod nat nat) (S (S O)) (@pair nat nat (S O) O)
+     : prod nat (prod nat nat)
+@pair (prod nat nat) nat (@pair nat nat O (S (S O))) (S O)
+     : prod (prod nat nat) nat
+{{RLRR 1, 2}}
+     : nat * (nat * nat) * (nat * nat * nat) * (nat * (nat * nat)) *
+       (nat * nat * nat)
+pair
+  (pair
+     (pair (pair (S (S O)) (pair (S O) O)) (pair (pair O (S (S O))) (S O)))
+     (pair (S O) (pair (S (S O)) O))) (pair (pair O (S O)) (S (S O)))
+     : prod
+         (prod (prod (prod nat (prod nat nat)) (prod (prod nat nat) nat))
+            (prod nat (prod nat nat))) (prod (prod nat nat) nat)
+fun x : nat => if x is n .+ 1 then n else 1
+     : nat -> nat
+{'{{x, y}} : nat * nat | x + y = 0}
+     : Set
+exists2' {{x, y}}, x = 0 & y = 0
+     : Prop
+myexists2 x : nat * nat,
+  let '{{y, z}} := x in y > z & let '{{y, z}} := x in z > y
+     : Prop
+fun '({{x, y}} as z) => x + y = 0 /\ z = z
+     : nat * nat -> Prop
+myexists ({{x, y}} as z), x + y = 0 /\ z = z
+     : Prop
+exists '({{x, y}} as z), x + y = 0 /\ z = z
+     : Prop
+∀ '({{x, y}} as z), x + y = 0 /\ z = z
+     : Prop
+fun '({{{{x, y}}, true}} | {{{{x, y}}, false}}) => x + y
+     : nat * nat * bool -> nat
+myexists ({{{{x, y}}, true}} | {{{{x, y}}, false}}), x > y
+     : Prop
+exists '({{{{x, y}}, true}} | {{{{x, y}}, false}}), x > y
+     : Prop
+∀ '({{{{x, y}}, true}} | {{{{x, y}}, false}}), x > y
+     : Prop
+fun p : nat => if p is S n then n else 0
+     : nat -> nat
+fun p : comparison => if p is Lt then 1 else 0
+     : comparison -> nat
+fun S : nat => [S | S + S]
+     : nat -> nat * (nat -> nat)
+fun N : nat => [N | N + 0]
+     : nat -> nat * (nat -> nat)
+fun S : nat => [[S | S + S]]
+     : nat -> nat * (nat -> nat)
+{I : nat | I = I}
+     : Set
+{'I : True | I = I}
+     : Prop
+{'{{x, y}} : nat * nat | x + y = 0}
+     : Set
+exists2 '{{y, z}} : nat * nat, y > z & z > y
+     : Prop
diff --git a/test-suite/output/Notations3.v b/test-suite/output/Notations3.v
index b1015137d..c98bfff41 100644
--- a/test-suite/output/Notations3.v
+++ b/test-suite/output/Notations3.v
@@ -59,7 +59,7 @@ 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)).
+Notation "{# x | P }" := (ex2 (fun y => x = y) (fun x => P)) : type_scope.
 Check forall n:nat, {# n | 1 > n}.
 
 Parameter foo : forall {T}(x : T)(P : T -> Prop), Prop.
@@ -183,6 +183,240 @@ Check letpair x [1] = {0}; return (1,2,3,4).
 
 (* Test spacing in #5569 *)
 
+Section S1.
+Variable plus : nat -> nat -> nat.
+Infix "+" := plus.
 Notation "{ { xL | xR // xcut } }" := (xL+xR+xcut)
   (at level 0, xR at level 39, format "{ {  xL  |  xR  //  xcut  } }").
 Check 1+1+1.
+End S1.
+
+(* Test presence of notation variables in the recursive parts (introduced in dfdaf4de) *)
+Notation "!!! x .. y , b" := ((fun x => b), .. ((fun y => b), True) ..) (at level 200, x binder).
+Check !!! (x y:nat), True.
+
+(* Allow level for leftmost nonterminal when printing-only, BZ#5739 *)
+
+Section S2.
+Notation "* x" := (id x) (only printing, at level 15, format "* x") : nat_scope.
+Notation "x . y" := (x + y) (only printing, at level 20, x at level 14, left associativity, format "x . y") : nat_scope.
+Check (((id 1) + 2) + 3).
+Check (id (1 + 2)).
+End S2.
+
+(* Test printing of notations guided by scope *)
+
+Module A.
+
+Delimit Scope line_scope with line.
+Notation "{ }" := nil (format "{ }") : line_scope.
+Notation "{ x }" := (cons x nil) : line_scope.
+Notation "{ x ; y ; .. ; z }" :=  (cons x (cons y .. (cons z nil) ..)) : line_scope.
+Notation "[ ]" := nil (format "[ ]") : matx_scope.
+Notation "[ l ]" := (cons l%line nil) : matx_scope.
+Notation "[ l ; l' ; .. ; l'' ]" :=  (cons l%line (cons l'%line .. (cons l''%line nil) ..))
+  (format "[ '[v' l ; '/' l' ; '/' .. ; '/' l'' ']' ]") : matx_scope.
+
+Open Scope matx_scope.
+Check [[0;0]].
+Check [[1;2;3];[4;5;6];[7;8;9]].
+
+End A.
+
+(* Example by Beta Ziliani *)
+
+Require Import Lists.List.
+
+Module B.
+
+Import ListNotations.
+
+Delimit Scope pattern_scope with pattern.
+Delimit Scope patterns_scope with patterns.
+
+Notation "a => b" := (a, b) (at level 201) : pattern_scope.
+Notation "'with' p1 | .. | pn 'end'" :=
+  ((cons p1%pattern (.. (cons pn%pattern nil) ..)))
+    (at level 91, p1 at level 210, pn at level 210) : patterns_scope.
+
+Definition mymatch (n:nat) (l : list (nat * nat)) := tt.
+Arguments mymatch _ _%patterns.
+Notation "'mmatch' n ls" := (mymatch n ls) (at level 0).
+
+Close Scope patterns_scope.
+Close Scope pattern_scope.
+
+Definition amatch := mmatch 0 with 0 => 1 | 1 => 2 end.
+Print amatch. (* Good: amatch = mmatch 0 (with 0 => 1| 1 => 2 end) *)
+
+Definition alist := [0;1;2].
+Print alist.
+
+End B.
+
+(* Test contraction of "forall x, let 'pat := x in ..." into "forall 'pat, ..." *)
+(* for isolated "forall" (was not working already in 8.6) *)
+Notation "! x .. y , A" := (id (forall x, .. (id (forall y, A)) .. )) (at level 200, x binder).
+Check ! '(x,y), x+y=0.
+
+(* Check that the terminator of a recursive pattern is interpreted in
+   the correct environment of bindings *)
+Notation "'exists_mixed' x .. y , P" := (ex (fun x => forall z:nat, .. (ex (fun y => forall z:nat, z=0 /\ P)) ..)) (at level 200, x binder).
+Check exists_mixed x y '(u,t), x+y=0/\u+t=0.
+Check exists_mixed x y '(z,t), x+y=0/\z+t=0.
+
+(* Check that intermediary let-in are inserted inbetween instances of
+   the repeated pattern *)
+Notation "'exists_true' x .. y , P" := (exists x, True /\ .. (exists y, True /\ P) ..) (at level 200, x binder).
+Check exists_true '(x,y) (u:=0) '(z,t), x+y=0/\z+t=0.
+
+(* Check that generalized binders are correctly interpreted *)
+
+Module G.
+Generalizable Variables A R.
+Class Reflexive {A:Type} (R : A->A->Prop) := reflexivity : forall x : A, R x x.
+Check exists_true `{Reflexive A R}, forall x, R x x.
+Check exists_true x `{Reflexive A R} y, x+y=0 -> forall z, R z z.
+End G.
+
+(* Allows recursive patterns for binders to be associative on the left *)
+Notation "!! x .. y # A #" := (.. (A,(forall x, True)) ..,(forall y, True)) (at level 200, x binder).
+Check !! a b : nat # True #.
+
+(* Examples where the recursive pattern refer several times to the recursive variable *)
+
+Notation "{{D  x , .. , y }}" := ((x,x), .. ((y,y),(0,0)) ..).
+Check {{D 1, 2 }}.
+
+Notation "! x .. y # A #" :=
+  ((forall x, x=x), .. ((forall y, y=y), A) ..)
+  (at level 200, x binder).
+Check ! a b : nat # True #.
+
+Notation "!!!! x .. y # A #" :=
+  (((forall x, x=x),(forall x, x=0)), .. (((forall y, y=y),(forall y, y=0)), A) ..)
+  (at level 200, x binder).
+Check !!!! a b : nat # True #.
+
+Notation "@@ x .. y # A # B #" :=
+  ((forall x, .. (forall y, A) ..), (forall x, .. (forall y, B) ..))
+  (at level 200, x binder).
+Check @@ a b : nat # a=b # b=a #.
+
+Notation "'exists_non_null' x .. y  , P" :=
+  (ex (fun x => x <> 0 /\ .. (ex (fun y => y <> 0 /\ P)) ..))
+  (at level 200, x binder).
+Check exists_non_null x y z t , x=y/\z=t.
+
+Notation "'forall_non_null' x .. y  , P" :=
+  (forall x, x <> 0 -> .. (forall y, y <> 0 -> P) ..)
+  (at level 200, x binder).
+Check forall_non_null x y z t , x=y/\z=t.
+
+(* Examples where the recursive pattern is in reverse order *)
+
+Notation "{{RL  c , .. , d }}" := (pair d .. (pair c 0) ..).
+Check {{RL 1 , 2}}.
+
+Notation "{{RR  c , .. , d }}" := (pair .. (pair 0 d) .. c).
+Check {{RR 1 , 2}}.
+
+Set Printing All.
+Check {{RL 1 , 2}}.
+Check {{RR 1 , 2}}.
+Unset Printing All.
+
+Notation "{{RLRR  c , .. , d }}" := (pair d .. (pair c 0) .., pair .. (pair 0 d) .. c, pair c .. (pair d 0) .., pair .. (pair 0 c) .. d).
+Check {{RLRR 1 , 2}}.
+Unset Printing Notations.
+Check {{RLRR 1 , 2}}.
+Set Printing Notations.
+
+(* Check insensitivity of "match" clauses to order *)
+
+Notation "'if' t 'is' n .+ 1 'then' p 'else' q" :=
+  (match t with S n => p | 0 => q end)
+  (at level 200).
+Check fun x => if x is n.+1 then n else 1.
+
+(* Examples with binding patterns *)
+
+Check {'(x,y)|x+y=0}.
+
+Module D.
+Notation "'exists2'' x , p & q" := (ex2 (fun x => p) (fun x => q))
+  (at level 200, x pattern, p at level 200, right associativity,
+    format "'[' 'exists2''  '/  ' x ,  '/  ' '[' p  &  '/' q ']' ']'")
+  : type_scope.
+
+Check exists2' (x,y), x=0 & y=0.
+End D.
+
+(* Ensuring for reparsability that printer of notations does not use a
+   pattern where only an ident could be reparsed *)
+
+Module E.
+Inductive myex2 {A:Type} (P Q:A -> Prop) : Prop :=
+  myex_intro2 : forall x:A, P x -> Q x -> myex2 P Q.
+Notation "'myexists2' x : A , p & q" := (myex2 (A:=A) (fun x => p) (fun x => q))
+  (at level 200, x ident, A at level 200, p at level 200, right associativity,
+    format "'[' 'myexists2'  '/  ' x  :  A ,  '/  ' '[' p  &  '/' q ']' ']'")
+  : type_scope.
+Check myex2 (fun x => let '(y,z) := x in y>z) (fun x => let '(y,z) := x in z>y).
+End E.
+
+(* A canonical example of a notation with a non-recursive binder *)
+
+Parameter myex : forall {A}, (A -> Prop) -> Prop.
+Notation "'myexists' x , p" := (myex (fun x => p))
+  (at level 200, x pattern, p at level 200, right associativity).
+
+(* A canonical example of a notation with recursive binders *)
+
+Notation "∀  x .. y , P" := (forall x, .. (forall y, P) ..)
+  (at level 200, x binder, y binder, right associativity) : type_scope.
+
+(* Check that printing 'pat uses an "as" when the variable bound to
+   the pattern is dependent. We check it for the three kinds of
+   notations involving bindings of patterns *)
+
+Check fun '((x,y) as z) => x+y=0/\z=z.    (* Primitive fun/forall *)
+Check myexists ((x,y) as z), x+y=0/\z=z.  (* Isolated binding pattern *)
+Check exists '((x,y) as z), x+y=0/\z=z.   (* Applicative recursive binder *)
+Check ∀ '((x,y) as z), x+y=0/\z=z.        (* Other example of recursive binder, now treated as the exists case *)
+
+(* Check parsability and printability of irrefutable disjunctive patterns *)
+
+Check fun '(((x,y),true)|((x,y),false)) => x+y.
+Check myexists (((x,y),true)|((x,y),false)), x>y.
+Check exists '(((x,y),true)|((x,y),false)), x>y.
+Check ∀ '(((x,y),true)|((x,y),false)), x>y.
+
+(* Check Georges' printability of a "if is then else" notation *)
+
+Notation "'if' c 'is' p 'then' u 'else' v" :=
+  (match c with p => u | _ => v end)
+  (at level 200, p pattern at level 100).
+Check fun p => if p is S n then n else 0.
+Check fun p => if p is Lt then 1 else 0.
+
+(* Check that mixed binders and terms defaults to ident and not pattern *)
+Module F.
+  (* First without an indirection *)
+Notation "[ n | t ]" := (n, (fun n : nat => t)).
+Check fun S : nat => [ S | S+S ].
+Check fun N : nat => (N, (fun n => n+0)). (* another test in passing *)
+  (* Then with an indirection *)
+Notation "[[ n | p | t ]]" := (n, (fun p : nat => t)).
+Notation "[[ n | t ]]" := [[ n | n | t ]].
+Check fun S : nat => [[ S | S+S ]].
+End F.
+
+(* Check parsability/printability of {x|P} and variants *)
+
+Check {I:nat|I=I}.
+Check {'I:True|I=I}.
+Check {'(x,y)|x+y=0}.
+
+(* Check exists2 with a pattern *)
+Check ex2 (fun x => let '(y,z) := x in y>z) (fun x => let '(y,z) := x in z>y).
diff --git a/test-suite/output/PatternsInBinders.out b/test-suite/output/PatternsInBinders.out
index 95be04c32..8a6d94c73 100644
--- a/test-suite/output/PatternsInBinders.out
+++ b/test-suite/output/PatternsInBinders.out
@@ -31,7 +31,7 @@ exists '(x, y) '(z, w), swap (x, y) = (z, w)
      : Prop
 both_z = 
 fun pat : nat * nat =>
-let '(n, p) as pat0 := pat return (F pat0) in (Z n, Z p) : F (n, p)
+let '(n, p) as x := pat return (F x) 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
@@ -39,3 +39,9 @@ forall '(x, y) '(z, t), swap (x, y) = (z, t)
      : Prop
 fun (pat : nat) '(x, y) => x + y = pat
      : nat -> nat * nat -> Prop
+f = fun x : nat => x + x
+     : nat -> nat
+
+Argument scope is [nat_scope]
+fun x : nat => x + x
+     : nat -> nat
diff --git a/test-suite/output/PatternsInBinders.v b/test-suite/output/PatternsInBinders.v
index 0bad472f4..d671053c0 100644
--- a/test-suite/output/PatternsInBinders.v
+++ b/test-suite/output/PatternsInBinders.v
@@ -67,3 +67,8 @@ End Suboptimal.
 
 (** Test risk of collision for internal name *)
 Check fun pat => fun '(x,y) => x+y = pat.
+
+(** Test name in degenerate case *)
+Definition f 'x := x+x.
+Print f.
+Check fun 'x => x+x.
diff --git a/test-suite/output/SearchPattern.out b/test-suite/output/SearchPattern.out
index 45ff5e73b..b0ac9ea29 100644
--- a/test-suite/output/SearchPattern.out
+++ b/test-suite/output/SearchPattern.out
@@ -12,32 +12,37 @@ Nat.ltb: nat -> nat -> bool
 Nat.testbit: nat -> nat -> bool
 Nat.eqb: nat -> nat -> bool
 Nat.two: nat
-Nat.zero: nat
 Nat.one: nat
+Nat.zero: nat
 O: nat
-Nat.double: nat -> nat
-Nat.sqrt: nat -> nat
 Nat.div2: nat -> nat
 Nat.log2: nat -> nat
+Nat.succ: nat -> nat
+Nat.sqrt: nat -> nat
 Nat.pred: nat -> nat
+Nat.double: nat -> nat
 Nat.square: nat -> nat
 S: nat -> nat
-Nat.succ: nat -> nat
 Nat.ldiff: nat -> nat -> nat
-Nat.add: nat -> nat -> nat
-Nat.lor: nat -> nat -> nat
-Nat.lxor: nat -> nat -> nat
+Nat.tail_add: nat -> nat -> nat
 Nat.land: nat -> nat -> nat
-Nat.mul: nat -> nat -> nat
-Nat.sub: nat -> nat -> nat
-Nat.max: nat -> nat -> nat
+Nat.tail_mul: nat -> nat -> nat
 Nat.div: nat -> nat -> nat
-Nat.pow: nat -> nat -> nat
-Nat.min: nat -> nat -> nat
-Nat.modulo: nat -> nat -> nat
+Nat.lor: nat -> nat -> nat
 Nat.gcd: nat -> nat -> nat
-Nat.sqrt_iter: nat -> nat -> nat -> nat -> nat
+Nat.modulo: nat -> nat -> nat
+Nat.max: nat -> nat -> nat
+Nat.sub: nat -> nat -> nat
+Nat.mul: nat -> nat -> nat
+Nat.lxor: nat -> nat -> nat
+Nat.add: nat -> nat -> nat
+Nat.min: nat -> nat -> nat
+Nat.pow: nat -> nat -> nat
+Nat.of_uint: Decimal.uint -> nat
+Nat.tail_addmul: nat -> nat -> nat -> nat
+Nat.of_uint_acc: Decimal.uint -> nat -> nat
 Nat.log2_iter: nat -> nat -> nat -> nat -> nat
+Nat.sqrt_iter: nat -> nat -> nat -> nat -> nat
 length: forall A : Type, list A -> nat
 Nat.bitwise: (bool -> bool -> bool) -> nat -> nat -> nat -> nat
 Nat.div2: nat -> nat
@@ -53,14 +58,18 @@ Nat.pow: nat -> nat -> nat
 Nat.land: nat -> nat -> nat
 Nat.lxor: nat -> nat -> nat
 Nat.div: nat -> nat -> nat
-Nat.mul: nat -> nat -> nat
-Nat.min: nat -> nat -> nat
+Nat.lor: nat -> nat -> nat
+Nat.tail_mul: nat -> nat -> nat
 Nat.modulo: nat -> nat -> nat
 Nat.sub: nat -> nat -> nat
-Nat.lor: nat -> nat -> nat
+Nat.mul: nat -> nat -> nat
 Nat.gcd: nat -> nat -> nat
 Nat.max: nat -> nat -> nat
+Nat.tail_add: nat -> nat -> nat
 Nat.add: nat -> nat -> nat
+Nat.min: nat -> nat -> nat
+Nat.tail_addmul: nat -> nat -> nat -> nat
+Nat.of_uint_acc: Decimal.uint -> nat -> nat
 Nat.log2_iter: nat -> nat -> nat -> nat -> nat
 Nat.sqrt_iter: nat -> nat -> nat -> nat -> nat
 Nat.bitwise: (bool -> bool -> bool) -> nat -> nat -> nat -> nat
diff --git a/test-suite/output/SearchPattern.v b/test-suite/output/SearchPattern.v
index bde195a51..de9f48873 100644
--- a/test-suite/output/SearchPattern.v
+++ b/test-suite/output/SearchPattern.v
@@ -33,4 +33,4 @@ Goal forall n (P:nat -> Prop), P n -> ~P n -> False.
   Search (P _) -"h'".       (* search hypothesis also for patterns *)
   Search (P _) -not.       (* search hypothesis also for patterns *)
 
-Abort.
\ No newline at end of file
+Abort.
diff --git a/test-suite/output/SuggestProofUsing.out b/test-suite/output/SuggestProofUsing.out
new file mode 100644
index 000000000..8d67a4a4b
--- /dev/null
+++ b/test-suite/output/SuggestProofUsing.out
@@ -0,0 +1,7 @@
+The proof of nat should start with one of the following commands:
+Proof using . 
+Proof using Type*. 
+Proof using Type. 
+The proof of foo should start with one of the following commands:
+Proof using A B. 
+Proof using All. 
diff --git a/test-suite/output/SuggestProofUsing.v b/test-suite/output/SuggestProofUsing.v
new file mode 100644
index 000000000..00b6f8e18
--- /dev/null
+++ b/test-suite/output/SuggestProofUsing.v
@@ -0,0 +1,31 @@
+Set Suggest Proof Using.
+
+Section Sec.
+  Variables A B : Type.
+
+  (* Some normal lemma. *)
+  Lemma nat : Set.
+  Proof.
+    exact nat.
+  Qed.
+
+  (* Make sure All is suggested even though we add an unused variable
+  to the context. *)
+  Let foo : Type.
+  Proof.
+    exact (A -> B).
+  Qed.
+
+  (* Having a [Proof using] disables the suggestion message. *)
+  Definition bar : Type.
+  Proof using A.
+    exact A.
+  Qed.
+
+  (* Transparent definitions don't get a suggestion message. *)
+  Definition baz : Type.
+  Proof.
+    exact A.
+  Defined.
+
+End Sec.
diff --git a/test-suite/output/Tactics.v b/test-suite/output/Tactics.v
index 9a5edb813..75b66e463 100644
--- a/test-suite/output/Tactics.v
+++ b/test-suite/output/Tactics.v
@@ -7,12 +7,12 @@ Ltac f H := split; [a H|e H].
 Print Ltac f.
 
 (* Test printing of match context *)
-(* Used to fail after translator removal (see bug #1070) *)
+(* Used to fail after translator removal (see BZ#1070) *)
 
 Ltac g := match goal with |- context [if ?X then _ else _ ] => case X end.
 Print Ltac g.
 
-(* Test an error message (#5390) *)
+(* Test an error message (BZ#5390) *)
 Lemma myid (P : Prop) : P <-> P.
 Proof. split; auto. Qed.
 
diff --git a/test-suite/output/UnivBinders.out b/test-suite/output/UnivBinders.out
index 128bc7767..668b4e578 100644
--- a/test-suite/output/UnivBinders.out
+++ b/test-suite/output/UnivBinders.out
@@ -1,6 +1,175 @@
+NonCumulative Inductive Empty@{u} : Type@{u} :=  
+NonCumulative Record PWrap (A : Type@{u}) : Type@{u} := pwrap { punwrap : A }
+
+PWrap has primitive projections with eta conversion.
+For PWrap: Argument scope is [type_scope]
+For pwrap: Argument scopes are [type_scope _]
+punwrap@{u} = 
+fun (A : Type@{u}) (p : PWrap@{u} A) => p.(punwrap)
+     : forall A : Type@{u}, PWrap@{u} A -> A
+(* u |=  *)
+
+punwrap is universe polymorphic
+Argument scopes are [type_scope _]
+NonCumulative Record RWrap (A : Type@{u}) : Type@{u} := rwrap { runwrap : A }
+
+For RWrap: Argument scope is [type_scope]
+For rwrap: Argument scopes are [type_scope _]
+runwrap@{u} = 
+fun (A : Type@{u}) (r : RWrap@{u} A) => let (runwrap) := r in runwrap
+     : forall A : Type@{u}, RWrap@{u} A -> A
+(* u |=  *)
+
+runwrap is universe polymorphic
+Argument scopes are [type_scope _]
+Wrap@{u} = fun A : Type@{u} => A
+     : Type@{u} -> Type@{u}
+(* u |=  *)
+
+Wrap is universe polymorphic
+Argument scope is [type_scope]
+wrap@{u} = 
+fun (A : Type@{u}) (Wrap : Wrap@{u} A) => Wrap
+     : forall A : Type@{u}, Wrap@{u} A -> A
+(* u |=  *)
+
+wrap is universe polymorphic
+Arguments A, Wrap are implicit and maximally inserted
+Argument scopes are [type_scope _]
 bar@{u} = nat
      : Wrap@{u} Set
 (* u |= Set < u
          *)
 
 bar is universe polymorphic
+foo@{u Top.17 v} = 
+Type@{Top.17} -> Type@{v} -> Type@{u}
+     : Type@{max(u+1,Top.17+1,v+1)}
+(* u Top.17 v |=  *)
+
+foo is universe polymorphic
+Monomorphic mono = Type@{mono.u}
+     : Type@{mono.u+1}
+(* {mono.u} |=  *)
+
+mono is not universe polymorphic
+mono
+     : Type@{mono.u+1}
+Type@{mono.u}
+     : Type@{mono.u+1}
+The command has indeed failed with message:
+Universe u already exists.
+monomono
+     : Type@{MONOU+1}
+mono.monomono
+     : Type@{mono.MONOU+1}
+monomono
+     : Type@{MONOU+1}
+mono
+     : Type@{mono.u+1}
+The command has indeed failed with message:
+Universe u already exists.
+bobmorane = 
+let tt := Type@{tt.v} in let ff := Type@{ff.v} in tt -> ff
+     : Type@{max(tt.u,ff.u)}
+The command has indeed failed with message:
+Universe u already bound.
+foo@{E M N} = 
+Type@{M} -> Type@{N} -> Type@{E}
+     : Type@{max(E+1,M+1,N+1)}
+(* E M N |=  *)
+
+foo is universe polymorphic
+foo@{Top.16 Top.17 Top.18} = 
+Type@{Top.17} -> Type@{Top.18} -> Type@{Top.16}
+     : Type@{max(Top.16+1,Top.17+1,Top.18+1)}
+(* Top.16 Top.17 Top.18 |=  *)
+
+foo is universe polymorphic
+NonCumulative Inductive Empty@{E} : Type@{E} :=  
+NonCumulative Record PWrap (A : Type@{E}) : Type@{E} := pwrap { punwrap : A }
+
+PWrap has primitive projections with eta conversion.
+For PWrap: Argument scope is [type_scope]
+For pwrap: Argument scopes are [type_scope _]
+punwrap@{K} : forall A : Type@{K}, PWrap@{K} A -> A
+(* K |=  *)
+
+punwrap is universe polymorphic
+Argument scopes are [type_scope _]
+punwrap is transparent
+Expands to: Constant Top.punwrap
+The command has indeed failed with message:
+Universe instance should have length 3
+The command has indeed failed with message:
+Universe instance should have length 0
+The command has indeed failed with message:
+This object does not support universe names.
+The command has indeed failed with message:
+Cannot enforce v < u because u < gU < gV < v
+Monomorphic bind_univs.mono = 
+Type@{bind_univs.mono.u}
+     : Type@{bind_univs.mono.u+1}
+(* {bind_univs.mono.u} |=  *)
+
+bind_univs.mono is not universe polymorphic
+bind_univs.poly@{u} = Type@{u}
+     : Type@{u+1}
+(* u |=  *)
+
+bind_univs.poly is universe polymorphic
+insec@{v} = Type@{u} -> Type@{v}
+     : Type@{max(u+1,v+1)}
+(* v |=  *)
+
+insec is universe polymorphic
+insec@{u v} = Type@{u} -> Type@{v}
+     : Type@{max(u+1,v+1)}
+(* u v |=  *)
+
+insec is universe polymorphic
+inmod@{u} = Type@{u}
+     : Type@{u+1}
+(* u |=  *)
+
+inmod is universe polymorphic
+SomeMod.inmod@{u} = Type@{u}
+     : Type@{u+1}
+(* u |=  *)
+
+SomeMod.inmod is universe polymorphic
+inmod@{u} = Type@{u}
+     : Type@{u+1}
+(* u |=  *)
+
+inmod is universe polymorphic
+Applied.infunct@{u v} = 
+inmod@{u} -> Type@{v}
+     : Type@{max(u+1,v+1)}
+(* u v |=  *)
+
+Applied.infunct is universe polymorphic
+axfoo@{i Top.41 Top.42} : Type@{Top.41} -> Type@{i}
+(* i Top.41 Top.42 |=  *)
+
+axfoo is universe polymorphic
+Argument scope is [type_scope]
+Expands to: Constant Top.axfoo
+axbar@{i Top.41 Top.42} : Type@{Top.42} -> Type@{i}
+(* i Top.41 Top.42 |=  *)
+
+axbar is universe polymorphic
+Argument scope is [type_scope]
+Expands to: Constant Top.axbar
+axfoo' : Type@{Top.44} -> Type@{axbar'.i}
+
+axfoo' is not universe polymorphic
+Argument scope is [type_scope]
+Expands to: Constant Top.axfoo'
+axbar' : Type@{Top.44} -> Type@{axbar'.i}
+
+axbar' is not universe polymorphic
+Argument scope is [type_scope]
+Expands to: Constant Top.axbar'
+The command has indeed failed with message:
+When declaring multiple axioms in one command, only the first is allowed a universe binder (which will be shared by the whole block).
diff --git a/test-suite/output/UnivBinders.v b/test-suite/output/UnivBinders.v
index d9e89e43c..266d94ad9 100644
--- a/test-suite/output/UnivBinders.v
+++ b/test-suite/output/UnivBinders.v
@@ -1,7 +1,146 @@
 Set Universe Polymorphism.
 Set Printing Universes.
+(* Unset Strict Universe Declaration. *)
 
-Class Wrap A := wrap : A.
+(* universe binders on inductive types and record projections *)
+Inductive Empty@{u} : Type@{u} := .
+Print Empty.
 
-Instance bar@{u} : Wrap@{u} Set. Proof nat.
+Set Primitive Projections.
+Record PWrap@{u} (A:Type@{u}) := pwrap { punwrap : A }.
+Print PWrap.
+Print punwrap.
+
+Unset Primitive Projections.
+Record RWrap@{u} (A:Type@{u}) := rwrap { runwrap : A }.
+Print RWrap.
+Print runwrap.
+
+(* universe binders also go on the constants for operational typeclasses. *)
+Class Wrap@{u} (A:Type@{u}) := wrap : A.
+Print Wrap.
+Print wrap.
+
+(* Instance in lemma mode used to ignore the binders. *)
+Instance bar@{u} : Wrap@{u} Set. Proof. exact nat. Qed.
 Print bar.
+
+Unset Strict Universe Declaration.
+(* The universes in the binder come first, then the extra universes in
+   order of appearance. *)
+Definition foo@{u +} := Type -> Type@{v} -> Type@{u}.
+Print foo.
+Set Strict Universe Declaration.
+
+(* Binders even work with monomorphic definitions! *)
+Monomorphic Definition mono@{u} := Type@{u}.
+Print mono.
+Check mono.
+Check Type@{mono.u}.
+
+Module mono.
+  Fail Monomorphic Universe u.
+  Monomorphic Universe MONOU.
+
+  Monomorphic Definition monomono := Type@{MONOU}.
+  Check monomono.
+End mono.
+Check mono.monomono. (* qualified MONOU *)
+Import mono.
+Check monomono. (* unqualified MONOU *)
+Check mono. (* still qualified mono.u *)
+
+Monomorphic Constraint Set < Top.mono.u.
+
+Module mono2.
+  Monomorphic Universe u.
+End mono2.
+
+Fail Monomorphic Definition mono2@{u} := Type@{u}.
+
+Module SecLet.
+  Unset Universe Polymorphism.
+  Section foo.
+    (* Fail Let foo@{} := Type@{u}. (* doesn't parse: Let foo@{...} doesn't exist *) *)
+    Unset Strict Universe Declaration.
+    Let tt : Type@{u} := Type@{v}. (* names disappear in the ether *)
+    Let ff : Type@{u}. Proof. exact Type@{v}. Qed. (* if Set Universe Polymorphism: universes are named ff.u and ff.v. Otherwise names disappear into space *)
+    Definition bobmorane := tt -> ff.
+  End foo.
+  Print bobmorane. (*
+                     bobmorane@{Top.15 Top.16 ff.u ff.v} =
+                     let tt := Type@{Top.16} in let ff := Type@{ff.v} in tt -> ff
+                     : Type@{max(Top.15,ff.u)}
+                     (* Top.15 Top.16 ff.u ff.v |= Top.16 < Top.15
+                     ff.v < ff.u
+                    *)
+
+                    bobmorane is universe polymorphic
+                    *)
+End SecLet.
+
+(* fun x x => foo is nonsense with local binders *)
+Fail Definition fo@{u u} := Type@{u}.
+
+(* Using local binders for printing. *)
+Print foo@{E M N}.
+(* Underscores discard the name if there's one. *)
+Print foo@{_ _ _}.
+
+(* Also works for inductives and records. *)
+Print Empty@{E}.
+Print PWrap@{E}.
+
+(* Also works for About. *)
+About punwrap@{K}.
+
+(* Instance length check. *)
+Fail Print foo@{E}.
+Fail Print mono@{E}.
+
+(* Not everything can be printed with custom universe names. *)
+Fail Print Coq.Init.Logic@{E}.
+
+(* Nice error when constraints are impossible. *)
+Monomorphic Universes gU gV. Monomorphic Constraint gU < gV.
+Fail Lemma foo@{u v|u < gU, gV < v, v < u} : nat.
+
+(* Universe binders survive through compilation, sections and modules. *)
+Require TestSuite.bind_univs.
+Print bind_univs.mono.
+Print bind_univs.poly.
+
+Section SomeSec.
+  Universe u.
+  Definition insec@{v} := Type@{u} -> Type@{v}.
+  Print insec.
+End SomeSec.
+Print insec.
+
+Module SomeMod.
+  Definition inmod@{u} := Type@{u}.
+  Print inmod.
+End SomeMod.
+Print SomeMod.inmod.
+Import SomeMod.
+Print inmod.
+
+Module Type SomeTyp. Definition inmod := Type. End SomeTyp.
+Module SomeFunct (In : SomeTyp).
+  Definition infunct@{u v} := In.inmod@{u} -> Type@{v}.
+End SomeFunct.
+Module Applied := SomeFunct(SomeMod).
+Print Applied.infunct.
+
+(* Multi-axiom declaration
+
+   In polymorphic mode the domain Type gets separate universes for the
+   different axioms, but all axioms have to declare all universes. In
+   polymorphic mode they get the same universes, ie the type is only
+   interpd once. *)
+Axiom axfoo@{i+} axbar : Type -> Type@{i}.
+Monomorphic Axiom axfoo'@{i+} axbar' : Type -> Type@{i}.
+
+About axfoo. About axbar. About axfoo'. About axbar'.
+
+Fail Axiom failfoo failbar@{i} : Type.
diff --git a/test-suite/output/auto.out b/test-suite/output/auto.out
index a5b55a999..2761b87b0 100644
--- a/test-suite/output/auto.out
+++ b/test-suite/output/auto.out
@@ -18,3 +18,5 @@ 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
+(* info trivial: *)
+exact I (in core).
diff --git a/test-suite/output/auto.v b/test-suite/output/auto.v
index a77b7b82e..92917cdfc 100644
--- a/test-suite/output/auto.v
+++ b/test-suite/output/auto.v
@@ -9,3 +9,7 @@ info_eauto.
 Undo.
 debug eauto.
 Qed.
+
+Goal True.
+info_trivial.
+Qed.
diff --git a/test-suite/output/bug5778.out b/test-suite/output/bug5778.out
new file mode 100644
index 000000000..91ceb1b58
--- /dev/null
+++ b/test-suite/output/bug5778.out
@@ -0,0 +1,4 @@
+The command has indeed failed with message:
+In nested Ltac calls to "c", "abs" and "abstract b ltac:(())", last call
+failed.
+The term "I" has type "True" which should be Set, Prop or Type.
diff --git a/test-suite/output/bug5778.v b/test-suite/output/bug5778.v
new file mode 100644
index 000000000..0dcd76aef
--- /dev/null
+++ b/test-suite/output/bug5778.v
@@ -0,0 +1,7 @@
+Ltac a _ := pose (I : I).
+Ltac b _ := a ().
+Ltac abs _ := abstract b ().
+Ltac c _ := abs ().
+Goal True.
+  Fail c ().
+Abort.
diff --git a/test-suite/output/bug6821.out b/test-suite/output/bug6821.out
new file mode 100644
index 000000000..7b12b5320
--- /dev/null
+++ b/test-suite/output/bug6821.out
@@ -0,0 +1,2 @@
+forall f : nat -> Type, f x where x : nat := 1
+     : Type
diff --git a/test-suite/output/bug6821.v b/test-suite/output/bug6821.v
new file mode 100644
index 000000000..40627e331
--- /dev/null
+++ b/test-suite/output/bug6821.v
@@ -0,0 +1,8 @@
+(* Was failing at printing time with stack overflow due to an infinite
+   eta-expansion *)
+
+Notation "x 'where' y .. z := v " :=
+  ((fun y => .. ((fun z => x) v) ..) v)
+  (at level 11, v at next level, y binder, z binder).
+
+Check forall f, f x where x := 1.
diff --git a/test-suite/output/idtac.out b/test-suite/output/idtac.out
new file mode 100644
index 000000000..3855f88a7
--- /dev/null
+++ b/test-suite/output/idtac.out
@@ -0,0 +1,11 @@
+"foo"
+True
+foo
+3
+foo
+2
+< True False Prop >
+< True False Prop >
+<  >
+<  >
+<< 1 2 3 >>
diff --git a/test-suite/output/idtac.v b/test-suite/output/idtac.v
new file mode 100644
index 000000000..ac60ea917
--- /dev/null
+++ b/test-suite/output/idtac.v
@@ -0,0 +1,45 @@
+(* Printing all kinds of Ltac generic arguments *)
+
+Tactic Notation "myidtac" string(v) := idtac v.
+Goal True.
+myidtac "foo".
+Abort.
+
+Tactic Notation "myidtac2" ref(c) := idtac c.
+Goal True.
+myidtac2 True.
+Abort.
+
+Tactic Notation "myidtac3" preident(s) := idtac s.
+Goal True.
+myidtac3 foo.
+Abort.
+
+Tactic Notation "myidtac4" int_or_var(n) := idtac n.
+Goal True.
+myidtac4 3.
+Abort.
+
+Tactic Notation "myidtac5" ident(id) := idtac id.
+Goal True.
+myidtac5 foo.
+Abort.
+
+(* Checking non focussing of idtac for integers *)
+Goal True/\True. split.
+all:let c:=numgoals in idtac c.
+Abort.
+
+(* Checking printing of lists and its focussing *)
+Tactic Notation "myidtac6" constr_list(l) := idtac "<" l ">".
+Goal True/\True. split.
+all:myidtac6 True False Prop.
+(* An empty list is focussing because of interp_genarg of a constr *)
+(* even if it is not focussing on printing *)
+all:myidtac6.
+Abort.
+
+Tactic Notation "myidtac7" int_list(l) := idtac "<<" l ">>".
+Goal True/\True. split.
+all:myidtac7 1 2 3.
+Abort.
diff --git a/test-suite/output/ltac.out b/test-suite/output/ltac.out
index 35c3057d8..eb9f57102 100644
--- a/test-suite/output/ltac.out
+++ b/test-suite/output/ltac.out
@@ -1,7 +1,7 @@
 The command has indeed failed with message:
 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
+  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.
@@ -31,3 +31,10 @@ nat
 nat
 0
 0
+Ltac foo :=
+  let x := intros in
+  let y := intros -> in
+  let v := constr:(nil) in
+  let w := () in
+  let z := 1 in
+  pose v
diff --git a/test-suite/output/ltac.v b/test-suite/output/ltac.v
index 76c37625a..6adbe95dd 100644
--- a/test-suite/output/ltac.v
+++ b/test-suite/output/ltac.v
@@ -57,3 +57,14 @@ 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.
+
+(* Check printing of let in Ltac and Tactic Notation *)
+
+Ltac foo :=
+  let x := intros in
+  let y := intros -> in
+  let v := constr:(@ nil True) in
+  let w := () in
+  let z := 1 in
+  pose v.
+Print Ltac foo.
diff --git a/test-suite/output/ltac_extra_args.out b/test-suite/output/ltac_extra_args.out
new file mode 100644
index 000000000..77e799d35
--- /dev/null
+++ b/test-suite/output/ltac_extra_args.out
@@ -0,0 +1,8 @@
+The command has indeed failed with message:
+Illegal tactic application: got 1 extra argument.
+The command has indeed failed with message:
+Illegal tactic application: got 2 extra arguments.
+The command has indeed failed with message:
+Illegal tactic application: got 1 extra argument.
+The command has indeed failed with message:
+Illegal tactic application: got 2 extra arguments.
diff --git a/test-suite/output/ltac_extra_args.v b/test-suite/output/ltac_extra_args.v
new file mode 100644
index 000000000..4caf619fe
--- /dev/null
+++ b/test-suite/output/ltac_extra_args.v
@@ -0,0 +1,10 @@
+Ltac foo := idtac.
+Ltac bar H := idtac.
+
+Goal True.
+Proof.
+  Fail foo H.
+  Fail foo H H'.
+  Fail bar H H'.
+  Fail bar H H' H''.
+Abort.
diff --git a/test-suite/output/ltac_missing_args.out b/test-suite/output/ltac_missing_args.out
index 172612405..7326f137c 100644
--- a/test-suite/output/ltac_missing_args.out
+++ b/test-suite/output/ltac_missing_args.out
@@ -1,20 +1,40 @@
 The command has indeed failed with message:
-A fully applied tactic is expected: missing argument for variable x.
+The user-defined tactic "Top.foo" was not fully applied:
+There is a missing argument for variable x,
+no arguments at all were provided.
 The command has indeed failed with message:
-A fully applied tactic is expected: missing argument for variable x.
+The user-defined tactic "Top.bar" was not fully applied:
+There is a missing argument for variable x,
+no arguments at all were provided.
 The command has indeed failed with message:
-A fully applied tactic is expected: missing arguments for variables y and _.
+The user-defined tactic "Top.bar" was not fully applied:
+There are missing arguments for variables y and _,
+an argument was provided for variable x.
 The command has indeed failed with message:
-A fully applied tactic is expected: missing argument for variable x.
+The user-defined tactic "Top.baz" was not fully applied:
+There is a missing argument for variable x,
+no arguments at all were provided.
 The command has indeed failed with message:
-A fully applied tactic is expected: missing argument for variable x.
+The user-defined tactic "Top.qux" was not fully applied:
+There is a missing argument for variable x,
+no arguments at all were provided.
 The command has indeed failed with message:
-A fully applied tactic is expected: missing argument for variable _.
+The user-defined tactic "Top.mydo" was not fully applied:
+There is a missing argument for variable _,
+no arguments at all were provided.
 The command has indeed failed with message:
-A fully applied tactic is expected: missing argument for variable _.
+An unnamed user-defined tactic was not fully applied:
+There is a missing argument for variable _,
+no arguments at all were provided.
 The command has indeed failed with message:
-A fully applied tactic is expected: missing argument for variable _.
+An unnamed user-defined tactic was not fully applied:
+There is a missing argument for variable _,
+no arguments at all were provided.
 The command has indeed failed with message:
-A fully applied tactic is expected: missing argument for variable x.
+The user-defined tactic "Top.rec" was not fully applied:
+There is a missing argument for variable x,
+no arguments at all were provided.
 The command has indeed failed with message:
-A fully applied tactic is expected: missing argument for variable x.
+An unnamed user-defined tactic was not fully applied:
+There is a missing argument for variable x,
+an argument was provided for variable tac.
diff --git a/test-suite/output/ltac_missing_args.v b/test-suite/output/ltac_missing_args.v
index 8ecd97aa5..91331a1de 100644
--- a/test-suite/output/ltac_missing_args.v
+++ b/test-suite/output/ltac_missing_args.v
@@ -16,4 +16,4 @@ Goal True.
   Fail (fun _ => idtac).
   Fail rec True.
   Fail let rec tac x := tac in tac True.
-Abort.
\ No newline at end of file
+Abort.
diff --git a/test-suite/output/optimize_heap.out b/test-suite/output/optimize_heap.out
new file mode 100644
index 000000000..94a0b1911
--- /dev/null
+++ b/test-suite/output/optimize_heap.out
@@ -0,0 +1,8 @@
+1 subgoal
+  
+  ============================
+  True
+1 subgoal
+  
+  ============================
+  True
diff --git a/test-suite/output/optimize_heap.v b/test-suite/output/optimize_heap.v
new file mode 100644
index 000000000..e566bd7ba
--- /dev/null
+++ b/test-suite/output/optimize_heap.v
@@ -0,0 +1,7 @@
+(* optimize_heap should not affect the proof state *)
+
+Goal True.
+  idtac.
+  Show.
+  optimize_heap.
+  Show.
diff --git a/test-suite/prerequisite/bind_univs.v b/test-suite/prerequisite/bind_univs.v
new file mode 100644
index 000000000..e834fde11
--- /dev/null
+++ b/test-suite/prerequisite/bind_univs.v
@@ -0,0 +1,7 @@
+(* Used in output/UnivBinders.v *)
+
+Monomorphic Definition mono@{u} := Type@{u}.
+
+Polymorphic Definition poly@{u} := Type@{u}.
+
+Monomorphic Universe reqU.
diff --git a/test-suite/success/Abstract.v b/test-suite/success/Abstract.v
index 69dc9aca7..d52a853aa 100644
--- a/test-suite/success/Abstract.v
+++ b/test-suite/success/Abstract.v
@@ -1,4 +1,4 @@
-(* Cf coqbugs #546 *)
+(* Cf BZ#546 *)
 
 Require Import Omega.
 
diff --git a/test-suite/success/BracketsWithGoalSelector.v b/test-suite/success/BracketsWithGoalSelector.v
new file mode 100644
index 000000000..ed035f521
--- /dev/null
+++ b/test-suite/success/BracketsWithGoalSelector.v
@@ -0,0 +1,16 @@
+Goal forall A B, B \/ A -> A \/ B.
+Proof.
+  intros * [HB | HA].
+  2: {
+    left.
+    exact HA.
+    Fail right. (* No such goal. Try unfocusing with "}". *)
+  }
+  Fail 2: { (* Non-existent goal. *)
+    idtac. (* The idtac is to get a dot, so that IDEs know to stop there. *)
+  1:{ (* Syntactic test: no space before bracket. *)
+    right.
+    exact HB.
+Fail Qed.
+  }
+Qed.
diff --git a/test-suite/success/Check.v b/test-suite/success/Check.v
index 0f677a849..82b51b1ff 100644
--- a/test-suite/success/Check.v
+++ b/test-suite/success/Check.v
@@ -12,3 +12,5 @@
 Check 0.
 Check S.
 Check nat.
+
+Type Type : Type.
diff --git a/test-suite/success/Inductive.v b/test-suite/success/Inductive.v
index f746def5c..893d75b77 100644
--- a/test-suite/success/Inductive.v
+++ b/test-suite/success/Inductive.v
@@ -64,7 +64,7 @@ Check (fun x:I1 =>
   end).
 
 (* Check implicit parameters of inductive types (submitted by Pierre
-  Casteran and also implicit in #338) *)
+  Casteran and also implicit in BZ#338) *)
 
 Set Implicit Arguments.
 Unset Strict Implicit.
@@ -80,7 +80,7 @@ Inductive Finite (A : Set) : LList A -> Prop :=
   | Finite_LCons :
       forall (a : A) (l : LList A), Finite l -> Finite (LCons a l).
 
-(* Check positivity modulo reduction (cf bug #983) *)
+(* Check positivity modulo reduction (cf bug BZ#983) *)
 
 Record P:Type := {PA:Set; PB:Set}.
 
@@ -183,3 +183,20 @@ Module PolyNoLowerProp.
   Fail Check Foo True : Prop.
 
 End PolyNoLowerProp.
+
+(* Test building of elimination scheme with noth let-ins and
+   non-recursively uniform parameters *)
+
+Module NonRecLetIn.
+
+  Unset Implicit Arguments.
+
+  Inductive Ind (b:=2) (a:nat) (c:=1) : Type :=
+  | Base : Ind a
+  | Rec : Ind (S a) -> Ind a.
+
+  Check Ind_rect (fun n (b:Ind n) => b = b)
+    (fun n => eq_refl)
+    (fun n b c => f_equal (Rec n) eq_refl) 0 (Rec 0 (Base 1)).
+
+End NonRecLetIn.
diff --git a/test-suite/success/Inversion.v b/test-suite/success/Inversion.v
index 850f09434..45c71615f 100644
--- a/test-suite/success/Inversion.v
+++ b/test-suite/success/Inversion.v
@@ -1,6 +1,6 @@
 Axiom magic : False.
 
-(* Submitted by Dachuan Yu (bug #220) *)
+(* Submitted by Dachuan Yu (BZ#220) *)
 Fixpoint T (n : nat) : Type :=
   match n with
   | O => nat -> Prop
@@ -16,7 +16,7 @@ Lemma Inversion_RO : forall l : nat, R 0 Psi0 l -> Psi00 l.
 inversion 1.
 Abort.
 
-(* Submitted by Pierre Casteran (bug #540) *)
+(* Submitted by Pierre Casteran (BZ#540) *)
 
 Set Implicit Arguments.
 Unset Strict Implicit.
@@ -64,7 +64,7 @@ elim magic.
 elim magic.
 Qed.
 
-(* Submitted by Boris Yakobowski (bug #529) *)
+(* Submitted by Boris Yakobowski (BZ#529) *)
 (* Check that Inversion does not fail due to unnormalized evars *)
 
 Set Implicit Arguments.
@@ -100,7 +100,7 @@ intros a b H.
 inversion H.
 Abort.
 
-(* Check non-regression of bug #1968 *)
+(* Check non-regression of BZ#1968 *)
 
 Inductive foo2 : option nat -> Prop := Foo : forall t, foo2 (Some t).
 Goal forall o, foo2 o -> 0 = 1.
@@ -130,7 +130,7 @@ Proof.
 intros. inversion H.
 Abort.
 
-(* Bug #2314 (simplified): check that errors do not show as anomalies *)
+(* BZ#2314 (simplified): check that errors do not show as anomalies *)
 
 Goal True -> True.
 intro.
@@ -158,7 +158,7 @@ reflexivity.
 Qed.
 
 (* Up to September 2014, Mapp below was called MApp0 because of a bug
-   in intro_replacing (short version of bug 2164.v)
+   in intro_replacing (short version of BZ#2164.v)
    (example taken from CoLoR) *)
 
 Parameter Term : Type.
diff --git a/test-suite/success/Mod_type.v b/test-suite/success/Mod_type.v
index d5e1a38cf..6c59bf6ed 100644
--- a/test-suite/success/Mod_type.v
+++ b/test-suite/success/Mod_type.v
@@ -1,4 +1,4 @@
-(* Check bug #1025 submitted by Pierre-Luc Carmel Biron *)
+(* Check BZ#1025 submitted by Pierre-Luc Carmel Biron *)
 
 Module Type FOO.
   Parameter A : Type.
@@ -18,7 +18,7 @@ Module Bar : BAR.
 
 End Bar.
 
-(* Check bug #2809: correct printing of modules with notations *)
+(* Check BZ#2809: correct printing of modules with notations *)
 
 Module C.
   Inductive test : Type :=
diff --git a/test-suite/success/Notations.v b/test-suite/success/Notations.v
index 837f2efd0..3c0ad2070 100644
--- a/test-suite/success/Notations.v
+++ b/test-suite/success/Notations.v
@@ -1,5 +1,5 @@
 (* Check that "where" clause behaves as if given independently of the  *)
-(* definition (variant of bug #1132 submitted by Assia Mahboubi) *)
+(* definition (variant of BZ#1132 submitted by Assia Mahboubi) *)
 
 Fixpoint plus1 (n m:nat) {struct n} : nat :=
    match n with
@@ -142,3 +142,14 @@ Fail Notation "'foobarkeyword'" := (@nil) (only parsing, only printing).
 Reserved Notation "x === y" (at level 50).
 Inductive EQ {A} (x:A) : A -> Prop := REFL : x === x
  where "x === y" := (EQ x y).
+
+(* Check that strictly ident or _ are coerced to a name *)
+
+Fail Check {x@{u},y|x=x}.
+Fail Check {?[n],y|0=0}.
+
+(* Check that 10 is well declared left associative *)
+
+Section C.
+Notation "f $$$ x" := (id f x) (at level 10, left associativity).
+End C.
diff --git a/test-suite/success/Notations2.v b/test-suite/success/Notations2.v
index 9505a56e3..7c2cf3ee5 100644
--- a/test-suite/success/Notations2.v
+++ b/test-suite/success/Notations2.v
@@ -90,3 +90,39 @@ Check fun A (x :prod' bool A) => match x with #### 0 y 0 => 2 | _ => 1 end.
 Notation "##### x" := (pair' x) (at level 0, x at level 1).
 Check ##### 0 _ 0%bool 0%bool : prod' bool bool.
 Check fun A (x :prod' bool A) => match x with ##### 0 _ y 0%bool => 2 | _ => 1 end.
+
+(* 10. Check computation of binding variable through other notations *)
+(* it should be detected as binding variable and the scopes not being checked *)
+Notation "'FUNNAT' i => t" := (fun i : nat => i = t) (at level 200).
+Notation "'Funnat' i => t" := (FUNNAT i => t + i%nat) (at level 200).
+
+(* 11. Notations with needed factorization of a recursive pattern *)
+(* See https://github.com/coq/coq/issues/6078#issuecomment-342287412 *)
+Module M11.
+Notation "[:: x1 ; .. ; xn & s ]" := (cons x1 .. (cons xn s) ..).
+Notation "[:: x1 ; .. ; xn ]" := (cons x1 .. (cons xn nil) ..).
+Check [:: 1 ; 2 ; 3 ].
+Check [:: 1 ; 2 ; 3 & nil ]. (* was failing *)
+End M11.
+
+(* 12. Preventively check that a variable which does not occur can be instantiated *)
+(* by any term. In particular, it should not be restricted to a binder *)
+Module M12.
+Notation "N ++ x" := (S x) (only parsing).
+Check 2 ++ 0.
+End M12.
+
+(* 13. Check that internal data about associativity are not used in comparing levels *)
+Module M13.
+Notation "x ;; z" := (x + z)
+  (at level 100, z at level 200, only parsing, right associativity).
+Notation "x ;; z" := (x * z)
+  (at level 100, z at level 200, only parsing) : foo_scope.
+End M13.
+
+(* 14. Check that a notation with a "ident" binder does not include a pattern *)
+Module M14.
+Notation "'myexists' x , p" := (ex (fun x => p))
+  (at level 200, x ident, p at level 200, right associativity) : type_scope.
+Check myexists I, I = 0. (* Should not be seen as a constructor *)
+End M14.
diff --git a/test-suite/success/Omega.v b/test-suite/success/Omega.v
index ecbf04e41..470e4f058 100644
--- a/test-suite/success/Omega.v
+++ b/test-suite/success/Omega.v
@@ -52,7 +52,7 @@ Lemma lem5 : (H > 0)%Z.
 Qed.
 End B.
 
-(* From Nicolas Oury (bug #180): handling -> on Set (fixed Oct 2002) *)
+(* From Nicolas Oury (BZ#180): handling -> on Set (fixed Oct 2002) *)
 Lemma lem6 :
  forall (A : Set) (i : Z), (i <= 0)%Z -> ((i <= 0)%Z -> A) -> (i <= 0)%Z.
 intros.
@@ -86,7 +86,7 @@ intros;  omega.
 Qed.
 
 (* Check that the interpretation of mult on nat enforces its positivity *)
-(* Submitted by Hubert Thierry (bug #743) *)
+(* Submitted by Hubert Thierry (BZ#743) *)
 (* Postponed... problem with goals of the form "(n*m=0)%nat -> (n*m=0)%Z" *)
 Lemma lem10 : forall n m:nat, le n (plus n (mult n m)).
 Proof.
diff --git a/test-suite/success/Omega0.v b/test-suite/success/Omega0.v
index b8f8660e9..6fd936935 100644
--- a/test-suite/success/Omega0.v
+++ b/test-suite/success/Omega0.v
@@ -132,7 +132,7 @@ intros.
 omega.
 Qed.
 
-(* Magaud #240 *)
+(* Magaud BZ#240 *)
 
 Lemma test_romega_8 : forall x y:Z, x*x<y*y-> ~ y*y <= x*x.
 intros.
diff --git a/test-suite/success/Omega2.v b/test-suite/success/Omega2.v
index c4d086a34..4e726335c 100644
--- a/test-suite/success/Omega2.v
+++ b/test-suite/success/Omega2.v
@@ -1,6 +1,6 @@
 Require Import ZArith Omega.
 
-(* Submitted by Yegor Bryukhov (#922) *)
+(* Submitted by Yegor Bryukhov (BZ#922) *)
 
 Open Scope Z_scope.
 
diff --git a/test-suite/success/ProgramWf.v b/test-suite/success/ProgramWf.v
index 681c4716b..85d7a770f 100644
--- a/test-suite/success/ProgramWf.v
+++ b/test-suite/success/ProgramWf.v
@@ -102,4 +102,4 @@ Qed.
 
 Program Fixpoint check_n'  (n : nat) (m : {m:nat | m = n}) (p : nat) (q:{q : nat | q = p})
   {measure (p - n) p} : nat :=
-  _.
\ No newline at end of file
+  _.
diff --git a/test-suite/success/ROmega.v b/test-suite/success/ROmega.v
index 801ece9e3..0df3d5685 100644
--- a/test-suite/success/ROmega.v
+++ b/test-suite/success/ROmega.v
@@ -52,7 +52,7 @@ Lemma lem5 : (H > 0)%Z.
 Qed.
 End B.
 
-(* From Nicolas Oury (bug #180): handling -> on Set (fixed Oct 2002) *)
+(* From Nicolas Oury (BZ#180): handling -> on Set (fixed Oct 2002) *)
 Lemma lem6 :
  forall (A : Set) (i : Z), (i <= 0)%Z -> ((i <= 0)%Z -> A) -> (i <= 0)%Z.
 intros.
@@ -88,7 +88,7 @@ romega with nat.
 Qed.
 
 (* Check that the interpretation of mult on nat enforces its positivity *)
-(* Submitted by Hubert Thierry (bug #743) *)
+(* Submitted by Hubert Thierry (BZ#743) *)
 (* Postponed... problem with goals of the form "(n*m=0)%nat -> (n*m=0)%Z" *)
 Lemma lem10 : forall n m : nat, le n (plus n (mult n m)).
 Proof.
diff --git a/test-suite/success/ROmega0.v b/test-suite/success/ROmega0.v
index 42730f2e1..3ddf6a40f 100644
--- a/test-suite/success/ROmega0.v
+++ b/test-suite/success/ROmega0.v
@@ -132,7 +132,7 @@ intros.
 romega.
 Qed.
 
-(* Magaud #240 *)
+(* Magaud BZ#240 *)
 
 Lemma test_romega_8 : forall x y:Z, x*x<y*y-> ~ y*y <= x*x.
 Proof.
@@ -146,7 +146,7 @@ intros x y.
 romega.
 Qed.
 
-(* Besson #1298 *)
+(* Besson BZ#1298 *)
 
 Lemma test_romega9 : forall z z':Z, z<>z' -> z'=z -> False.
 Proof.
diff --git a/test-suite/success/ROmega2.v b/test-suite/success/ROmega2.v
index 87e8c8e33..43eda67ea 100644
--- a/test-suite/success/ROmega2.v
+++ b/test-suite/success/ROmega2.v
@@ -1,6 +1,6 @@
 Require Import ZArith ROmega.
 
-(* Submitted by Yegor Bryukhov (#922) *)
+(* Submitted by Yegor Bryukhov (BZ#922) *)
 
 Open Scope Z_scope.
 
diff --git a/test-suite/success/ROmega4.v b/test-suite/success/ROmega4.v
new file mode 100644
index 000000000..58ae5b8fb
--- /dev/null
+++ b/test-suite/success/ROmega4.v
@@ -0,0 +1,26 @@
+(** ROmega is now aware of the bodies of context variables
+    (of type Z or nat).
+    See also #148 for the corresponding improvement in Omega.
+*)
+
+Require Import ZArith ROmega.
+Open Scope Z.
+
+Goal let x := 3 in x = 3.
+intros.
+romega.
+Qed.
+
+(** Example seen in #4132
+    (actually solvable even if b isn't known to be 5) *)
+
+Lemma foo
+  (x y x' zxy zxy' z : Z)
+  (b := 5)
+  (Ry : - b <= y < b)
+  (Bx : x' <= b)
+  (H : - zxy' <= zxy)
+  (H' : zxy' <= x') : - b <= zxy.
+Proof.
+romega.
+Qed.
diff --git a/test-suite/success/Rename.v b/test-suite/success/Rename.v
index 0576f3c68..2789c6c9a 100644
--- a/test-suite/success/Rename.v
+++ b/test-suite/success/Rename.v
@@ -4,7 +4,7 @@ rename n into p.
 induction p; auto.
 Qed.
 
-(* Submitted by Iris Loeb (#842) *)
+(* Submitted by Iris Loeb (BZ#842) *)
 
 Section rename.
 
diff --git a/test-suite/success/Try.v b/test-suite/success/Try.v
index 361c787e2..76aac39a5 100644
--- a/test-suite/success/Try.v
+++ b/test-suite/success/Try.v
@@ -1,5 +1,5 @@
 (* To shorten interactive scripts, it is better that Try catches
-   non-existent names in Unfold [cf bug #263] *)
+   non-existent names in Unfold [cf BZ#263] *)
 
 Lemma lem1 : True.
 try unfold i_dont_exist.
diff --git a/test-suite/success/Typeclasses.v b/test-suite/success/Typeclasses.v
index 6b1f0315b..cd6eac35c 100644
--- a/test-suite/success/Typeclasses.v
+++ b/test-suite/success/Typeclasses.v
@@ -240,3 +240,20 @@ Module IterativeDeepening.
   Qed.
 
 End IterativeDeepening.
+
+Module AxiomsAreInstances.
+  Set Typeclasses Axioms Are Instances.
+  Class TestClass1 := {}.
+  Axiom testax1 : TestClass1.
+  Definition testdef1 : TestClass1 := _.
+
+  Unset Typeclasses Axioms Are Instances.
+  Class TestClass2 := {}.
+  Axiom testax2 : TestClass2.
+  Fail Definition testdef2 : TestClass2 := _.
+
+  (* we didn't break typeclasses *)
+  Existing Instance testax2.
+  Definition testdef2 : TestClass2 := _.
+
+End AxiomsAreInstances.
diff --git a/test-suite/success/abstract_poly.v b/test-suite/success/abstract_poly.v
index b736b734f..aa8da5336 100644
--- a/test-suite/success/abstract_poly.v
+++ b/test-suite/success/abstract_poly.v
@@ -17,4 +17,4 @@ intros m n P e p.
 abstract (rewrite e in p; exact p).
 Defined.
 
-Check bar_subproof@{Set Set Set}.
+Check bar_subproof@{Set Set}.
diff --git a/test-suite/success/bteauto.v b/test-suite/success/bteauto.v
index 3178c6fc1..730b367d6 100644
--- a/test-suite/success/bteauto.v
+++ b/test-suite/success/bteauto.v
@@ -55,6 +55,7 @@ Module Backtracking.
     Axiom A : Type.
     Existing Class A.
     Axioms a b c d e: A.
+    Existing Instances a b c d e.
     
     Ltac get_value H := eval cbv delta [H] in H.
     
diff --git a/test-suite/success/cbn.v b/test-suite/success/cbn.v
index 6aeb05f54..c98689c23 100644
--- a/test-suite/success/cbn.v
+++ b/test-suite/success/cbn.v
@@ -15,4 +15,4 @@ Goal forall n, foo (S n) = g n.
   match goal with
     |- g _ = g _ => reflexivity
   end.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/success/clear.v b/test-suite/success/clear.v
index e25510cf0..03034cf13 100644
--- a/test-suite/success/clear.v
+++ b/test-suite/success/clear.v
@@ -30,4 +30,4 @@ Section Foo.
     assert(b:=Build_A).
     solve [ typeclasses eauto ].
   Qed.
-End Foo.
\ No newline at end of file
+End Foo.
diff --git a/test-suite/success/coercions.v b/test-suite/success/coercions.v
index b538d2ed2..9b11bc011 100644
--- a/test-suite/success/coercions.v
+++ b/test-suite/success/coercions.v
@@ -130,4 +130,4 @@ Local Coercion l2v2 : list >-> vect.
    of coercions *)
 Fail Check (fun l : list (T1 * T1) => (l : vect _ _)).
 Check (fun l : list (T1 * T1) => (l2v2 l : vect _ _)).
-Section what_we_could_do.
\ No newline at end of file
+Section what_we_could_do.
diff --git a/test-suite/success/cumulativity.v b/test-suite/success/cumulativity.v
index 0ee85712e..e05762477 100644
--- a/test-suite/success/cumulativity.v
+++ b/test-suite/success/cumulativity.v
@@ -45,6 +45,15 @@ Section TpLift.
 
 End TpLift.
 
+Record Tp' := { tp' : Tp }.
+
+Definition CTp := Tp.
+(* here we have to reduce a constant to infer the correct subtyping. *)
+Record Tp'' := { tp'' : CTp }.
+
+Definition LiftTp'@{i j|i < j} : Tp'@{i} -> Tp'@{j} := fun x => x.
+Definition LiftTp''@{i j|i < j} : Tp''@{i} -> Tp''@{j} := fun x => x.
+
 Lemma LiftC_Lem (t : Tp) : LiftTp t = t.
 Proof. reflexivity. Qed.
 
@@ -98,3 +107,30 @@ Section down.
     intros H f g Hfg. exact (H f g Hfg).
   Defined.
 End down.
+
+Record Arrow@{i j} := { arrow : Type@{i} -> Type@{j} }.
+
+Fail Definition arrow_lift@{i i' j j' | i' < i, j < j'}
+  : Arrow@{i j} -> Arrow@{i' j'}
+  := fun x => x.
+
+Definition arrow_lift@{i i' j j' | i' = i, j < j'}
+  : Arrow@{i j} -> Arrow@{i' j'}
+  := fun x => x.
+
+Inductive Mut1 A :=
+| Base1 : Type -> Mut1 A
+| Node1 : (A -> Mut2 A) -> Mut1 A
+with Mut2 A :=
+     | Base2 : Type -> Mut2 A
+     | Node2 : Mut1 A -> Mut2 A.
+
+(* If we don't reduce T while inferring cumulativity for the
+   constructor we will see a Rel and believe i is irrelevant. *)
+Inductive withparams@{i j} (T:=Type@{i}:Type@{j}) := mkwithparams : T -> withparams.
+
+Definition withparams_co@{i i' j|i < i', i' < j} : withparams@{i j} -> withparams@{i' j}
+  := fun x => x.
+
+Fail Definition withparams_not_irr@{i i' j|i' < i, i' < j} : withparams@{i j} -> withparams@{i' j}
+  := fun x => x.
diff --git a/test-suite/success/destruct.v b/test-suite/success/destruct.v
index 90a60daa6..6fbe61a9b 100644
--- a/test-suite/success/destruct.v
+++ b/test-suite/success/destruct.v
@@ -12,7 +12,7 @@ assumption.
 assumption.
 Qed.
 
-(* Simplification of bug 711 *)
+(* Simplification of BZ#711 *)
 
 Parameter f : true = false.
 Goal let p := f in True.
@@ -37,7 +37,7 @@ Goal True.
 case Refl || ecase Refl.
 Abort.
 
-(* Submitted by B. Baydemir (bug #1882) *)
+(* Submitted by B. Baydemir (BZ#1882) *)
 
 Require Import List.
 
@@ -385,7 +385,7 @@ intros.
 Fail destruct H.
 Abort.
 
-(* Check keep option (bug #3791) *)
+(* Check keep option (BZ#3791) *)
 
 Goal forall b:bool, True.
 intro b.
@@ -430,3 +430,9 @@ eexists ?[x].
 destruct (S _).
 change (0 = ?x).
 Abort.
+
+Goal (forall P, P 0 -> True/\True) -> True.
+intro H.
+destruct (H (fun x => True)).
+match goal with |- True => idtac end.
+Abort.
diff --git a/test-suite/success/dtauto-let-deps.v b/test-suite/success/dtauto-let-deps.v
new file mode 100644
index 000000000..094b2f8b3
--- /dev/null
+++ b/test-suite/success/dtauto-let-deps.v
@@ -0,0 +1,24 @@
+(*
+This test is sensitive to changes in which let-ins are expanded when checking
+for dependencies in constructors.
+If the (x := X) is not reduced, Foo1 won't be recognized as a conjunction,
+and if the (y := X) is reduced, Foo2 will be recognized as a conjunction.
+
+This tests the behavior of engine/termops.ml : prod_applist_assum,
+which is currently specified to reduce exactly the parameters.
+
+If dtauto is changed to reduce lets in constructors before checking dependency,
+this test will need to be changed.
+*)
+
+Context (P Q : Type).
+Inductive Foo1 (X : Type) (x := X) := foo1 : let y := X in P -> Q -> Foo1 x.
+Inductive Foo2 (X : Type) (x := X) := foo2 : let y := X in P -> Q -> Foo2 y.
+
+Goal P -> Q -> Foo1 nat.
+solve [dtauto].
+Qed.
+
+Goal P -> Q -> Foo2 nat.
+Fail solve [dtauto].
+Abort.
diff --git a/test-suite/success/evars.v b/test-suite/success/evars.v
index c36313ec1..627794832 100644
--- a/test-suite/success/evars.v
+++ b/test-suite/success/evars.v
@@ -23,7 +23,7 @@ Definition f1 frm0 a1 : B := f frm0 a1.
 (* Checks that solvable ? in the type part of the definition are harmless *)
 Definition f2 frm0 a1 : B := f frm0 a1.
 
-(* Checks that sorts that are evars are handled correctly (bug 705) *)
+(* Checks that sorts that are evars are handled correctly (BZ#705) *)
 Require Import List.
 
 Fixpoint build (nl : list nat) :
@@ -58,7 +58,7 @@ Check
     (forall y n : nat, {q : nat | y = q * n}) ->
     forall n : nat, {q : nat | x = q * n}).
 
-(* Check instantiation of nested evars (bug #1089) *)
+(* Check instantiation of nested evars (BZ#1089) *)
 
 Check (fun f:(forall (v:Type->Type), v (v nat) -> nat) => f _ (Some (Some O))).
 
@@ -188,7 +188,7 @@ Abort.
 
 End Additions_while.
 
-(* Two examples from G. Melquiond (bugs #1878 and #1884) *)
+(* Two examples from G. Melquiond (BZ#1878 and BZ#1884) *)
 
 Parameter F1 G1 : nat -> Prop.
 Goal forall x : nat, F1 x -> G1 x.
@@ -207,7 +207,7 @@ Fixpoint filter (A:nat->Set) (l:list (sigT A)) : list (sigT A) :=
   | (existT _ k v)::l' => (existT _ k v):: (filter A l')
   end.
 
-(* Bug #2000: used to raise Out of memory in 8.2 while it should fail by
+(* BZ#2000: used to raise Out of memory in 8.2 while it should fail by
    lack of information on the conclusion of the type of j *)
 
 Goal True.
@@ -381,7 +381,7 @@ Section evar_evar_occur.
   Check match g _ with conj a b => f _ a b end.
 End evar_evar_occur.
 
-(* Eta expansion (bug #2936) *)
+(* Eta expansion (BZ#2936) *)
 Record iffT (X Y:Type) : Type := mkIff { iffLR : X->Y; iffRL : Y->X }.
 Record tri (R:Type->Type->Type) (S:Type->Type->Type) (T:Type->Type->Type) := mkTri {
   tri0 : forall a b c, R a b -> S a c -> T b c
diff --git a/test-suite/success/extraction.v b/test-suite/success/extraction.v
index 0ee223250..83726bfdc 100644
--- a/test-suite/success/extraction.v
+++ b/test-suite/success/extraction.v
@@ -635,6 +635,6 @@ Recursive Extraction Everything.
 
 Require Import ZArith.
 
-Extraction Language Ocaml.
+Extraction Language OCaml.
 Recursive Extraction Z_modulo_2 Zdiv_eucl_exist.
 Extraction TestCompile Z_modulo_2 Zdiv_eucl_exist.
diff --git a/test-suite/success/guard.v b/test-suite/success/guard.v
index b9181d430..3a1c6dabe 100644
--- a/test-suite/success/guard.v
+++ b/test-suite/success/guard.v
@@ -9,3 +9,20 @@ Check let x (f:nat->nat) k := f k in
         | 0 => 0
         | S k => f F k (* here Rel 3 = F ! *)
         end.
+
+(** Commutation of guard condition allows recursive calls on functional arguments,
+    despite rewriting in their domain types.  *)
+Inductive foo : Type -> Type :=
+| End A : foo A
+| Next A : (A -> foo A) -> foo A.
+
+Definition nat : Type := nat.
+
+Fixpoint bar (A : Type) (e : nat = A) (f : foo A) {struct f} : nat :=
+match f with
+| End _ => fun _ => O
+| Next A g => fun e =>
+    match e in (_ = B) return (B -> foo A) -> nat with
+    | eq_refl => fun (g' : nat -> foo A) => bar A e (g' O)
+    end g
+end e.
diff --git a/test-suite/success/hintdb_in_ltac_bis.v b/test-suite/success/hintdb_in_ltac_bis.v
index f5c25540e..2bc3f9d22 100644
--- a/test-suite/success/hintdb_in_ltac_bis.v
+++ b/test-suite/success/hintdb_in_ltac_bis.v
@@ -12,4 +12,4 @@ Goal Foo.
   progress foo mybase.
   Undo.
   progress bar mybase.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/success/if.v b/test-suite/success/if.v
index 9fde95e80..c81d2b9bf 100644
--- a/test-suite/success/if.v
+++ b/test-suite/success/if.v
@@ -3,7 +3,7 @@
 
 Check (fun b : bool => if b then Type else nat).
 
-(* Check correct use of if-then-else predicate annotation (cf bug 690) *)
+(* Check correct use of if-then-else predicate annotation (cf BZ#690) *)
 
 Check fun b : bool =>
  if b as b0 return (if b0 then b0 = true else b0 = false)
diff --git a/test-suite/success/indelim.v b/test-suite/success/indelim.v
index 91b6dee2e..a962c29f4 100644
--- a/test-suite/success/indelim.v
+++ b/test-suite/success/indelim.v
@@ -58,4 +58,4 @@ Inductive color := Red | Black.
 
 Inductive option (A : Type) : Type :=
 | None : option A
-| Some : A -> option A.
\ No newline at end of file
+| Some : A -> option A.
diff --git a/test-suite/success/intros.v b/test-suite/success/intros.v
index ee69df977..a329894aa 100644
--- a/test-suite/success/intros.v
+++ b/test-suite/success/intros.v
@@ -1,5 +1,5 @@
 (* Thinning introduction hypothesis must be done after all introductions *)
-(* Submitted by Guillaume Melquiond (bug #1000) *)
+(* Submitted by Guillaume Melquiond (BZ#1000) *)
 
 Goal forall A, A -> True.
 intros _ _.
diff --git a/test-suite/success/keyedrewrite.v b/test-suite/success/keyedrewrite.v
index b88c142be..5638a7d3e 100644
--- a/test-suite/success/keyedrewrite.v
+++ b/test-suite/success/keyedrewrite.v
@@ -59,4 +59,4 @@ Qed.
    Lemma test b : b && true = b.
     Fail rewrite andb_true_l.
    Admitted.
-   
\ No newline at end of file
+   
diff --git a/test-suite/success/ltac.v b/test-suite/success/ltac.v
index 29e373eaa..0f22a1f0a 100644
--- a/test-suite/success/ltac.v
+++ b/test-suite/success/ltac.v
@@ -147,7 +147,7 @@ check_binding ipattern:(H).
 Abort.
 
 (* Check that variables explicitly parsed as ltac variables are not
-   seen as intro pattern or constr (bug #984) *)
+   seen as intro pattern or constr (BZ#984) *)
 
 Ltac afi tac := intros; tac.
 Goal 1 = 2.
diff --git a/test-suite/success/ltac_match_pattern_names.v b/test-suite/success/ltac_match_pattern_names.v
index 736329496..790cd1b3a 100644
--- a/test-suite/success/ltac_match_pattern_names.v
+++ b/test-suite/success/ltac_match_pattern_names.v
@@ -25,4 +25,4 @@ Ltac multiple_branches :=
     let P := fresh P in
     let Q := fresh Q in
     idtac
-  end.
\ No newline at end of file
+  end.
diff --git a/test-suite/success/ltac_plus.v b/test-suite/success/ltac_plus.v
index 8a08d6465..01d477bdf 100644
--- a/test-suite/success/ltac_plus.v
+++ b/test-suite/success/ltac_plus.v
@@ -9,4 +9,4 @@ Proof.
   Fail ((apply h0+apply h2) || apply h1); apply h3.
   (* interaction with || *)
   ((apply h0+apply h1) || apply h2); apply h3.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/success/polymorphism.v b/test-suite/success/polymorphism.v
index ecc988507..d76b30791 100644
--- a/test-suite/success/polymorphism.v
+++ b/test-suite/success/polymorphism.v
@@ -156,6 +156,58 @@ Polymorphic Definition twoprojs (d : dyn) := dyn_proof d = dyn_proof d.
 
 End structures.
 
+
+Module binders.
+
+  Definition mynat@{|} := nat.
+
+  Definition foo@{i j | i < j, i < j} (A : Type@{i}) : Type@{j}.
+    exact A.
+  Defined.
+
+  Definition nomoreu@{i j | i < j +} (A : Type@{i}) : Type@{j}.
+    pose(foo:=Type).
+    exact A.
+    Fail Defined.
+  Abort.
+
+  Polymorphic Definition moreu@{i j +} (A : Type@{i}) : Type@{j}.
+    pose(foo:=Type).
+    exact A.
+  Defined.
+
+  Check moreu@{_ _ _ _}.
+  
+  Fail Definition morec@{i j|} (A : Type@{i}) : Type@{j} := A.
+
+  (* By default constraints are extensible *)
+  Polymorphic Definition morec@{i j} (A : Type@{i}) : Type@{j} := A.
+  Check morec@{_ _}.
+
+  (* Handled in proofs as well *)
+  Lemma bar@{i j | } : Type@{i}.
+    exact Type@{j}.
+    Fail Defined.
+  Abort.
+
+  Fail Lemma bar@{u v | } : let x := (fun x => x) : Type@{u} -> Type@{v} in nat.
+
+  Lemma bar@{i j| i < j} : Type@{j}.
+  Proof.
+    exact Type@{i}.
+  Qed.
+
+  Lemma barext@{i j|+} : Type@{j}.
+  Proof.
+    exact Type@{i}.
+  Qed.
+
+  Monomorphic Universe M.
+  Fail Definition with_mono@{u|} : Type@{M} := Type@{u}.
+  Definition with_mono@{u|u < M} : Type@{M} := Type@{u}.
+
+End binders.
+    
 Section cats.
   Local Set Universe Polymorphism.
   Require Import Utf8.
@@ -353,6 +405,31 @@ Module Anonymous.
 
 End Anonymous.
 
+Module Restrict.
+  (* Universes which don't appear in the term should be pruned, unless they have names *)
+  Set Universe Polymorphism.
+
+  Ltac exact0 := let x := constr:(Type) in exact 0.
+  Definition dummy_pruned@{} : nat := ltac:(exact0).
+
+  Definition named_not_pruned@{u} : nat := 0.
+  Check named_not_pruned@{_}.
+
+  Definition named_not_pruned_nonstrict : nat := ltac:(let x := constr:(Type@{u}) in exact 0).
+  Check named_not_pruned_nonstrict@{_}.
+
+  Lemma lemma_restrict_poly@{} : nat.
+  Proof. exact0. Defined.
+
+  Unset Universe Polymorphism.
+  Lemma lemma_restrict_mono_qed@{} : nat.
+  Proof. exact0. Qed.
+
+  Lemma lemma_restrict_abstract@{} : nat.
+  Proof. abstract exact0. Qed.
+
+End Restrict.
+
 Module F.
   Context {A B : Type}.
   Definition foo : Type := B.
@@ -384,3 +461,10 @@ Section test_letin_subtyping.
   Qed.
 
 End test_letin_subtyping.
+
+Module ObligationRegression.
+  (** Test for a regression encountered when fixing obligations for
+      stronger restriction of universe context. *)
+  Require Import CMorphisms.
+  Check trans_co_eq_inv_arrow_morphism@{_ _ _ _ _  _ _ _}.
+End ObligationRegression.
diff --git a/test-suite/success/programequality.v b/test-suite/success/programequality.v
index 414c572f8..05f4a7185 100644
--- a/test-suite/success/programequality.v
+++ b/test-suite/success/programequality.v
@@ -10,4 +10,4 @@ Proof.
   pi_eq_proofs. clear e.
   destruct e'. simpl.
   change (P a eq_refl).
-Abort.
\ No newline at end of file
+Abort.
diff --git a/test-suite/success/qed_export.v b/test-suite/success/qed_export.v
deleted file mode 100644
index b3e41ab1f..000000000
--- a/test-suite/success/qed_export.v
+++ /dev/null
@@ -1,18 +0,0 @@
-Lemma a : True.
-Proof.
-assert True as H.
-  abstract (trivial) using exported_seff.
-exact H.
-Fail Qed exporting a_subproof.
-Qed exporting exported_seff.
-Check ( exported_seff : True ).
-
-Lemma b : True.
-Proof.
-assert True as H.
-  abstract (trivial) using exported_seff2.
-exact H.
-Qed.
-
-Fail Check ( exported_seff2 : True ).
-
diff --git a/test-suite/success/refine.v b/test-suite/success/refine.v
index 352abb2af..22fb4d757 100644
--- a/test-suite/success/refine.v
+++ b/test-suite/success/refine.v
@@ -31,7 +31,7 @@ Proof.
   end).
 Abort.
 
-(* Submitted by Roland Zumkeller (bug #888) *)
+(* Submitted by Roland Zumkeller (BZ#888) *)
 
 (* The Fix and CoFix rules expect a subgoal even for closed components of the
    (co-)fixpoint *)
@@ -43,7 +43,7 @@ Goal nat -> nat.
 exact 0.
 Qed.
 
-(* Submitted by Roland Zumkeller (bug #889) *)
+(* Submitted by Roland Zumkeller (BZ#889) *)
 
 (* The types of metas were in metamap and they were not updated when
    passing through a binder *)
@@ -56,7 +56,7 @@ Goal forall n : nat, nat -> n = 0.
                                       end).
 Abort.
 
-(* Submitted by Roland Zumkeller (bug #931) *)
+(* Submitted by Roland Zumkeller (BZ#931) *)
 (* Don't turn dependent evar into metas *)
 
 Goal (forall n : nat, n = 0 -> Prop) -> Prop.
@@ -65,7 +65,7 @@ intro P.
 reflexivity.
 Abort.
 
-(* Submitted by Jacek Chrzaszcz (bug #1102) *)
+(* Submitted by Jacek Chrzaszcz (BZ#1102) *)
 
 (* le problème a été résolu ici par normalisation des evars présentes
    dans les types d'evars, mais le problème reste a priori ouvert dans
@@ -122,3 +122,13 @@ Abort.
 
 Goal (forall A : Prop, A -> ~~A).
 Proof. refine(fun A a f => _).
+
+(* Checking beta-iota normalization of hypotheses in created evars *)
+
+Goal {x|x=0} -> True.
+refine (fun y => let (x,a) := y in _).
+match goal with a:_=0 |- _ => idtac end.
+
+Goal (forall P, {P 0}+{P 1}) -> True.
+refine (fun H => if H (fun x => x=x) then _ else _).
+match goal with _:0=0 |- _ => idtac end.
diff --git a/test-suite/success/rewrite_dep.v b/test-suite/success/rewrite_dep.v
index d0aafd383..d73864e4e 100644
--- a/test-suite/success/rewrite_dep.v
+++ b/test-suite/success/rewrite_dep.v
@@ -31,4 +31,4 @@ Proof.
   intros.
   rewrite H0.
   reflexivity.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/test-suite/success/rewrite_strat.v b/test-suite/success/rewrite_strat.v
index 04c675563..a6e59fdda 100644
--- a/test-suite/success/rewrite_strat.v
+++ b/test-suite/success/rewrite_strat.v
@@ -50,4 +50,4 @@ Proof.
 Time Qed. (* 0.06 s *)
 
 Set Printing All.
-Set Printing Depth 100000.
\ No newline at end of file
+Set Printing Depth 100000.
diff --git a/test-suite/success/setoid_test.v b/test-suite/success/setoid_test.v
index 1f24ef2a6..c8dfcd2cb 100644
--- a/test-suite/success/setoid_test.v
+++ b/test-suite/success/setoid_test.v
@@ -33,7 +33,8 @@ Qed.
 
 Add Setoid set same setoid_set as setsetoid.
 
-Add Morphism In : In_ext.
+Add Morphism In with signature (eq ==> same ==> iff) as In_ext.
+Proof.
 unfold same; intros a s t H; elim (H a); auto.
 Qed.
 
@@ -50,10 +51,9 @@ simpl; right.
 apply (H2 H1).
 Qed.
 
-Add Morphism Add : Add_ext.
+Add Morphism Add with signature (eq ==> same ==> same) as Add_ext.
 split; apply add_aux.
 assumption.
-
 rewrite H.
 reflexivity.
 Qed.
@@ -90,7 +90,7 @@ Qed.
 Parameter P : set -> Prop.
 Parameter P_ext : forall s t : set, same s t -> P s -> P t.
 
-Add Morphism P : P_extt.
+Add Morphism P with signature (same ==> iff) as P_extt.
 intros; split; apply P_ext; (assumption || apply (Seq_sym _ _ setoid_set); assumption).
 Qed.
 
@@ -113,7 +113,7 @@ Definition f: forall A : Set, A -> A := fun A x => x.
 
 Add Relation (id A) (rel A) as eq_rel.
 
-Add Morphism (@f A) : f_morph.
+Add Morphism (@f A) with signature (eq ==> eq) as f_morph.
 Proof.
 unfold rel, f. trivial.
 Qed.
diff --git a/test-suite/success/setoid_test2.v b/test-suite/success/setoid_test2.v
index 6baf79701..79467e549 100644
--- a/test-suite/success/setoid_test2.v
+++ b/test-suite/success/setoid_test2.v
@@ -134,8 +134,8 @@ Axiom SetoidS2 : Setoid_Theory S2 eqS2.
 Add Setoid S2 eqS2 SetoidS2 as S2setoid.
 
 Axiom f : S1 -> nat -> S2.
-Add Morphism f : f_compat. Admitted.
-Add Morphism f : f_compat2. Admitted.
+Add Morphism f with signature (eqS1 ==> eq ==> eqS2) as f_compat. Admitted.
+Add Morphism f with signature (eqS1 ==> eq ==> eqS2) as f_compat2. Admitted.
 
 Theorem test1: forall x y, (eqS1 x y) -> (eqS2 (f x 0) (f y 0)).
  intros.
@@ -151,7 +151,7 @@ Theorem test1': forall x y, (eqS1 x y) -> (eqS2 (f x 0) (f y 0)).
 Qed.
 
 Axiom g : S1 -> S2 -> nat.
-Add Morphism g : g_compat. Admitted.
+Add Morphism g with signature (eqS1 ==> eqS2 ==> eq) as g_compat. Admitted.
 
 Axiom P : nat -> Prop.
 Theorem test2:
@@ -190,13 +190,13 @@ Theorem test5:
 Qed.
 
 Axiom f_test6 : S2 -> Prop.
-Add Morphism f_test6 : f_test6_compat. Admitted.
+Add Morphism f_test6 with signature (eqS2 ==> iff) as f_test6_compat. Admitted.
 
 Axiom g_test6 : bool -> S2.
-Add Morphism g_test6 : g_test6_compat. Admitted.
+Add Morphism g_test6 with signature (eq ==> eqS2) as g_test6_compat. Admitted.
 
 Axiom h_test6 : S1 -> bool.
-Add Morphism h_test6 : h_test6_compat. Admitted.
+Add Morphism h_test6 with signature (eqS1 ==> eq) as h_test6_compat. Admitted.
 
 Theorem test6:
  forall E1 E2, (eqS1 E1 E2) -> (f_test6 (g_test6 (h_test6 E2))) ->
@@ -223,7 +223,7 @@ Add Setoid S1_test8 eqS1_test8 SetoidS1_test8 as S1_test8setoid.
 Instance eqS1_test8_default : DefaultRelation eqS1_test8.
 
 Axiom f_test8 : S2 -> S1_test8.
-Add Morphism f_test8 : f_compat_test8. Admitted.
+Add Morphism f_test8 with signature (eqS2 ==> eqS1_test8) as f_compat_test8. Admitted.
 
 Axiom eqS1_test8': S1_test8 -> S1_test8 -> Prop.
 Axiom SetoidS1_test8' : Setoid_Theory S1_test8 eqS1_test8'.
@@ -233,7 +233,7 @@ Add Setoid S1_test8 eqS1_test8' SetoidS1_test8' as S1_test8setoid'.
   (S1_test8, eqS1_test8'). However this does not happen and
   there is still no syntax for it ;-( *)
 Axiom g_test8 : S1_test8 -> S2.
-Add Morphism g_test8 : g_compat_test8. Admitted.
+Add Morphism g_test8 with signature (eqS1_test8 ==> eqS2) as g_compat_test8. Admitted.
 
 Theorem test8:
  forall x x': S2, (eqS2 x x') ->
diff --git a/test-suite/success/simpl.v b/test-suite/success/simpl.v
index 5b87e877b..1bfb8580b 100644
--- a/test-suite/success/simpl.v
+++ b/test-suite/success/simpl.v
@@ -1,6 +1,6 @@
 Require Import TestSuite.admit.
 (* Check that inversion of names of mutual inductive fixpoints works *)
-(* (cf bug #1031) *)
+(* (cf BZ#1031) *)
 
 Inductive tree : Set :=
 | node : nat -> forest -> tree
diff --git a/test-suite/success/unidecls.v b/test-suite/success/unidecls.v
new file mode 100644
index 000000000..c4a1d7c28
--- /dev/null
+++ b/test-suite/success/unidecls.v
@@ -0,0 +1,121 @@
+Set Printing Universes.
+
+Module unidecls.
+  Universes a b.
+End unidecls.
+
+Universe a.
+
+Constraint a < unidecls.a.
+
+Print Universes.
+
+(** These are different universes *)
+Check Type@{a}.
+Check Type@{unidecls.a}.
+
+Check Type@{unidecls.b}.
+
+Fail Check Type@{unidecls.c}.
+
+Fail Check Type@{i}.
+Universe foo.
+Module Foo.
+  (** Already declared globaly: but universe names are scoped at the module level  *)
+  Universe foo.
+  Universe bar.
+
+  Check Type@{Foo.foo}.
+  Definition bar := 0.
+End Foo.
+
+(** Already declared in the module *)
+Universe bar.
+
+(** Accessible outside the module: universe declarations are global *)
+Check Type@{bar}.
+Check Type@{Foo.bar}.
+
+Check Type@{Foo.foo}.
+(** The same *)
+Check Type@{foo}.
+Check Type@{Top.foo}.
+
+Universe secfoo.
+Section Foo'.
+  Fail Universe secfoo.
+  Universe secfoo2.
+  Check Type@{Foo'.secfoo2}.
+  Constraint secfoo2 < a.
+End Foo'.
+
+Check Type@{secfoo2}.
+Fail Check Type@{Foo'.secfoo2}.
+Fail Check eq_refl : Type@{secfoo2} = Type@{a}.
+
+(** Below, u and v are global, fixed universes *)
+Module Type Arg.
+  Universe u.
+  Parameter T: Type@{u}.
+End Arg.
+
+Module Fn(A : Arg).
+  Universes v.
+
+  Check Type@{A.u}.
+  Constraint A.u < v.
+
+  Definition foo : Type@{v} := nat.
+  Definition bar : Type@{A.u} := nat.
+
+  Fail Definition foo(A : Type@{v}) : Type@{A.u} := A.
+End Fn.
+
+Module ArgImpl : Arg.
+  Definition T := nat.
+End ArgImpl.
+
+Module ArgImpl2 : Arg.
+  Definition T := bool.
+End ArgImpl2.
+
+(** Two applications of the functor result in the exact same universes *)
+Module FnApp := Fn(ArgImpl).
+
+Check Type@{FnApp.v}.
+Check FnApp.foo.
+Check FnApp.bar.
+
+Check (eq_refl : Type@{ArgImpl.u} = Type@{ArgImpl2.u}).
+
+Module FnApp2 := Fn(ArgImpl).
+Check Type@{FnApp2.v}.
+Check FnApp2.foo.
+Check FnApp2.bar.
+
+Import ArgImpl2.
+(** Now u refers to ArgImpl.u and ArgImpl2.u *)
+Check FnApp2.bar.
+
+(** It can be shadowed *)
+Universe u.
+
+(** This refers to the qualified name *)
+Check FnApp2.bar.
+
+Constraint u = ArgImpl.u.
+Print Universes.
+
+Set Universe Polymorphism.
+
+Section PS.
+  Universe poly.
+
+  Definition id (A : Type@{poly}) (a : A) : A := a.
+End PS.
+(** The universe is polymorphic and discharged, does not persist *)
+Fail Check Type@{poly}.
+
+Print Universes.
+Check id nat.
+Check id@{Set}.
diff --git a/test-suite/success/unification.v b/test-suite/success/unification.v
index 6f7498d65..1ffc02673 100644
--- a/test-suite/success/unification.v
+++ b/test-suite/success/unification.v
@@ -43,7 +43,7 @@ Check (fun _h1 => (zenon_notall nat _ (fun _T_0 =>
           (fun _h2 => (zenon_noteq _ _T_0 _h2))) _h1)).
 
 
-(* Core of an example submitted by Ralph Matthes (#849)
+(* Core of an example submitted by Ralph Matthes (BZ#849)
 
    It used to fail because of the K-variable x in the type of "sum_rec ..."
    which was not in the scope of the evar ?B. Solved by a head
@@ -131,7 +131,7 @@ try case nonemptyT_intro. (* check that it fails w/o anomaly *)
 Abort.
 
 (* Test handling of return type and when it is decided to make the
-   predicate dependent or not - see "bug" #1851 *)
+   predicate dependent or not - see "bug" BZ#1851 *)
 
 Goal forall X (a:X) (f':nat -> X), (exists f : nat -> X, True).
 intros.
diff --git a/test-suite/success/univers.v b/test-suite/success/univers.v
index 269359ae6..286340459 100644
--- a/test-suite/success/univers.v
+++ b/test-suite/success/univers.v
@@ -20,8 +20,7 @@ intro P; pattern P.
 apply lem2.
 Abort.
 
-(* Check managing of universe constraints in inversion *)
-(* Bug report #855 *)
+(* Check managing of universe constraints in inversion (BZ#855) *)
 
 Inductive dep_eq : forall X : Type, X -> X -> Prop :=
   | intro_eq : forall (X : Type) (f : X), dep_eq X f f
@@ -40,7 +39,7 @@ Proof.
 Abort.
 
 
-(* Submitted by Bas Spitters (bug report #935) *)
+(* Submitted by Bas Spitters (BZ#935) *)
 
 (* This is a problem with the status of the type in LetIn: is it a
    user-provided one or an inferred one? At the current time, the
@@ -76,4 +75,4 @@ End Ind.
 Module Rec.
 Record box_in : myType :=
   BoxIn { coord :> nat * nat; _ : is_box_in_shape coord }.
-End Rec.
\ No newline at end of file
+End Rec.
diff --git a/test-suite/success/unshelve.v b/test-suite/success/unshelve.v
index 672222bdd..a4fa544cd 100644
--- a/test-suite/success/unshelve.v
+++ b/test-suite/success/unshelve.v
@@ -9,3 +9,11 @@ unshelve (refine (F _ _ _ _)).
 + exact (@eq_refl bool true).
 + exact (@eq_refl unit tt).
 Qed.
+
+(* This was failing in 8.6, because of ?a:nat being wrongly duplicated *)
+
+Goal (forall a : nat, a = 0 -> True) -> True.
+intros F.
+unshelve (eapply (F _);clear F).
+2:reflexivity.
+Qed.
diff --git a/test-suite/typeclasses/deftwice.v b/test-suite/typeclasses/deftwice.v
index 439782c9e..139447702 100644
--- a/test-suite/typeclasses/deftwice.v
+++ b/test-suite/typeclasses/deftwice.v
@@ -6,4 +6,4 @@ Instance inhab_C : C Type := Inhab.
 
 Variable full : forall A (X : C A), forall x : A, c x.
 
-Definition truc {A : Type} : Inhab A := (full _ _ _).
\ No newline at end of file
+Definition truc {A : Type} : Inhab A := (full _ _ _).
diff --git a/test-suite/typeclasses/unification_delta.v b/test-suite/typeclasses/unification_delta.v
index 663a837f3..518912433 100644
--- a/test-suite/typeclasses/unification_delta.v
+++ b/test-suite/typeclasses/unification_delta.v
@@ -43,4 +43,4 @@ Proof.
   (* Breaks if too much delta in unification *)
   rewrite H.
   reflexivity.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/.dir-locals.el b/theories/.dir-locals.el
deleted file mode 100644
index 4e8830f6c..000000000
--- a/theories/.dir-locals.el
+++ /dev/null
@@ -1,4 +0,0 @@
-((coq-mode . ((eval . (let ((default-directory (locate-dominating-file
-						buffer-file-name ".dir-locals.el")))
-			(setq-local coq-prog-args `("-coqlib" ,(expand-file-name "..") "-R" ,(expand-file-name ".") "Coq"))
-			(setq-local coq-prog-name (expand-file-name "../bin/coqtop")))))))
diff --git a/theories/Arith/Between.v b/theories/Arith/Between.v
index 9b4071085..ead08b3eb 100644
--- a/theories/Arith/Between.v
+++ b/theories/Arith/Between.v
@@ -16,6 +16,8 @@ Implicit Types k l p q r : nat.
 Section Between.
   Variables P Q : nat -> Prop.
 
+  (** The [between] type expresses the concept
+      [forall i: nat, k <= i < l -> P i.]. *)
   Inductive between k : nat -> Prop :=
     | bet_emp : between k k
     | bet_S : forall l, between k l -> P l -> between k (S l).
@@ -47,6 +49,8 @@ Section Between.
     induction 1; auto with arith.
   Qed.
 
+  (** The [exists_between] type expresses the concept
+      [exists i: nat, k <= i < l /\ Q i]. *)
   Inductive exists_between k : nat -> Prop :=
     | exists_S : forall l, exists_between k l -> exists_between k (S l)
     | exists_le : forall l, k <= l -> Q l -> exists_between k (S l).
diff --git a/theories/Arith/Lt.v b/theories/Arith/Lt.v
index 035c4e466..2c2bea4a6 100644
--- a/theories/Arith/Lt.v
+++ b/theories/Arith/Lt.v
@@ -107,6 +107,11 @@ Proof.
  intros. symmetry. now apply Nat.lt_succ_pred with m.
 Qed.
 
+Lemma S_pred_pos n: O < n -> n = S (pred n).
+Proof.
+ apply S_pred.
+Qed.
+
 Lemma lt_pred n m : S n < m -> n < pred m.
 Proof.
  apply Nat.lt_succ_lt_pred.
diff --git a/theories/Arith/PeanoNat.v b/theories/Arith/PeanoNat.v
index bde6f1bb4..68060900c 100644
--- a/theories/Arith/PeanoNat.v
+++ b/theories/Arith/PeanoNat.v
@@ -724,6 +724,26 @@ Definition shiftr_spec a n m (_:0<=m) := shiftr_specif a n m.
 
 Include NExtraProp.
 
+(** Properties of tail-recursive addition and multiplication *)
+
+Lemma tail_add_spec n m : tail_add n m = n + m.
+Proof.
+ revert m. induction n as [|n IH]; simpl; trivial.
+ intros. now rewrite IH, add_succ_r.
+Qed.
+
+Lemma tail_addmul_spec r n m : tail_addmul r n m = r + n * m.
+Proof.
+ revert m r. induction n as [| n IH]; simpl; trivial.
+ intros. rewrite IH, tail_add_spec.
+ rewrite add_assoc. f_equal. apply add_comm.
+Qed.
+
+Lemma tail_mul_spec n m : tail_mul n m = n * m.
+Proof.
+ unfold tail_mul. now rewrite tail_addmul_spec.
+Qed.
+
 End Nat.
 
 (** Re-export notations that should be available even when
diff --git a/theories/Arith/Peano_dec.v b/theories/Arith/Peano_dec.v
index 88cda79d8..247ea20a8 100644
--- a/theories/Arith/Peano_dec.v
+++ b/theories/Arith/Peano_dec.v
@@ -57,4 +57,4 @@ now rewrite H.
 Qed.
 
 (** For compatibility *)
-Require Import Le Lt.
\ No newline at end of file
+Require Import Le Lt.
diff --git a/theories/Compat/Coq87.v b/theories/Compat/Coq87.v
index 61e911678..aeef9595d 100644
--- a/theories/Compat/Coq87.v
+++ b/theories/Compat/Coq87.v
@@ -7,3 +7,14 @@
 (************************************************************************)
 
 (** Compatibility file for making Coq act similar to Coq v8.7 *)
+
+(* In 8.7, omega wasn't taking advantage of local abbreviations,
+   see bug 148 and PR#768. For adjusting this flag, we're forced to
+   first dynlink the omega plugin, but we should avoid doing a full
+   "Require Omega", since it has some undesired effects (at least on hints)
+   and breaks at least fiat-crypto. *)
+Declare ML Module "omega_plugin".
+Unset Omega UseLocalDefs.
+
+
+Set Typeclasses Axioms Are Instances.
diff --git a/theories/FSets/FSetCompat.v b/theories/FSets/FSetCompat.v
index b1769da3d..31bc1cc31 100644
--- a/theories/FSets/FSetCompat.v
+++ b/theories/FSets/FSetCompat.v
@@ -165,13 +165,13 @@ End Backport_WSets.
 (** * From new Sets to new ones *)
 
 Module Backport_Sets
- (E:OrderedType.OrderedType)
- (M:MSetInterface.Sets with Definition E.t := E.t
-                       with Definition E.eq := E.eq
-                       with Definition E.lt := E.lt)
- <: FSetInterface.S with Module E:=E.
+ (O:OrderedType.OrderedType)
+ (M:MSetInterface.Sets with Definition E.t := O.t
+                       with Definition E.eq := O.eq
+                       with Definition E.lt := O.lt)
+ <: FSetInterface.S with Module E:=O.
 
-  Include Backport_WSets E M.
+  Include Backport_WSets O M.
 
   Implicit Type s : t.
   Implicit Type x y : elt.
@@ -182,21 +182,21 @@ Module Backport_Sets
   Definition min_elt_1 : forall s x, min_elt s = Some x -> In x s
    := M.min_elt_spec1.
   Definition min_elt_2 : forall s x y,
-   min_elt s = Some x -> In y s -> ~ E.lt y x
+   min_elt s = Some x -> In y s -> ~ O.lt y x
    := M.min_elt_spec2.
   Definition min_elt_3 : forall s, min_elt s = None -> Empty s
    := M.min_elt_spec3.
   Definition max_elt_1 : forall s x, max_elt s = Some x -> In x s
    := M.max_elt_spec1.
   Definition max_elt_2 : forall s x y,
-   max_elt s = Some x -> In y s -> ~ E.lt x y
+   max_elt s = Some x -> In y s -> ~ O.lt x y
    := M.max_elt_spec2.
   Definition max_elt_3 : forall s, max_elt s = None -> Empty s
    := M.max_elt_spec3.
-  Definition elements_3 : forall s, sort E.lt (elements s)
+  Definition elements_3 : forall s, sort O.lt (elements s)
    := M.elements_spec2.
   Definition choose_3 : forall s s' x y,
-   choose s = Some x -> choose s' = Some y -> Equal s s' -> E.eq x y
+   choose s = Some x -> choose s' = Some y -> Equal s s' -> O.eq x y
    := M.choose_spec3.
   Definition lt_trans : forall s s' s'', lt s s' -> lt s' s'' -> lt s s''
    := @StrictOrder_Transitive _ _ M.lt_strorder.
@@ -211,7 +211,7 @@ Module Backport_Sets
     [ apply EQ | apply LT | apply GT ]; auto.
   Defined.
 
-  Module E := E.
+  Module E := O.
 
 End Backport_Sets.
 
@@ -342,13 +342,13 @@ End Update_WSets.
 (** * From old Sets to new ones. *)
 
 Module Update_Sets
- (E:Orders.OrderedType)
- (M:FSetInterface.S with Definition E.t := E.t
-                    with Definition E.eq := E.eq
-                    with Definition E.lt := E.lt)
- <: MSetInterface.Sets with Module E:=E.
+ (O:Orders.OrderedType)
+ (M:FSetInterface.S with Definition E.t := O.t
+                    with Definition E.eq := O.eq
+                    with Definition E.lt := O.lt)
+ <: MSetInterface.Sets with Module E:=O.
 
-  Include Update_WSets E M.
+  Include Update_WSets O M.
 
   Implicit Type s : t.
   Implicit Type x y : elt.
@@ -359,21 +359,21 @@ Module Update_Sets
   Definition min_elt_spec1 : forall s x, min_elt s = Some x -> In x s
    := M.min_elt_1.
   Definition min_elt_spec2 : forall s x y,
-   min_elt s = Some x -> In y s -> ~ E.lt y x
+   min_elt s = Some x -> In y s -> ~ O.lt y x
    := M.min_elt_2.
   Definition min_elt_spec3 : forall s, min_elt s = None -> Empty s
    := M.min_elt_3.
   Definition max_elt_spec1 : forall s x, max_elt s = Some x -> In x s
    := M.max_elt_1.
   Definition max_elt_spec2 : forall s x y,
-   max_elt s = Some x -> In y s -> ~ E.lt x y
+   max_elt s = Some x -> In y s -> ~ O.lt x y
    := M.max_elt_2.
   Definition max_elt_spec3 : forall s, max_elt s = None -> Empty s
    := M.max_elt_3.
-  Definition elements_spec2 : forall s, sort E.lt (elements s)
+  Definition elements_spec2 : forall s, sort O.lt (elements s)
    := M.elements_3.
   Definition choose_spec3 : forall s s' x y,
-   choose s = Some x -> choose s' = Some y -> Equal s s' -> E.eq x y
+   choose s = Some x -> choose s' = Some y -> Equal s s' -> O.eq x y
    := M.choose_3.
 
   Instance lt_strorder : StrictOrder lt.
@@ -407,6 +407,6 @@ Module Update_Sets
   Lemma compare_spec : forall s s', CompSpec eq lt s s' (compare s s').
   Proof. intros; unfold compare; destruct M.compare; auto. Qed.
 
-  Module E := E.
+  Module E := O.
 
 End Update_Sets.
diff --git a/theories/FSets/FSetProperties.v b/theories/FSets/FSetProperties.v
index 25b042ca9..0041bfa1c 100644
--- a/theories/FSets/FSetProperties.v
+++ b/theories/FSets/FSetProperties.v
@@ -762,7 +762,7 @@ Module WProperties_fun (Import E : DecidableType)(M : WSfun E).
   rewrite (cardinal_2 (s:=remove x s') (s':=s') (x:=x)); eauto with set.
   Qed.
 
-  Add Morphism cardinal : cardinal_m.
+  Add Morphism cardinal with signature (Equal ==> Logic.eq) as cardinal_m.
   Proof.
   exact Equal_cardinal.
   Qed.
diff --git a/theories/FSets/FSets.v b/theories/FSets/FSets.v
index 572f28654..e03fb2236 100644
--- a/theories/FSets/FSets.v
+++ b/theories/FSets/FSets.v
@@ -20,4 +20,4 @@ Require Export FSetEqProperties.
 Require Export FSetWeakList.
 Require Export FSetList.
 Require Export FSetPositive.
-Require Export FSetAVL.
\ No newline at end of file
+Require Export FSetAVL.
diff --git a/theories/Init/Decimal.v b/theories/Init/Decimal.v
new file mode 100644
index 000000000..fa462f147
--- /dev/null
+++ b/theories/Init/Decimal.v
@@ -0,0 +1,161 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(** * Decimal numbers *)
+
+(** These numbers coded in base 10 will be used for parsing and printing
+    other Coq numeral datatypes in an human-readable way.
+    See the [Numeral Notation] command.
+    We represent numbers in base 10 as lists of decimal digits,
+    in big-endian order (most significant digit comes first). *)
+
+(** Unsigned integers are just lists of digits.
+    For instance, ten is (D1 (D0 Nil)) *)
+
+Inductive uint :=
+ | Nil
+ | D0 (_:uint)
+ | D1 (_:uint)
+ | D2 (_:uint)
+ | D3 (_:uint)
+ | D4 (_:uint)
+ | D5 (_:uint)
+ | D6 (_:uint)
+ | D7 (_:uint)
+ | D8 (_:uint)
+ | D9 (_:uint).
+
+(** [Nil] is the number terminator. Taken alone, it behaves as zero,
+    but rather use [D0 Nil] instead, since this form will be denoted
+    as [0], while [Nil] will be printed as [Nil]. *)
+
+Notation zero := (D0 Nil).
+
+(** For signed integers, we use two constructors [Pos] and [Neg]. *)
+
+Inductive int := Pos (d:uint) | Neg (d:uint).
+
+Delimit Scope uint_scope with uint.
+Bind Scope uint_scope with uint.
+Delimit Scope int_scope with int.
+Bind Scope int_scope with int.
+
+(** This representation favors simplicity over canonicity.
+    For normalizing numbers, we need to remove head zero digits,
+    and choose our canonical representation of 0 (here [D0 Nil]
+    for unsigned numbers and [Pos (D0 Nil)] for signed numbers). *)
+
+(** [nzhead] removes all head zero digits *)
+
+Fixpoint nzhead d :=
+  match d with
+  | D0 d => nzhead d
+  | _ => d
+  end.
+
+(** [unorm] : normalization of unsigned integers *)
+
+Definition unorm d :=
+  match nzhead d with
+  | Nil => zero
+  | d => d
+  end.
+
+(** [norm] : normalization of signed integers *)
+
+Definition norm d :=
+  match d with
+  | Pos d => Pos (unorm d)
+  | Neg d =>
+    match nzhead d with
+    | Nil => Pos zero
+    | d => Neg d
+    end
+  end.
+
+(** A few easy operations. For more advanced computations, use the conversions
+    with other Coq numeral datatypes (e.g. Z) and the operations on them. *)
+
+Definition opp (d:int) :=
+  match d with
+  | Pos d => Neg d
+  | Neg d => Pos d
+  end.
+
+(** For conversions with binary numbers, it is easier to operate
+    on little-endian numbers. *)
+
+Fixpoint revapp (d d' : uint) :=
+  match d with
+  | Nil => d'
+  | D0 d => revapp d (D0 d')
+  | D1 d => revapp d (D1 d')
+  | D2 d => revapp d (D2 d')
+  | D3 d => revapp d (D3 d')
+  | D4 d => revapp d (D4 d')
+  | D5 d => revapp d (D5 d')
+  | D6 d => revapp d (D6 d')
+  | D7 d => revapp d (D7 d')
+  | D8 d => revapp d (D8 d')
+  | D9 d => revapp d (D9 d')
+  end.
+
+Definition rev d := revapp d Nil.
+
+Module Little.
+
+(** Successor of little-endian numbers *)
+
+Fixpoint succ d :=
+  match d with
+  | Nil => D1 Nil
+  | D0 d => D1 d
+  | D1 d => D2 d
+  | D2 d => D3 d
+  | D3 d => D4 d
+  | D4 d => D5 d
+  | D5 d => D6 d
+  | D6 d => D7 d
+  | D7 d => D8 d
+  | D8 d => D9 d
+  | D9 d => D0 (succ d)
+  end.
+
+(** Doubling little-endian numbers *)
+
+Fixpoint double d :=
+  match d with
+  | Nil => Nil
+  | D0 d => D0 (double d)
+  | D1 d => D2 (double d)
+  | D2 d => D4 (double d)
+  | D3 d => D6 (double d)
+  | D4 d => D8 (double d)
+  | D5 d => D0 (succ_double d)
+  | D6 d => D2 (succ_double d)
+  | D7 d => D4 (succ_double d)
+  | D8 d => D6 (succ_double d)
+  | D9 d => D8 (succ_double d)
+  end
+
+with succ_double d :=
+  match d with
+  | Nil => D1 Nil
+  | D0 d => D1 (double d)
+  | D1 d => D3 (double d)
+  | D2 d => D5 (double d)
+  | D3 d => D7 (double d)
+  | D4 d => D9 (double d)
+  | D5 d => D1 (succ_double d)
+  | D6 d => D3 (succ_double d)
+  | D7 d => D5 (succ_double d)
+  | D8 d => D7 (succ_double d)
+  | D9 d => D9 (succ_double d)
+  end.
+
+End Little.
diff --git a/theories/Init/Logic.v b/theories/Init/Logic.v
index 037d37daf..053ed601f 100644
--- a/theories/Init/Logic.v
+++ b/theories/Init/Logic.v
@@ -267,6 +267,13 @@ Notation "'exists2' x : A , p & q" := (ex2 (A:=A) (fun x => p) (fun x => q))
     format "'[' 'exists2'  '/  ' x  :  A ,  '/  ' '[' p  &  '/' q ']' ']'")
   : type_scope.
 
+Notation "'exists2' ' x , p & q" := (ex2 (fun x => p) (fun x => q))
+  (at level 200, x strict pattern, p at level 200, right associativity) : type_scope.
+Notation "'exists2' ' x : A , p & q" := (ex2 (A:=A) (fun x => p) (fun x => q))
+  (at level 200, x strict pattern, A at level 200, p at level 200, right associativity,
+    format "'[' 'exists2'  '/  ' ' x  :  A ,  '/  ' '[' p  &  '/' q ']' ']'")
+  : type_scope.
+
 (** Derived rules for universal quantification *)
 
 Section universal_quantification.
diff --git a/theories/Init/Nat.v b/theories/Init/Nat.v
index e942ca562..8f2648269 100644
--- a/theories/Init/Nat.v
+++ b/theories/Init/Nat.v
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 Require Import Notations Logic Datatypes.
-
+Require Decimal.
 Local Open Scope nat_scope.
 
 (**********************************************************************)
@@ -134,6 +134,62 @@ Fixpoint pow n m :=
 
 where "n ^ m" := (pow n m) : nat_scope.
 
+(** ** Tail-recursive versions of [add] and [mul] *)
+
+Fixpoint tail_add n m :=
+  match n with
+    | O => m
+    | S n => tail_add n (S m)
+  end.
+
+(** [tail_addmul r n m] is [r + n * m]. *)
+
+Fixpoint tail_addmul r n m :=
+  match n with
+    | O => r
+    | S n => tail_addmul (tail_add m r) n m
+  end.
+
+Definition tail_mul n m := tail_addmul 0 n m.
+
+(** ** Conversion with a decimal representation for printing/parsing *)
+
+Local Notation ten := (S (S (S (S (S (S (S (S (S (S O)))))))))).
+
+Fixpoint of_uint_acc (d:Decimal.uint)(acc:nat) :=
+  match d with
+  | Decimal.Nil => acc
+  | Decimal.D0 d => of_uint_acc d (tail_mul ten acc)
+  | Decimal.D1 d => of_uint_acc d (S (tail_mul ten acc))
+  | Decimal.D2 d => of_uint_acc d (S (S (tail_mul ten acc)))
+  | Decimal.D3 d => of_uint_acc d (S (S (S (tail_mul ten acc))))
+  | Decimal.D4 d => of_uint_acc d (S (S (S (S (tail_mul ten acc)))))
+  | Decimal.D5 d => of_uint_acc d (S (S (S (S (S (tail_mul ten acc))))))
+  | Decimal.D6 d => of_uint_acc d (S (S (S (S (S (S (tail_mul ten acc)))))))
+  | Decimal.D7 d => of_uint_acc d (S (S (S (S (S (S (S (tail_mul ten acc))))))))
+  | Decimal.D8 d => of_uint_acc d (S (S (S (S (S (S (S (S (tail_mul ten acc)))))))))
+  | Decimal.D9 d => of_uint_acc d (S (S (S (S (S (S (S (S (S (tail_mul ten acc))))))))))
+  end.
+
+Definition of_uint (d:Decimal.uint) := of_uint_acc d O.
+
+Fixpoint to_little_uint n acc :=
+  match n with
+  | O => acc
+  | S n => to_little_uint n (Decimal.Little.succ acc)
+  end.
+
+Definition to_uint n :=
+  Decimal.rev (to_little_uint n Decimal.zero).
+
+Definition of_int (d:Decimal.int) : option nat :=
+  match Decimal.norm d with
+    | Decimal.Pos u => Some (of_uint u)
+    | _ => None
+  end.
+
+Definition to_int n := Decimal.Pos (to_uint n).
+
 (** ** Euclidean division *)
 
 (** This division is linear and tail-recursive.
diff --git a/theories/Init/Notations.v b/theories/Init/Notations.v
index 5e8d2faa5..a9051e761 100644
--- a/theories/Init/Notations.v
+++ b/theories/Init/Notations.v
@@ -78,6 +78,33 @@ Reserved Notation "{ x : A  |  P  & Q }" (at level 0, x at level 99).
 Reserved Notation "{ x : A  & P }" (at level 0, x at level 99).
 Reserved Notation "{ x : A  & P  & Q }" (at level 0, x at level 99).
 
+Reserved Notation "{ ' pat | P }"
+  (at level 0, pat strict pattern, format "{ ' pat  |  P  }").
+Reserved Notation "{ ' pat | P & Q }"
+  (at level 0, pat strict pattern, format "{ ' pat  |  P  & Q }").
+
+Reserved Notation "{ ' pat : A | P }"
+  (at level 0, pat strict pattern, format "{ ' pat  :  A  |  P }").
+Reserved Notation "{ ' pat : A | P & Q }"
+  (at level 0, pat strict pattern, format "{ ' pat  :  A  |  P  & Q }").
+
+Reserved Notation "{ ' pat : A & P }"
+  (at level 0, pat strict pattern, format "{ ' pat  :  A  & P }").
+Reserved Notation "{ ' pat : A & P & Q }"
+  (at level 0, pat strict pattern, format "{ ' pat  :  A  & P  & Q }").
+
+(** Support for Gonthier-Ssreflect's "if c is pat then u else v" *)
+
+Module IfNotations.
+
+Notation "'if' c 'is' p 'then' u 'else' v" :=
+  (match c with p => u | _ => v end)
+  (at level 200, p pattern at level 100).
+
+End IfNotations.
+
+(** Scopes *)
+
 Delimit Scope type_scope with type.
 Delimit Scope function_scope with function.
 Delimit Scope core_scope with core.
diff --git a/theories/Init/Prelude.v b/theories/Init/Prelude.v
index f0867a034..63c431e8e 100644
--- a/theories/Init/Prelude.v
+++ b/theories/Init/Prelude.v
@@ -11,6 +11,7 @@ Require Export Logic.
 Require Export Logic_Type.
 Require Export Datatypes.
 Require Export Specif.
+Require Coq.Init.Decimal.
 Require Coq.Init.Nat.
 Require Export Peano.
 Require Export Coq.Init.Wf.
diff --git a/theories/Init/Specif.v b/theories/Init/Specif.v
index 3b4f833a3..47e8a7558 100644
--- a/theories/Init/Specif.v
+++ b/theories/Init/Specif.v
@@ -53,6 +53,15 @@ Notation "{ x : A  & P }" := (sigT (A:=A) (fun x => P)) : type_scope.
 Notation "{ x : A  & P  & Q }" := (sigT2 (A:=A) (fun x => P) (fun x => Q)) :
   type_scope.
 
+Notation "{ ' pat  |  P }" := (sig (fun pat => P)) : type_scope.
+Notation "{ ' pat  |  P  & Q }" := (sig2 (fun pat => P) (fun pat => Q)) : type_scope.
+Notation "{ ' pat : A  |  P }" := (sig (A:=A) (fun pat => P)) : type_scope.
+Notation "{ ' pat : A  |  P  & Q }" := (sig2 (A:=A) (fun pat => P) (fun pat => Q)) :
+  type_scope.
+Notation "{ ' pat : A  & P }" := (sigT (A:=A) (fun pat => P)) : type_scope.
+Notation "{ ' pat : A  & P  & Q }" := (sigT2 (A:=A) (fun pat => P) (fun pat => Q)) :
+  type_scope.
+
 Add Printing Let sig.
 Add Printing Let sig2.
 Add Printing Let sigT.
diff --git a/theories/Init/Tactics.v b/theories/Init/Tactics.v
index 5d0e7602a..47a971ef0 100644
--- a/theories/Init/Tactics.v
+++ b/theories/Init/Tactics.v
@@ -306,3 +306,10 @@ Ltac inversion_sigma_step :=
     => induction_sigma_in_using H @eq_sigT2_rect
   end.
 Ltac inversion_sigma := repeat inversion_sigma_step.
+
+(** A version of [time] that works for constrs *)
+Ltac time_constr tac :=
+  let eval_early := match goal with _ => restart_timer end in
+  let ret := tac () in
+  let eval_early := match goal with _ => finish_timing ( "Tactic evaluation" ) end in
+  ret.
diff --git a/theories/Init/Tauto.v b/theories/Init/Tauto.v
index 886533586..87b7a9a3b 100644
--- a/theories/Init/Tauto.v
+++ b/theories/Init/Tauto.v
@@ -27,7 +27,7 @@ Local Ltac simplif flags :=
       | id: ?X1 |- _ => is_disj flags X1; elim id; intro; clear id
       | id0: (forall (_: ?X1), ?X2), id1: ?X1|- _ =>
     (* generalize (id0 id1); intro; clear id0 does not work
-       (see Marco Maggiesi's bug PR#301)
+       (see Marco Maggiesi's BZ#301)
     so we instead use Assert and exact. *)
     assert X2; [exact (id0 id1) | clear id0]
       | id: forall (_ : ?X1), ?X2|- _ =>
diff --git a/theories/Lists/List.v b/theories/Lists/List.v
index fbf992dbf..eae2c52de 100644
--- a/theories/Lists/List.v
+++ b/theories/Lists/List.v
@@ -2110,13 +2110,13 @@ Section Exists_Forall.
       {Exists l} + {~ Exists l}.
     Proof.
       intro Pdec. induction l as [|a l' Hrec].
-      - right. now rewrite Exists_nil.
+      - right. abstract now rewrite Exists_nil.
       - destruct Hrec as [Hl'|Hl'].
         * left. now apply Exists_cons_tl.
         * destruct (Pdec a) as [Ha|Ha].
           + left. now apply Exists_cons_hd.
-          + right. now inversion_clear 1.
-    Qed.
+          + right. abstract now inversion 1.
+    Defined.
 
     Inductive Forall : list A -> Prop :=
       | Forall_nil : Forall nil
@@ -2152,9 +2152,9 @@ Section Exists_Forall.
       - destruct Hrec as [Hl'|Hl'].
         + destruct (Pdec a) as [Ha|Ha].
           * left. now apply Forall_cons.
-          * right. now inversion_clear 1.
-        + right. now inversion_clear 1.
-    Qed.
+          * right. abstract now inversion 1.
+        + right. abstract now inversion 1.
+    Defined.
 
   End One_predicate.
 
@@ -2179,6 +2179,16 @@ Section Exists_Forall.
        * now apply Exists_cons_hd.
   Qed.
 
+  Lemma neg_Forall_Exists_neg (P:A->Prop) (l:list A) :
+    (forall x:A, {P x} + { ~ P x }) ->
+    ~ Forall P l ->
+    Exists (fun x => ~ P x) l.
+  Proof.
+    intro Dec.
+    apply Exists_Forall_neg; intros.
+    destruct (Dec x); auto.
+  Qed.
+
   Lemma Forall_Exists_dec (P:A->Prop) :
     (forall x:A, {P x} + { ~ P x }) ->
     forall l:list A,
@@ -2186,9 +2196,8 @@ Section Exists_Forall.
   Proof.
     intros Pdec l.
     destruct (Forall_dec P Pdec l); [left|right]; trivial.
-    apply Exists_Forall_neg; trivial.
-    intro x. destruct (Pdec x); [now left|now right].
-  Qed.
+    now apply neg_Forall_Exists_neg.
+  Defined.
 
   Lemma Forall_impl : forall (P Q : A -> Prop), (forall a, P a -> Q a) ->
     forall l, Forall P l -> Forall Q l.
diff --git a/theories/Logic/Classical_Prop.v b/theories/Logic/Classical_Prop.v
index f7b53f1dc..a5ae07b64 100644
--- a/theories/Logic/Classical_Prop.v
+++ b/theories/Logic/Classical_Prop.v
@@ -97,12 +97,12 @@ Proof proof_irrelevance_cci classic.
 (* classical_left  transforms |- A \/ B into ~B |- A *)
 (* classical_right transforms |- A \/ B into ~A |- B *)
 
-Ltac classical_right :=  match goal with
- | _:_ |-?X1 \/ _ => (elim (classic X1);intro;[left;trivial|right])
+Ltac classical_right := match goal with
+|- ?X \/ _ => (elim (classic X);intro;[left;trivial|right])
 end.
 
 Ltac classical_left := match goal with
-| _:_ |- _ \/?X1 => (elim (classic X1);intro;[right;trivial|left])
+|- _ \/ ?X => (elim (classic X);intro;[right;trivial|left])
 end.
 
 Require Export EqdepFacts.
diff --git a/theories/Logic/FunctionalExtensionality.v b/theories/Logic/FunctionalExtensionality.v
index ac95ddd0c..82b04d132 100644
--- a/theories/Logic/FunctionalExtensionality.v
+++ b/theories/Logic/FunctionalExtensionality.v
@@ -221,13 +221,12 @@ Tactic Notation "extensionality" "in" hyp(H) :=
   (* 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. *)
+(** Eta expansion is built into Coq. *)
 
 Lemma eta_expansion_dep {A} {B : A -> Type} (f : forall x : A, B x) :
   f = fun x => f x.
 Proof.
   intros.
-  extensionality x.
   reflexivity.
 Qed.
 
diff --git a/theories/MSets/MSetGenTree.v b/theories/MSets/MSetGenTree.v
index 036ff1aa4..9fb8e499b 100644
--- a/theories/MSets/MSetGenTree.v
+++ b/theories/MSets/MSetGenTree.v
@@ -1144,4 +1144,4 @@ Proof.
  apply mindepth_cardinal.
 Qed.
 
-End Props.
\ No newline at end of file
+End Props.
diff --git a/theories/MSets/MSets.v b/theories/MSets/MSets.v
index f179bcd1d..1ee485cc1 100644
--- a/theories/MSets/MSets.v
+++ b/theories/MSets/MSets.v
@@ -18,4 +18,4 @@ Require Export MSetEqProperties.
 Require Export MSetWeakList.
 Require Export MSetList.
 Require Export MSetPositive.
-Require Export MSetAVL.
\ No newline at end of file
+Require Export MSetAVL.
diff --git a/theories/NArith/BinNatDef.v b/theories/NArith/BinNatDef.v
index ba923d062..e07758914 100644
--- a/theories/NArith/BinNatDef.v
+++ b/theories/NArith/BinNatDef.v
@@ -378,4 +378,22 @@ Definition iter (n:N) {A} (f:A->A) (x:A) : A :=
     | pos p => Pos.iter f x p
   end.
 
-End N.
\ No newline at end of file
+(** Conversion with a decimal representation for printing/parsing *)
+
+Definition of_uint (d:Decimal.uint) := Pos.of_uint d.
+
+Definition of_int (d:Decimal.int) :=
+  match Decimal.norm d with
+  | Decimal.Pos d => Some (Pos.of_uint d)
+  | Decimal.Neg _ => None
+  end.
+
+Definition to_uint n :=
+  match n with
+  | 0 => Decimal.zero
+  | pos p => Pos.to_uint p
+  end.
+
+Definition to_int n := Decimal.Pos (to_uint n).
+
+End N.
diff --git a/theories/Numbers/DecimalFacts.v b/theories/Numbers/DecimalFacts.v
new file mode 100644
index 000000000..3eef63c7f
--- /dev/null
+++ b/theories/Numbers/DecimalFacts.v
@@ -0,0 +1,141 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(** * DecimalFacts : some facts about Decimal numbers *)
+
+Require Import Decimal.
+
+Lemma uint_dec (d d' : uint) : { d = d' } + { d <> d' }.
+Proof.
+ decide equality.
+Defined.
+
+Lemma rev_revapp d d' :
+ rev (revapp d d') = revapp d' d.
+Proof.
+ revert d'. induction d; simpl; intros; now rewrite ?IHd.
+Qed.
+
+Lemma rev_rev d : rev (rev d) = d.
+Proof.
+ apply rev_revapp.
+Qed.
+
+(** Normalization on little-endian numbers *)
+
+Fixpoint nztail d :=
+ match d with
+ | Nil => Nil
+ | D0 d => match nztail d with Nil => Nil | d' => D0 d' end
+ | D1 d => D1 (nztail d)
+ | D2 d => D2 (nztail d)
+ | D3 d => D3 (nztail d)
+ | D4 d => D4 (nztail d)
+ | D5 d => D5 (nztail d)
+ | D6 d => D6 (nztail d)
+ | D7 d => D7 (nztail d)
+ | D8 d => D8 (nztail d)
+ | D9 d => D9 (nztail d)
+ end.
+
+Definition lnorm d :=
+ match nztail d with
+ | Nil => zero
+ | d => d
+ end.
+
+Lemma nzhead_revapp_0 d d' : nztail d = Nil ->
+ nzhead (revapp d d') = nzhead d'.
+Proof.
+ revert d'. induction d; intros d' [=]; simpl; trivial.
+ destruct (nztail d); now rewrite IHd.
+Qed.
+
+Lemma nzhead_revapp d d' : nztail d <> Nil ->
+ nzhead (revapp d d') = revapp (nztail d) d'.
+Proof.
+ revert d'.
+ induction d; intros d' H; simpl in *;
+ try destruct (nztail d) eqn:E;
+  (now rewrite ?nzhead_revapp_0) || (now rewrite IHd).
+Qed.
+
+Lemma nzhead_rev d : nztail d <> Nil ->
+ nzhead (rev d) = rev (nztail d).
+Proof.
+ apply nzhead_revapp.
+Qed.
+
+Lemma rev_nztail_rev d :
+  rev (nztail (rev d)) = nzhead d.
+Proof.
+ destruct (uint_dec (nztail (rev d)) Nil) as [H|H].
+ - rewrite H. unfold rev; simpl.
+   rewrite <- (rev_rev d). symmetry.
+   now apply nzhead_revapp_0.
+ - now rewrite <- nzhead_rev, rev_rev.
+Qed.
+
+Lemma revapp_nil_inv d d' : revapp d d' = Nil -> d = Nil /\ d' = Nil.
+Proof.
+ revert d'.
+ induction d; simpl; intros d' H; auto; now apply IHd in H.
+Qed.
+
+Lemma rev_nil_inv d : rev d = Nil -> d = Nil.
+Proof.
+ apply revapp_nil_inv.
+Qed.
+
+Lemma rev_lnorm_rev d :
+  rev (lnorm (rev d)) = unorm d.
+Proof.
+ unfold unorm, lnorm.
+ rewrite <- rev_nztail_rev.
+ destruct nztail; simpl; trivial;
+  destruct rev eqn:E; trivial; now apply rev_nil_inv in E.
+Qed.
+
+Lemma nzhead_nonzero d d' : nzhead d <> D0 d'.
+Proof.
+ induction d; easy.
+Qed.
+
+Lemma unorm_0 d : unorm d = zero <-> nzhead d = Nil.
+Proof.
+ unfold unorm. split.
+ - generalize (nzhead_nonzero d).
+   destruct nzhead; intros H [=]; trivial. now destruct (H u).
+ - now intros ->.
+Qed.
+
+Lemma unorm_nonnil d : unorm d <> Nil.
+Proof.
+ unfold unorm. now destruct nzhead.
+Qed.
+
+Lemma nzhead_invol d : nzhead (nzhead d) = nzhead d.
+Proof.
+ now induction d.
+Qed.
+
+Lemma unorm_invol d : unorm (unorm d) = unorm d.
+Proof.
+ unfold unorm.
+ destruct (nzhead d) eqn:E; trivial.
+ destruct (nzhead_nonzero _ _ E).
+Qed.
+
+Lemma norm_invol d : norm (norm d) = norm d.
+Proof.
+ unfold norm.
+ destruct d.
+ - f_equal. apply unorm_invol.
+ - destruct (nzhead d) eqn:E; auto.
+   destruct (nzhead_nonzero _ _ E).
+Qed.
diff --git a/theories/Numbers/DecimalN.v b/theories/Numbers/DecimalN.v
new file mode 100644
index 000000000..998f009a7
--- /dev/null
+++ b/theories/Numbers/DecimalN.v
@@ -0,0 +1,105 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(** * DecimalN
+
+    Proofs that conversions between decimal numbers and [N]
+    are bijections *)
+
+Require Import Decimal DecimalFacts DecimalPos PArith NArith.
+
+Module Unsigned.
+
+Lemma of_to (n:N) : N.of_uint (N.to_uint n) = n.
+Proof.
+ destruct n.
+ - reflexivity.
+ - apply DecimalPos.Unsigned.of_to.
+Qed.
+
+Lemma to_of (d:uint) : N.to_uint (N.of_uint d) = unorm d.
+Proof.
+ exact (DecimalPos.Unsigned.to_of d).
+Qed.
+
+Lemma to_uint_inj n n' : N.to_uint n = N.to_uint n' -> n = n'.
+Proof.
+ intros E. now rewrite <- (of_to n), <- (of_to n'), E.
+Qed.
+
+Lemma to_uint_surj d : exists p, N.to_uint p = unorm d.
+Proof.
+ exists (N.of_uint d). apply to_of.
+Qed.
+
+Lemma of_uint_norm d : N.of_uint (unorm d) = N.of_uint d.
+Proof.
+ now induction d.
+Qed.
+
+Lemma of_inj d d' :
+ N.of_uint d = N.of_uint d' -> unorm d = unorm d'.
+Proof.
+ intros. rewrite <- !to_of. now f_equal.
+Qed.
+
+Lemma of_iff d d' : N.of_uint d = N.of_uint d' <-> unorm d = unorm d'.
+Proof.
+ split. apply of_inj. intros E. rewrite <- of_uint_norm, E.
+ apply of_uint_norm.
+Qed.
+
+End Unsigned.
+
+(** Conversion from/to signed decimal numbers *)
+
+Module Signed.
+
+Lemma of_to (n:N) : N.of_int (N.to_int n) = Some n.
+Proof.
+ unfold N.to_int, N.of_int, norm. f_equal.
+ rewrite Unsigned.of_uint_norm. apply Unsigned.of_to.
+Qed.
+
+Lemma to_of (d:int)(n:N) : N.of_int d = Some n -> N.to_int n = norm d.
+Proof.
+ unfold N.of_int.
+ destruct (norm d) eqn:Hd; intros [= <-].
+ unfold N.to_int. rewrite Unsigned.to_of. f_equal.
+ revert Hd; destruct d; simpl.
+ - intros [= <-]. apply unorm_invol.
+ - destruct (nzhead d); now intros [= <-].
+Qed.
+
+Lemma to_int_inj n n' : N.to_int n = N.to_int n' -> n = n'.
+Proof.
+ intro E.
+ assert (E' : Some n = Some n').
+ { now rewrite <- (of_to n), <- (of_to n'), E. }
+ now injection E'.
+Qed.
+
+Lemma to_int_pos_surj d : exists n, N.to_int n = norm (Pos d).
+Proof.
+ exists (N.of_uint d). unfold N.to_int. now rewrite Unsigned.to_of.
+Qed.
+
+Lemma of_int_norm d : N.of_int (norm d) = N.of_int d.
+Proof.
+ unfold N.of_int. now rewrite norm_invol.
+Qed.
+
+Lemma of_inj_pos d d' :
+ N.of_int (Pos d) = N.of_int (Pos d') -> unorm d = unorm d'.
+Proof.
+ unfold N.of_int. simpl. intros [= H]. apply Unsigned.of_inj.
+ change Pos.of_uint with N.of_uint in H.
+ now rewrite <- Unsigned.of_uint_norm, H, Unsigned.of_uint_norm.
+Qed.
+
+End Signed.
diff --git a/theories/Numbers/DecimalNat.v b/theories/Numbers/DecimalNat.v
new file mode 100644
index 000000000..4aa189e24
--- /dev/null
+++ b/theories/Numbers/DecimalNat.v
@@ -0,0 +1,300 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(** * DecimalNat
+
+    Proofs that conversions between decimal numbers and [nat]
+    are bijections. *)
+
+Require Import Decimal DecimalFacts Arith.
+
+Module Unsigned.
+
+(** A few helper functions used during proofs *)
+
+Definition hd d :=
+ match d with
+ | Nil => 0
+ | D0 _ => 0
+ | D1 _ => 1
+ | D2 _ => 2
+ | D3 _ => 3
+ | D4 _ => 4
+ | D5 _ => 5
+ | D6 _ => 6
+ | D7 _ => 7
+ | D8 _ => 8
+ | D9 _ => 9
+end.
+
+Definition tl d :=
+ match d with
+ | Nil => d
+ | D0 d | D1 d | D2 d | D3 d | D4 d | D5 d | D6 d | D7 d | D8 d | D9 d => d
+end.
+
+Fixpoint usize (d:uint) : nat :=
+  match d with
+  | Nil => 0
+  | D0 d => S (usize d)
+  | D1 d => S (usize d)
+  | D2 d => S (usize d)
+  | D3 d => S (usize d)
+  | D4 d => S (usize d)
+  | D5 d => S (usize d)
+  | D6 d => S (usize d)
+  | D7 d => S (usize d)
+  | D8 d => S (usize d)
+  | D9 d => S (usize d)
+  end.
+
+(** A direct version of [to_little_uint], not tail-recursive *)
+Fixpoint to_lu n :=
+ match n with
+ | 0 => Decimal.zero
+ | S n => Little.succ (to_lu n)
+ end.
+
+(** A direct version of [of_little_uint] *)
+Fixpoint of_lu (d:uint) : nat :=
+  match d with
+  | Nil => 0
+  | D0 d => 10 * of_lu d
+  | D1 d => 1 + 10 * of_lu d
+  | D2 d => 2 + 10 * of_lu d
+  | D3 d => 3 + 10 * of_lu d
+  | D4 d => 4 + 10 * of_lu d
+  | D5 d => 5 + 10 * of_lu d
+  | D6 d => 6 + 10 * of_lu d
+  | D7 d => 7 + 10 * of_lu d
+  | D8 d => 8 + 10 * of_lu d
+  | D9 d => 9 + 10 * of_lu d
+  end.
+
+(** Properties of [to_lu] *)
+
+Lemma to_lu_succ n : to_lu (S n) = Little.succ (to_lu n).
+Proof.
+ reflexivity.
+Qed.
+
+Lemma to_little_uint_succ n d :
+ Nat.to_little_uint n (Little.succ d) =
+  Little.succ (Nat.to_little_uint n d).
+Proof.
+ revert d; induction n; simpl; trivial.
+Qed.
+
+Lemma to_lu_equiv n :
+  to_lu n = Nat.to_little_uint n zero.
+Proof.
+ induction n; simpl; trivial.
+ now rewrite IHn, <- to_little_uint_succ.
+Qed.
+
+Lemma to_uint_alt n :
+ Nat.to_uint n = rev (to_lu n).
+Proof.
+ unfold Nat.to_uint. f_equal. symmetry. apply to_lu_equiv.
+Qed.
+
+(** Properties of [of_lu] *)
+
+Lemma of_lu_eqn d :
+ of_lu d = hd d + 10 * of_lu (tl d).
+Proof.
+ induction d; simpl; trivial.
+Qed.
+
+Ltac simpl_of_lu :=
+ match goal with
+ | |- context [ of_lu (?f ?x) ] =>
+   rewrite (of_lu_eqn (f x)); simpl hd; simpl tl
+ end.
+
+Lemma of_lu_succ d :
+ of_lu (Little.succ d) = S (of_lu d).
+Proof.
+ induction d; trivial.
+ simpl_of_lu. rewrite IHd. simpl_of_lu.
+ now rewrite Nat.mul_succ_r, <- (Nat.add_comm 10).
+Qed.
+
+Lemma of_to_lu n :
+ of_lu (to_lu n) = n.
+Proof.
+ induction n; simpl; trivial. rewrite of_lu_succ. now f_equal.
+Qed.
+
+Lemma of_lu_revapp d d' :
+of_lu (revapp d d') =
+ of_lu (rev d) + of_lu d' * 10^usize d.
+Proof.
+ revert d'.
+ induction d; intro d'; simpl usize;
+ [ simpl; now rewrite Nat.mul_1_r | .. ];
+ unfold rev; simpl revapp; rewrite 2 IHd;
+ rewrite <- Nat.add_assoc; f_equal; simpl_of_lu; simpl of_lu;
+ rewrite Nat.pow_succ_r'; ring.
+Qed.
+
+Lemma of_uint_acc_spec n d :
+ Nat.of_uint_acc d n = of_lu (rev d) + n * 10^usize d.
+Proof.
+ revert n. induction d; intros;
+ simpl Nat.of_uint_acc; rewrite ?Nat.tail_mul_spec, ?IHd;
+ simpl rev; simpl usize; rewrite ?Nat.pow_succ_r';
+ [ simpl; now rewrite Nat.mul_1_r | .. ];
+ unfold rev at 2; simpl revapp; rewrite of_lu_revapp;
+ simpl of_lu; ring.
+Qed.
+
+Lemma of_uint_alt d : Nat.of_uint d = of_lu (rev d).
+Proof.
+ unfold Nat.of_uint. now rewrite of_uint_acc_spec.
+Qed.
+
+(** First main bijection result *)
+
+Lemma of_to (n:nat) : Nat.of_uint (Nat.to_uint n) = n.
+Proof.
+ rewrite to_uint_alt, of_uint_alt, rev_rev. apply of_to_lu.
+Qed.
+
+(** The other direction *)
+
+Lemma to_lu_tenfold n : n<>0 ->
+ to_lu (10 * n) = D0 (to_lu n).
+Proof.
+ induction n.
+ - simpl. now destruct 1.
+ - intros _.
+   destruct (Nat.eq_dec n 0) as [->|H]; simpl; trivial.
+   rewrite !Nat.add_succ_r.
+   simpl in *. rewrite (IHn H). now destruct (to_lu n).
+Qed.
+
+Lemma of_lu_0 d : of_lu d = 0 <-> nztail d = Nil.
+Proof.
+ induction d; try simpl_of_lu; try easy.
+ rewrite Nat.add_0_l.
+ split; intros H.
+ - apply Nat.eq_mul_0_r in H; auto.
+   rewrite IHd in H. simpl. now rewrite H.
+ - simpl in H. destruct (nztail d); try discriminate.
+   now destruct IHd as [_ ->].
+Qed.
+
+Lemma to_of_lu_tenfold d :
+ to_lu (of_lu d) = lnorm d ->
+ to_lu (10 * of_lu d) = lnorm (D0 d).
+Proof.
+ intro IH.
+ destruct (Nat.eq_dec (of_lu d) 0) as [H|H].
+ - rewrite H. simpl. rewrite of_lu_0 in H.
+   unfold lnorm. simpl. now rewrite H.
+ - rewrite (to_lu_tenfold _ H), IH.
+   rewrite of_lu_0 in H.
+   unfold lnorm. simpl. now destruct (nztail d).
+Qed.
+
+Lemma to_of_lu d : to_lu (of_lu d) = lnorm d.
+Proof.
+ induction d; [ reflexivity | .. ];
+ simpl_of_lu;
+ rewrite ?Nat.add_succ_l, Nat.add_0_l, ?to_lu_succ, to_of_lu_tenfold
+  by assumption;
+ unfold lnorm; simpl; now destruct nztail.
+Qed.
+
+(** Second bijection result *)
+
+Lemma to_of (d:uint) : Nat.to_uint (Nat.of_uint d) = unorm d.
+Proof.
+ rewrite to_uint_alt, of_uint_alt, to_of_lu.
+ apply rev_lnorm_rev.
+Qed.
+
+(** Some consequences *)
+
+Lemma to_uint_inj n n' : Nat.to_uint n = Nat.to_uint n' -> n = n'.
+Proof.
+ intro EQ.
+ now rewrite <- (of_to n), <- (of_to n'), EQ.
+Qed.
+
+Lemma to_uint_surj d : exists n, Nat.to_uint n = unorm d.
+Proof.
+ exists (Nat.of_uint d). apply to_of.
+Qed.
+
+Lemma of_uint_norm d : Nat.of_uint (unorm d) = Nat.of_uint d.
+Proof.
+ unfold Nat.of_uint. now induction d.
+Qed.
+
+Lemma of_inj d d' :
+ Nat.of_uint d = Nat.of_uint d' -> unorm d = unorm d'.
+Proof.
+ intros. rewrite <- !to_of. now f_equal.
+Qed.
+
+Lemma of_iff d d' : Nat.of_uint d = Nat.of_uint d' <-> unorm d = unorm d'.
+Proof.
+ split. apply of_inj. intros E. rewrite <- of_uint_norm, E.
+ apply of_uint_norm.
+Qed.
+
+End Unsigned.
+
+(** Conversion from/to signed decimal numbers *)
+
+Module Signed.
+
+Lemma of_to (n:nat) : Nat.of_int (Nat.to_int n) = Some n.
+Proof.
+ unfold Nat.to_int, Nat.of_int, norm. f_equal.
+ rewrite Unsigned.of_uint_norm. apply Unsigned.of_to.
+Qed.
+
+Lemma to_of (d:int)(n:nat) : Nat.of_int d = Some n -> Nat.to_int n = norm d.
+Proof.
+ unfold Nat.of_int.
+ destruct (norm d) eqn:Hd; intros [= <-].
+ unfold Nat.to_int. rewrite Unsigned.to_of. f_equal.
+ revert Hd; destruct d; simpl.
+ - intros [= <-]. apply unorm_invol.
+ - destruct (nzhead d); now intros [= <-].
+Qed.
+
+Lemma to_int_inj n n' : Nat.to_int n = Nat.to_int n' -> n = n'.
+Proof.
+ intro E.
+ assert (E' : Some n = Some n').
+ { now rewrite <- (of_to n), <- (of_to n'), E. }
+ now injection E'.
+Qed.
+
+Lemma to_int_pos_surj d : exists n, Nat.to_int n = norm (Pos d).
+Proof.
+ exists (Nat.of_uint d). unfold Nat.to_int. now rewrite Unsigned.to_of.
+Qed.
+
+Lemma of_int_norm d : Nat.of_int (norm d) = Nat.of_int d.
+Proof.
+ unfold Nat.of_int. now rewrite norm_invol.
+Qed.
+
+Lemma of_inj_pos d d' :
+ Nat.of_int (Pos d) = Nat.of_int (Pos d') -> unorm d = unorm d'.
+Proof.
+ unfold Nat.of_int. simpl. intros [= H]. apply Unsigned.of_inj.
+ now rewrite <- Unsigned.of_uint_norm, H, Unsigned.of_uint_norm.
+Qed.
+
+End Signed.
diff --git a/theories/Numbers/DecimalPos.v b/theories/Numbers/DecimalPos.v
new file mode 100644
index 000000000..40c8f5a5a
--- /dev/null
+++ b/theories/Numbers/DecimalPos.v
@@ -0,0 +1,381 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(** * DecimalPos
+
+    Proofs that conversions between decimal numbers and [positive]
+    are bijections. *)
+
+Require Import Decimal DecimalFacts PArith NArith.
+
+Module Unsigned.
+
+Local Open Scope N.
+
+(** A direct version of [of_little_uint] *)
+Fixpoint of_lu (d:uint) : N :=
+  match d with
+  | Nil => 0
+  | D0 d => 10 * of_lu d
+  | D1 d => 1 + 10 * of_lu d
+  | D2 d => 2 + 10 * of_lu d
+  | D3 d => 3 + 10 * of_lu d
+  | D4 d => 4 + 10 * of_lu d
+  | D5 d => 5 + 10 * of_lu d
+  | D6 d => 6 + 10 * of_lu d
+  | D7 d => 7 + 10 * of_lu d
+  | D8 d => 8 + 10 * of_lu d
+  | D9 d => 9 + 10 * of_lu d
+  end.
+
+Definition hd d :=
+match d with
+ | Nil => 0
+ | D0 _ => 0
+ | D1 _ => 1
+ | D2 _ => 2
+ | D3 _ => 3
+ | D4 _ => 4
+ | D5 _ => 5
+ | D6 _ => 6
+ | D7 _ => 7
+ | D8 _ => 8
+ | D9 _ => 9
+end.
+
+Definition tl d :=
+ match d with
+ | Nil => d
+ | D0 d | D1 d | D2 d | D3 d | D4 d | D5 d | D6 d | D7 d | D8 d | D9 d => d
+end.
+
+Lemma of_lu_eqn d :
+ of_lu d = hd d + 10 * (of_lu (tl d)).
+Proof.
+ induction d; simpl; trivial.
+Qed.
+
+Ltac simpl_of_lu :=
+ match goal with
+ | |- context [ of_lu (?f ?x) ] =>
+   rewrite (of_lu_eqn (f x)); simpl hd; simpl tl
+ end.
+
+Fixpoint usize (d:uint) : N :=
+  match d with
+  | Nil => 0
+  | D0 d => N.succ (usize d)
+  | D1 d => N.succ (usize d)
+  | D2 d => N.succ (usize d)
+  | D3 d => N.succ (usize d)
+  | D4 d => N.succ (usize d)
+  | D5 d => N.succ (usize d)
+  | D6 d => N.succ (usize d)
+  | D7 d => N.succ (usize d)
+  | D8 d => N.succ (usize d)
+  | D9 d => N.succ (usize d)
+  end.
+
+Lemma of_lu_revapp d d' :
+ of_lu (revapp d d') =
+  of_lu (rev d) + of_lu d' * 10^usize d.
+Proof.
+ revert d'.
+ induction d; simpl; intro d'; [ now rewrite N.mul_1_r | .. ];
+ unfold rev; simpl revapp; rewrite 2 IHd;
+ rewrite <- N.add_assoc; f_equal; simpl_of_lu; simpl of_lu;
+ rewrite N.pow_succ_r'; ring.
+Qed.
+
+Definition Nadd n p :=
+ match n with
+ | N0 => p
+ | Npos p0 => (p0+p)%positive
+ end.
+
+Lemma Nadd_simpl n p q : Npos (Nadd n (p * q)) = n + Npos p * Npos q.
+Proof.
+ now destruct n.
+Qed.
+
+Lemma of_uint_acc_eqn d acc : d<>Nil ->
+ Pos.of_uint_acc d acc = Pos.of_uint_acc (tl d) (Nadd (hd d) (10*acc)).
+Proof.
+ destruct d; simpl; trivial. now destruct 1.
+Qed.
+
+Lemma of_uint_acc_rev d acc :
+ Npos (Pos.of_uint_acc d acc) =
+  of_lu (rev d) + (Npos acc) * 10^usize d.
+Proof.
+ revert acc.
+ induction d; intros; simpl usize;
+ [ simpl; now rewrite Pos.mul_1_r | .. ];
+ rewrite N.pow_succ_r';
+ unfold rev; simpl revapp; try rewrite of_lu_revapp; simpl of_lu;
+ rewrite of_uint_acc_eqn by easy; simpl tl; simpl hd;
+ rewrite IHd, Nadd_simpl; ring.
+Qed.
+
+Lemma of_uint_alt d : Pos.of_uint d = of_lu (rev d).
+Proof.
+ induction d; simpl; trivial; unfold rev; simpl revapp;
+ rewrite of_lu_revapp; simpl of_lu; try apply of_uint_acc_rev.
+ rewrite IHd. ring.
+Qed.
+
+Lemma of_lu_rev d : Pos.of_uint (rev d) = of_lu d.
+Proof.
+ rewrite of_uint_alt. now rewrite rev_rev.
+Qed.
+
+Lemma of_lu_double_gen d :
+  of_lu (Little.double d) = N.double (of_lu d) /\
+  of_lu (Little.succ_double d) = N.succ_double (of_lu d).
+Proof.
+ rewrite N.double_spec, N.succ_double_spec.
+ induction d; try destruct IHd as (IH1,IH2);
+ simpl Little.double; simpl Little.succ_double;
+ repeat (simpl_of_lu; rewrite ?IH1, ?IH2); split; reflexivity || ring.
+Qed.
+
+Lemma of_lu_double d :
+  of_lu (Little.double d) = N.double (of_lu d).
+Proof.
+ apply of_lu_double_gen.
+Qed.
+
+Lemma of_lu_succ_double d :
+  of_lu (Little.succ_double d) = N.succ_double (of_lu d).
+Proof.
+ apply of_lu_double_gen.
+Qed.
+
+(** First bijection result *)
+
+Lemma of_to (p:positive) : Pos.of_uint (Pos.to_uint p) = Npos p.
+Proof.
+ unfold Pos.to_uint.
+ rewrite of_lu_rev.
+ induction p; simpl; trivial.
+ - now rewrite of_lu_succ_double, IHp.
+ - now rewrite of_lu_double, IHp.
+Qed.
+
+(** The other direction *)
+
+Definition to_lu n :=
+  match n with
+  | N0 => Decimal.zero
+  | Npos p => Pos.to_little_uint p
+  end.
+
+Lemma succ_double_alt d :
+  Little.succ_double d = Little.succ (Little.double d).
+Proof.
+ now induction d.
+Qed.
+
+Lemma double_succ d :
+  Little.double (Little.succ d) =
+  Little.succ (Little.succ_double d).
+Proof.
+ induction d; simpl; f_equal; auto using succ_double_alt.
+Qed.
+
+Lemma to_lu_succ n :
+ to_lu (N.succ n) = Little.succ (to_lu n).
+Proof.
+ destruct n; simpl; trivial.
+ induction p; simpl; rewrite ?IHp;
+  auto using succ_double_alt, double_succ.
+Qed.
+
+Lemma nat_iter_S n {A} (f:A->A) i :
+ Nat.iter (S n) f i = f (Nat.iter n f i).
+Proof.
+ reflexivity.
+Qed.
+
+Lemma nat_iter_0 {A} (f:A->A) i : Nat.iter 0 f i = i.
+Proof.
+ reflexivity.
+Qed.
+
+Lemma to_ldec_tenfold p :
+ to_lu (10 * Npos p) = D0 (to_lu (Npos p)).
+Proof.
+ induction p using Pos.peano_rect.
+ - trivial.
+ - change (N.pos (Pos.succ p)) with (N.succ (N.pos p)).
+   rewrite N.mul_succ_r.
+   change 10 at 2 with (Nat.iter 10%nat N.succ 0).
+   rewrite ?nat_iter_S, nat_iter_0.
+   rewrite !N.add_succ_r, N.add_0_r, !to_lu_succ, IHp.
+   destruct (to_lu (N.pos p)); simpl; auto.
+Qed.
+
+Lemma of_lu_0 d : of_lu d = 0 <-> nztail d = Nil.
+Proof.
+ induction d; try simpl_of_lu; split; trivial; try discriminate;
+ try (intros H; now apply N.eq_add_0 in H).
+ - rewrite N.add_0_l. intros H.
+   apply N.eq_mul_0_r in H; [|easy]. rewrite IHd in H.
+   simpl. now rewrite H.
+ - simpl. destruct (nztail d); try discriminate.
+   now destruct IHd as [_ ->].
+Qed.
+
+Lemma to_of_lu_tenfold d :
+ to_lu (of_lu d) = lnorm d ->
+ to_lu (10 * of_lu d) = lnorm (D0 d).
+Proof.
+ intro IH.
+ destruct (N.eq_dec (of_lu d) 0) as [H|H].
+ - rewrite H. simpl. rewrite of_lu_0 in H.
+   unfold lnorm. simpl. now rewrite H.
+ - destruct (of_lu d) eqn:Eq; [easy| ].
+   rewrite to_ldec_tenfold; auto. rewrite IH.
+   rewrite <- Eq in H. rewrite of_lu_0 in H.
+   unfold lnorm. simpl. now destruct (nztail d).
+Qed.
+
+Lemma Nadd_alt n m : n + m = Nat.iter (N.to_nat n) N.succ m.
+Proof.
+ destruct n. trivial.
+ induction p using Pos.peano_rect.
+ - now rewrite N.add_1_l.
+ - change (N.pos (Pos.succ p)) with (N.succ (N.pos p)).
+   now rewrite N.add_succ_l, IHp, N2Nat.inj_succ.
+Qed.
+
+Ltac simpl_to_nat := simpl N.to_nat; unfold Pos.to_nat; simpl Pos.iter_op.
+
+Lemma to_of_lu d : to_lu (of_lu d) = lnorm d.
+Proof.
+ induction d; [reflexivity|..];
+ simpl_of_lu; rewrite Nadd_alt; simpl_to_nat;
+ rewrite ?nat_iter_S, nat_iter_0, ?to_lu_succ, to_of_lu_tenfold by assumption;
+ unfold lnorm; simpl; destruct nztail; auto.
+Qed.
+
+(** Second bijection result *)
+
+Lemma to_of (d:uint) : N.to_uint (Pos.of_uint d) = unorm d.
+Proof.
+ rewrite of_uint_alt.
+ unfold N.to_uint, Pos.to_uint.
+ destruct (of_lu (rev d)) eqn:H.
+ - rewrite of_lu_0 in H. rewrite <- rev_lnorm_rev.
+   unfold lnorm. now rewrite H.
+ - change (Pos.to_little_uint p) with (to_lu (N.pos p)).
+   rewrite <- H. rewrite to_of_lu. apply rev_lnorm_rev.
+Qed.
+
+(** Some consequences *)
+
+Lemma to_uint_nonzero p : Pos.to_uint p <> zero.
+Proof.
+ intro E. generalize (of_to p). now rewrite E.
+Qed.
+
+Lemma to_uint_nonnil p : Pos.to_uint p <> Nil.
+Proof.
+ intros E. generalize (of_to p). now rewrite E.
+Qed.
+
+Lemma to_uint_inj p p' : Pos.to_uint p = Pos.to_uint p' -> p = p'.
+Proof.
+ intro E.
+ assert (E' : N.pos p = N.pos p').
+ { now rewrite <- (of_to p), <- (of_to p'), E. }
+ now injection E'.
+Qed.
+
+Lemma to_uint_pos_surj d :
+ unorm d<>zero -> exists p, Pos.to_uint p = unorm d.
+Proof.
+ intros.
+ destruct (Pos.of_uint d) eqn:E.
+ - destruct H. generalize (to_of d). now rewrite E.
+ - exists p. generalize (to_of d). now rewrite E.
+Qed.
+
+Lemma of_uint_norm d : Pos.of_uint (unorm d) = Pos.of_uint d.
+Proof.
+ now induction d.
+Qed.
+
+Lemma of_inj d d' :
+ Pos.of_uint d = Pos.of_uint d' -> unorm d = unorm d'.
+Proof.
+ intros. rewrite <- !to_of. now f_equal.
+Qed.
+
+Lemma of_iff d d' : Pos.of_uint d = Pos.of_uint d' <-> unorm d = unorm d'.
+Proof.
+ split. apply of_inj. intros E. rewrite <- of_uint_norm, E.
+ apply of_uint_norm.
+Qed.
+
+End Unsigned.
+
+(** Conversion from/to signed decimal numbers *)
+
+Module Signed.
+
+Lemma of_to (p:positive) : Pos.of_int (Pos.to_int p) = Some p.
+Proof.
+ unfold Pos.to_int, Pos.of_int, norm.
+ now rewrite Unsigned.of_to.
+Qed.
+
+Lemma to_of (d:int)(p:positive) :
+ Pos.of_int d = Some p -> Pos.to_int p = norm d.
+Proof.
+ unfold Pos.of_int.
+ destruct d; [ | intros [=]].
+ simpl norm. rewrite <- Unsigned.to_of.
+ destruct (Pos.of_uint d); now intros [= <-].
+Qed.
+
+Lemma to_int_inj p p' : Pos.to_int p = Pos.to_int p' -> p = p'.
+Proof.
+ intro E.
+ assert (E' : Some p = Some p').
+ { now rewrite <- (of_to p), <- (of_to p'), E. }
+ now injection E'.
+Qed.
+
+Lemma to_int_pos_surj d :
+ unorm d <> zero -> exists p, Pos.to_int p = norm (Pos d).
+Proof.
+ simpl. unfold Pos.to_int. intros H.
+ destruct (Unsigned.to_uint_pos_surj d H) as (p,Hp).
+ exists p. now f_equal.
+Qed.
+
+Lemma of_int_norm d : Pos.of_int (norm d) = Pos.of_int d.
+Proof.
+ unfold Pos.of_int.
+ destruct d.
+ - simpl. now rewrite Unsigned.of_uint_norm.
+ - simpl. now destruct (nzhead d) eqn:H.
+Qed.
+
+Lemma of_inj_pos d d' :
+ Pos.of_int (Pos d) = Pos.of_int (Pos d') -> unorm d = unorm d'.
+Proof.
+ unfold Pos.of_int.
+ destruct (Pos.of_uint d) eqn:Hd, (Pos.of_uint d') eqn:Hd';
+  intros [=].
+ - apply Unsigned.of_inj; now rewrite Hd, Hd'.
+ - apply Unsigned.of_inj; rewrite Hd, Hd'; now f_equal.
+Qed.
+
+End Signed.
diff --git a/theories/Numbers/DecimalString.v b/theories/Numbers/DecimalString.v
new file mode 100644
index 000000000..7e937f481
--- /dev/null
+++ b/theories/Numbers/DecimalString.v
@@ -0,0 +1,263 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+Require Import Decimal Ascii String.
+
+(** * Conversion between decimal numbers and Coq strings *)
+
+(** Pretty straightforward, which is precisely the point of the
+    [Decimal.int] datatype. The only catch is [Decimal.Nil] : we could
+    choose to convert it as [""] or as ["0"]. In the first case, it is
+    awkward to consider "" (or "-") as a number, while in the second case
+    we don't have a perfect bijection. Since the second variant is implemented
+    thanks to the first one, we provide both. *)
+
+Local Open Scope string_scope.
+
+(** Parsing one char *)
+
+Definition uint_of_char (a:ascii)(d:option uint) :=
+ match d with
+ | None => None
+ | Some d =>
+   match a with
+   | "0" => Some (D0 d)
+   | "1" => Some (D1 d)
+   | "2" => Some (D2 d)
+   | "3" => Some (D3 d)
+   | "4" => Some (D4 d)
+   | "5" => Some (D5 d)
+   | "6" => Some (D6 d)
+   | "7" => Some (D7 d)
+   | "8" => Some (D8 d)
+   | "9" => Some (D9 d)
+   | _ => None
+   end
+ end%char.
+
+Lemma uint_of_char_spec c d d' :
+  uint_of_char c (Some d) = Some d' ->
+  (c = "0" /\ d' = D0 d \/
+  c = "1" /\ d' = D1 d \/
+  c = "2" /\ d' = D2 d \/
+  c = "3" /\ d' = D3 d \/
+  c = "4" /\ d' = D4 d \/
+  c = "5" /\ d' = D5 d \/
+  c = "6" /\ d' = D6 d \/
+  c = "7" /\ d' = D7 d \/
+  c = "8" /\ d' = D8 d \/
+  c = "9" /\ d' = D9 d)%char.
+Proof.
+ destruct c as [[|] [|] [|] [|] [|] [|] [|] [|]];
+ intros [= <-]; intuition.
+Qed.
+
+(** Decimal/String conversion where [Nil] is [""] *)
+
+Module NilEmpty.
+
+Fixpoint string_of_uint (d:uint) :=
+ match d with
+ | Nil => EmptyString
+ | D0 d => String "0" (string_of_uint d)
+ | D1 d => String "1" (string_of_uint d)
+ | D2 d => String "2" (string_of_uint d)
+ | D3 d => String "3" (string_of_uint d)
+ | D4 d => String "4" (string_of_uint d)
+ | D5 d => String "5" (string_of_uint d)
+ | D6 d => String "6" (string_of_uint d)
+ | D7 d => String "7" (string_of_uint d)
+ | D8 d => String "8" (string_of_uint d)
+ | D9 d => String "9" (string_of_uint d)
+ end.
+
+Fixpoint uint_of_string s :=
+ match s with
+ | EmptyString => Some Nil
+ | String a s => uint_of_char a (uint_of_string s)
+ end.
+
+Definition string_of_int (d:int) :=
+ match d with
+ | Pos d => string_of_uint d
+ | Neg d => String "-" (string_of_uint d)
+ end.
+
+Definition int_of_string s :=
+ match s with
+ | EmptyString => Some (Pos Nil)
+ | String a s' =>
+   if ascii_dec a "-" then option_map Neg (uint_of_string s')
+   else option_map Pos (uint_of_string s)
+ end.
+
+(* NB: For the moment whitespace between - and digits are not accepted.
+   And in this variant [int_of_string "-" = Some (Neg Nil)].
+
+Compute int_of_string "-123456890123456890123456890123456890".
+Compute string_of_int (-123456890123456890123456890123456890).
+*)
+
+(** Corresponding proofs *)
+
+Lemma usu d :
+  uint_of_string (string_of_uint d) = Some d.
+Proof.
+ induction d; simpl; rewrite ?IHd; simpl; auto.
+Qed.
+
+Lemma sus s d :
+  uint_of_string s = Some d -> string_of_uint d = s.
+Proof.
+ revert d.
+ induction s; simpl.
+ - now intros d [= <-].
+ - intros d.
+   destruct (uint_of_string s); [intros H | intros [=]].
+   apply uint_of_char_spec in H.
+   intuition subst; simpl; f_equal; auto.
+Qed.
+
+Lemma isi d : int_of_string (string_of_int d) = Some d.
+Proof.
+ destruct d; simpl.
+ - unfold int_of_string.
+   destruct (string_of_uint d) eqn:Hd.
+   + now destruct d.
+   + destruct ascii_dec; subst.
+     * now destruct d.
+     * rewrite <- Hd, usu; auto.
+ - rewrite usu; auto.
+Qed.
+
+Lemma sis s d :
+ int_of_string s = Some d -> string_of_int d = s.
+Proof.
+ destruct s; [intros [= <-]| ]; simpl; trivial.
+ destruct ascii_dec; subst; simpl.
+ - destruct (uint_of_string s) eqn:Hs; simpl; intros [= <-].
+   simpl; f_equal. now apply sus.
+ - destruct d; [ | now destruct uint_of_char].
+   simpl string_of_int.
+   intros. apply sus; simpl.
+   destruct uint_of_char; simpl in *; congruence.
+Qed.
+
+End NilEmpty.
+
+(** Decimal/String conversions where [Nil] is ["0"] *)
+
+Module NilZero.
+
+Definition string_of_uint (d:uint) :=
+ match d with
+ | Nil => "0"
+ | _ => NilEmpty.string_of_uint d
+ end.
+
+Definition uint_of_string s :=
+ match s with
+ | EmptyString => None
+ | _ => NilEmpty.uint_of_string s
+ end.
+
+Definition string_of_int (d:int) :=
+ match d with
+ | Pos d => string_of_uint d
+ | Neg d => String "-" (string_of_uint d)
+ end.
+
+Definition int_of_string s :=
+ match s with
+ | EmptyString => None
+ | String a s' =>
+   if ascii_dec a "-" then option_map Neg (uint_of_string s')
+   else option_map Pos (uint_of_string s)
+ end.
+
+(** Corresponding proofs *)
+
+Lemma uint_of_string_nonnil s : uint_of_string s <> Some Nil.
+Proof.
+ destruct s; simpl.
+ - easy.
+ - destruct (NilEmpty.uint_of_string s); [intros H | intros [=]].
+   apply uint_of_char_spec in H.
+   now intuition subst.
+Qed.
+
+Lemma sus s d :
+  uint_of_string s = Some d -> string_of_uint d = s.
+Proof.
+ destruct s; [intros [=] | intros H].
+ apply NilEmpty.sus in H. now destruct d.
+Qed.
+
+Lemma usu d :
+  d<>Nil -> uint_of_string (string_of_uint d) = Some d.
+Proof.
+ destruct d; (now destruct 1) || (intros _; apply NilEmpty.usu).
+Qed.
+
+Lemma usu_nil :
+  uint_of_string (string_of_uint Nil) = Some Decimal.zero.
+Proof.
+ reflexivity.
+Qed.
+
+Lemma usu_gen d :
+  uint_of_string (string_of_uint d) = Some d \/
+  uint_of_string (string_of_uint d) = Some Decimal.zero.
+Proof.
+ destruct d; (now right) || (left; now apply usu).
+Qed.
+
+Lemma isi d :
+  d<>Pos Nil -> d<>Neg Nil ->
+  int_of_string (string_of_int d) = Some d.
+Proof.
+ destruct d; simpl.
+ - intros H _.
+   unfold int_of_string.
+   destruct (string_of_uint d) eqn:Hd.
+   + now destruct d.
+   + destruct ascii_dec; subst.
+     * now destruct d.
+     * rewrite <- Hd, usu; auto. now intros ->.
+ - intros _ H.
+   rewrite usu; auto. now intros ->.
+Qed.
+
+Lemma isi_posnil :
+ int_of_string (string_of_int (Pos Nil)) = Some (Pos Decimal.zero).
+Proof.
+ reflexivity.
+Qed.
+
+(** Warning! (-0) won't parse (compatibility with the behavior of Z). *)
+
+Lemma isi_negnil :
+ int_of_string (string_of_int (Neg Nil)) = Some (Neg (D0 Nil)).
+Proof.
+ reflexivity.
+Qed.
+
+Lemma sis s d :
+ int_of_string s = Some d -> string_of_int d = s.
+Proof.
+ destruct s; [intros [=]| ]; simpl.
+ destruct ascii_dec; subst; simpl.
+ - destruct (uint_of_string s) eqn:Hs; simpl; intros [= <-].
+   simpl; f_equal. now apply sus.
+ - destruct d; [ | now destruct uint_of_char].
+   simpl string_of_int.
+   intros. apply sus; simpl.
+   destruct uint_of_char; simpl in *; congruence.
+Qed.
+
+End NilZero.
diff --git a/theories/Numbers/DecimalZ.v b/theories/Numbers/DecimalZ.v
new file mode 100644
index 000000000..92d66ecfb
--- /dev/null
+++ b/theories/Numbers/DecimalZ.v
@@ -0,0 +1,73 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(** * DecimalZ
+
+    Proofs that conversions between decimal numbers and [Z]
+    are bijections. *)
+
+Require Import Decimal DecimalFacts DecimalPos DecimalN ZArith.
+
+Lemma of_to (z:Z) : Z.of_int (Z.to_int z) = z.
+Proof.
+ destruct z; simpl.
+ - trivial.
+ - unfold Z.of_uint. rewrite DecimalPos.Unsigned.of_to. now destruct p.
+ - unfold Z.of_uint. rewrite DecimalPos.Unsigned.of_to. destruct p; auto.
+Qed.
+
+Lemma to_of (d:int) : Z.to_int (Z.of_int d) = norm d.
+Proof.
+ destruct d; simpl; unfold Z.to_int, Z.of_uint.
+ - rewrite <- (DecimalN.Unsigned.to_of d). unfold N.of_uint.
+   now destruct (Pos.of_uint d).
+ - destruct (Pos.of_uint d) eqn:Hd; simpl; f_equal.
+   + generalize (DecimalPos.Unsigned.to_of d). rewrite Hd. simpl.
+     intros H. symmetry in H. apply unorm_0 in H. now rewrite H.
+   + assert (Hp := DecimalPos.Unsigned.to_of d). rewrite Hd in Hp. simpl in *.
+     rewrite Hp. unfold unorm in *.
+     destruct (nzhead d); trivial.
+     generalize (DecimalPos.Unsigned.of_to p). now rewrite Hp.
+Qed.
+
+(** Some consequences *)
+
+Lemma to_int_inj n n' : Z.to_int n = Z.to_int n' -> n = n'.
+Proof.
+ intro EQ.
+ now rewrite <- (of_to n), <- (of_to n'), EQ.
+Qed.
+
+Lemma to_int_surj d : exists n, Z.to_int n = norm d.
+Proof.
+ exists (Z.of_int d). apply to_of.
+Qed.
+
+Lemma of_int_norm d : Z.of_int (norm d) = Z.of_int d.
+Proof.
+ unfold Z.of_int, Z.of_uint.
+ destruct d.
+ - simpl. now rewrite DecimalPos.Unsigned.of_uint_norm.
+ - simpl. destruct (nzhead d) eqn:H;
+   [ induction d; simpl; auto; discriminate |
+     destruct (nzhead_nonzero _ _ H) | .. ];
+   f_equal; f_equal; apply DecimalPos.Unsigned.of_iff;
+   unfold unorm; now rewrite H.
+Qed.
+
+Lemma of_inj d d' :
+ Z.of_int d = Z.of_int d' -> norm d = norm d'.
+Proof.
+ intros. rewrite <- !to_of. now f_equal.
+Qed.
+
+Lemma of_iff d d' : Z.of_int d = Z.of_int d' <-> norm d = norm d'.
+Proof.
+ split. apply of_inj. intros E. rewrite <- of_int_norm, E.
+ apply of_int_norm.
+Qed.
diff --git a/theories/Numbers/NatInt/NZParity.v b/theories/Numbers/NatInt/NZParity.v
index de3bbbca7..626d59d73 100644
--- a/theories/Numbers/NatInt/NZParity.v
+++ b/theories/Numbers/NatInt/NZParity.v
@@ -260,4 +260,4 @@ Proof.
  intros. apply odd_add_mul_even. apply even_spec, even_2.
 Qed.
 
-End NZParityProp.
\ No newline at end of file
+End NZParityProp.
diff --git a/theories/PArith/BinPosDef.v b/theories/PArith/BinPosDef.v
index 2b647555c..a77c26e5a 100644
--- a/theories/PArith/BinPosDef.v
+++ b/theories/PArith/BinPosDef.v
@@ -557,4 +557,59 @@ Fixpoint of_succ_nat (n:nat) : positive :=
     | S x => succ (of_succ_nat x)
   end.
 
+(** ** Conversion with a decimal representation for printing/parsing *)
+
+Local Notation ten := 1~0~1~0.
+
+Fixpoint of_uint_acc (d:Decimal.uint)(acc:positive) :=
+  match d with
+  | Decimal.Nil => acc
+  | Decimal.D0 l => of_uint_acc l (mul ten acc)
+  | Decimal.D1 l => of_uint_acc l (add 1 (mul ten acc))
+  | Decimal.D2 l => of_uint_acc l (add 1~0 (mul ten acc))
+  | Decimal.D3 l => of_uint_acc l (add 1~1 (mul ten acc))
+  | Decimal.D4 l => of_uint_acc l (add 1~0~0 (mul ten acc))
+  | Decimal.D5 l => of_uint_acc l (add 1~0~1 (mul ten acc))
+  | Decimal.D6 l => of_uint_acc l (add 1~1~0 (mul ten acc))
+  | Decimal.D7 l => of_uint_acc l (add 1~1~1 (mul ten acc))
+  | Decimal.D8 l => of_uint_acc l (add 1~0~0~0 (mul ten acc))
+  | Decimal.D9 l => of_uint_acc l (add 1~0~0~1 (mul ten acc))
+  end.
+
+Fixpoint of_uint (d:Decimal.uint) : N :=
+  match d with
+  | Decimal.Nil => N0
+  | Decimal.D0 l => of_uint l
+  | Decimal.D1 l => Npos (of_uint_acc l 1)
+  | Decimal.D2 l => Npos (of_uint_acc l 1~0)
+  | Decimal.D3 l => Npos (of_uint_acc l 1~1)
+  | Decimal.D4 l => Npos (of_uint_acc l 1~0~0)
+  | Decimal.D5 l => Npos (of_uint_acc l 1~0~1)
+  | Decimal.D6 l => Npos (of_uint_acc l 1~1~0)
+  | Decimal.D7 l => Npos (of_uint_acc l 1~1~1)
+  | Decimal.D8 l => Npos (of_uint_acc l 1~0~0~0)
+  | Decimal.D9 l => Npos (of_uint_acc l 1~0~0~1)
+  end.
+
+Definition of_int (d:Decimal.int) : option positive :=
+  match d with
+  | Decimal.Pos d =>
+    match of_uint d with
+    | N0 => None
+    | Npos p => Some p
+    end
+  | Decimal.Neg _ => None
+  end.
+
+Fixpoint to_little_uint p :=
+  match p with
+  | 1 => Decimal.D1 Decimal.Nil
+  | p~1 => Decimal.Little.succ_double (to_little_uint p)
+  | p~0 => Decimal.Little.double (to_little_uint p)
+  end.
+
+Definition to_uint p := Decimal.rev (to_little_uint p).
+
+Definition to_int n := Decimal.Pos (to_uint n).
+
 End Pos.
diff --git a/theories/Program/Combinators.v b/theories/Program/Combinators.v
index 90db10ef1..237d878bf 100644
--- a/theories/Program/Combinators.v
+++ b/theories/Program/Combinators.v
@@ -22,15 +22,13 @@ Open Scope program_scope.
 Lemma compose_id_left : forall A B (f : A -> B), id ∘ f = f.
 Proof.
   intros.
-  unfold id, compose.
-  symmetry. apply eta_expansion.
+  reflexivity.
 Qed.
 
 Lemma compose_id_right : forall A B (f : A -> B), f ∘ id = f.
 Proof.
   intros.
-  unfold id, compose.
-  symmetry ; apply eta_expansion.
+  reflexivity.
 Qed.
 
 Lemma compose_assoc : forall A B C D (f : A -> B) (g : B -> C) (h : C -> D),
@@ -47,9 +45,7 @@ Hint Rewrite <- @compose_assoc : core.
 
 Lemma flip_flip : forall A B C, @flip A B C ∘ flip = id.
 Proof.
-  unfold flip, compose.
   intros.
-  extensionality x ; extensionality y ; extensionality z.
   reflexivity.
 Qed.
 
@@ -57,9 +53,7 @@ Qed.
 
 Lemma prod_uncurry_curry : forall A B C, @prod_uncurry A B C ∘ prod_curry = id.
 Proof.
-  simpl ; intros.
-  unfold prod_uncurry, prod_curry, compose.
-  extensionality x ; extensionality y ; extensionality z.
+  intros.
   reflexivity.
 Qed.
 
diff --git a/theories/Program/Tactics.v b/theories/Program/Tactics.v
index 9aca56f47..b06562fc4 100644
--- a/theories/Program/Tactics.v
+++ b/theories/Program/Tactics.v
@@ -328,4 +328,4 @@ Ltac program_simpl := program_simplify ; try typeclasses eauto with program ; tr
 
 Obligation Tactic := program_simpl.
 
-Definition obligation (A : Type) {a : A} := a.
\ No newline at end of file
+Definition obligation (A : Type) {a : A} := a.
diff --git a/theories/QArith/QArith_base.v b/theories/QArith/QArith_base.v
index a19f9f902..5996d30f2 100644
--- a/theories/QArith/QArith_base.v
+++ b/theories/QArith/QArith_base.v
@@ -171,6 +171,26 @@ Proof.
  auto with qarith.
 Qed.
 
+Lemma Qeq_bool_comm x y: Qeq_bool x y = Qeq_bool y x.
+Proof.
+ apply eq_true_iff_eq. rewrite !Qeq_bool_iff. now symmetry.
+Qed.
+
+Lemma Qeq_bool_refl x: Qeq_bool x x = true.
+Proof.
+  rewrite Qeq_bool_iff. now reflexivity.
+Qed.
+
+Lemma Qeq_bool_sym x y: Qeq_bool x y = true -> Qeq_bool y x = true.
+Proof.
+  rewrite !Qeq_bool_iff. now symmetry.
+Qed.
+
+Lemma Qeq_bool_trans x y z: Qeq_bool x y = true -> Qeq_bool y z = true -> Qeq_bool x z = true.
+Proof.
+  rewrite !Qeq_bool_iff; apply Qeq_trans.
+Qed.
+
 Hint Resolve Qnot_eq_sym : qarith.
 
 (** * Addition, multiplication and opposite *)
diff --git a/theories/QArith/Qabs.v b/theories/QArith/Qabs.v
index 116aa0d42..ec2ac7832 100644
--- a/theories/QArith/Qabs.v
+++ b/theories/QArith/Qabs.v
@@ -100,6 +100,13 @@ rewrite Z.abs_mul.
 reflexivity.
 Qed.
 
+Lemma Qabs_Qinv : forall q, Qabs (/ q) == / (Qabs q).
+Proof.
+  intros [n d]; simpl.
+  unfold Qinv.
+  case_eq n; intros; simpl in *; apply Qeq_refl.
+Qed.
+  
 Lemma Qabs_Qminus x y: Qabs (x - y) = Qabs (y - x).
 Proof.
  unfold Qminus, Qopp. simpl.
diff --git a/theories/QArith/Qcabs.v b/theories/QArith/Qcabs.v
index 1883c77be..09908665e 100644
--- a/theories/QArith/Qcabs.v
+++ b/theories/QArith/Qcabs.v
@@ -126,4 +126,4 @@ Proof.
   destruct (proj1 (Qcabs_Qcle_condition x 0)) as [A B].
   + rewrite H; apply Qcle_refl.
   + apply Qcle_antisym; auto.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/theories/QArith/Qreduction.v b/theories/QArith/Qreduction.v
index 88e1298fb..5d055b547 100644
--- a/theories/QArith/Qreduction.v
+++ b/theories/QArith/Qreduction.v
@@ -101,7 +101,7 @@ Proof.
  - apply Qred_complete.
 Qed.
 
-Add Morphism Qred : Qred_comp.
+Add Morphism Qred with signature (Qeq ==> Qeq) as Qred_comp.
 Proof.
   intros. now rewrite !Qred_correct.
 Qed.
@@ -125,19 +125,19 @@ Proof.
   intros; unfold Qminus'; apply Qred_correct; auto.
 Qed.
 
-Add Morphism Qplus' : Qplus'_comp.
+Add Morphism Qplus' with signature (Qeq ==> Qeq ==> Qeq) as Qplus'_comp.
 Proof.
   intros; unfold Qplus'.
   rewrite H, H0; auto with qarith.
 Qed.
 
-Add Morphism Qmult' : Qmult'_comp.
+Add Morphism Qmult' with signature (Qeq ==> Qeq ==> Qeq) as Qmult'_comp.
 Proof.
   intros; unfold Qmult'.
   rewrite H, H0; auto with qarith.
 Qed.
 
-Add Morphism Qminus' : Qminus'_comp.
+Add Morphism Qminus' with signature (Qeq ==> Qeq ==> Qeq) as Qminus'_comp.
 Proof.
   intros; unfold Qminus'.
   rewrite H, H0; auto with qarith.
diff --git a/theories/Reals/Ranalysis.v b/theories/Reals/Ranalysis.v
index 66e37e867..9b0357f03 100644
--- a/theories/Reals/Ranalysis.v
+++ b/theories/Reals/Ranalysis.v
@@ -26,4 +26,4 @@ Require Export RList.
 Require Export Sqrt_reg.
 Require Export Ranalysis4.
 Require Export Rpower.
-Require Export Ranalysis_reg.
\ No newline at end of file
+Require Export Ranalysis_reg.
diff --git a/theories/Sets/Powerset_facts.v b/theories/Sets/Powerset_facts.v
index 2dd559a95..209c22f71 100644
--- a/theories/Sets/Powerset_facts.v
+++ b/theories/Sets/Powerset_facts.v
@@ -40,6 +40,11 @@ Section Sets_as_an_algebra.
     auto 6 with sets.
   Qed.
 
+  Theorem Empty_set_zero_right : forall X:Ensemble U, Union U X (Empty_set U) = X.
+  Proof.
+    auto 6 with sets.
+  Qed.
+
   Theorem Empty_set_zero' : forall x:U, Add U (Empty_set U) x = Singleton U x.
   Proof.
     unfold Add at 1; auto using Empty_set_zero with sets.
@@ -131,6 +136,17 @@ Section Sets_as_an_algebra.
     elim H'; intros x0 H'0; elim H'0; auto with sets.
   Qed.
 
+  Lemma Distributivity_l
+       : forall (A B C : Ensemble U),
+         Intersection U (Union U A B) C =
+         Union U (Intersection U A C) (Intersection U B C).
+  Proof.
+     intros  A B C.
+     rewrite Intersection_commutative.
+     rewrite Distributivity.
+     f_equal; apply Intersection_commutative.
+  Qed.
+
   Theorem Distributivity' :
     forall A B C:Ensemble U,
       Union U A (Intersection U B C) =
@@ -251,6 +267,81 @@ Section Sets_as_an_algebra.
     intros; apply Definition_of_covers; auto with sets.
   Qed.
 
+  Lemma Disjoint_Intersection:
+    forall A s1 s2, Disjoint A s1 s2 -> Intersection A s1 s2 = Empty_set A.
+  Proof.
+    intros. apply Extensionality_Ensembles. split.
+    * destruct H.
+      intros x H1. unfold In in *. exfalso. intuition. apply (H _ H1).
+    * intuition.
+  Qed.
+
+  Lemma Intersection_Empty_set_l:
+    forall A s, Intersection A (Empty_set A) s = Empty_set A.
+  Proof.
+    intros. auto with sets.
+  Qed.
+
+  Lemma Intersection_Empty_set_r:
+    forall A s, Intersection A s (Empty_set A) = Empty_set A.
+  Proof.
+    intros. auto with sets.
+  Qed.
+
+  Lemma Seminus_Empty_set_l:
+    forall A s, Setminus A (Empty_set A) s = Empty_set A.
+  Proof.
+    intros. apply Extensionality_Ensembles. split.
+    * intros x H1. destruct H1. unfold In in *. assumption.
+    * intuition.
+  Qed.
+
+  Lemma Seminus_Empty_set_r:
+    forall A s, Setminus A s (Empty_set A) = s.
+  Proof.
+    intros. apply Extensionality_Ensembles. split.
+    * intros x H1. destruct H1. unfold In in *. assumption.
+    * intuition.
+  Qed.
+
+  Lemma Setminus_Union_l:
+    forall A s1 s2 s3,
+    Setminus A (Union A s1 s2) s3 = Union A (Setminus A s1 s3)  (Setminus A s2 s3).
+  Proof.
+    intros. apply Extensionality_Ensembles. split.
+    * intros x H. inversion H. inversion H0; intuition.
+    * intros x H. constructor; inversion H; inversion H0; intuition.
+  Qed.
+
+  Lemma Setminus_Union_r:
+    forall A s1 s2 s3,
+    Setminus A s1 (Union A s2 s3) = Setminus A (Setminus A s1 s2) s3.
+  Proof.
+    intros. apply Extensionality_Ensembles. split.
+    * intros x H. inversion H. constructor. intuition. contradict H1. intuition.
+    * intros x H. inversion H. inversion H0. constructor; intuition. inversion H4; intuition.
+  Qed.
+
+ Lemma Setminus_Disjoint_noop:
+    forall A s1 s2,
+    Intersection A s1 s2 = Empty_set A -> Setminus A s1 s2 = s1.
+  Proof.
+    intros. apply Extensionality_Ensembles. split.
+    * intros x H1. inversion_clear H1. intuition.
+    * intros x H1. constructor; intuition. contradict H.
+      apply Inhabited_not_empty.
+      exists x. intuition.
+  Qed.
+
+  Lemma Setminus_Included_empty:
+    forall A s1 s2,
+    Included A s1 s2 -> Setminus A s1 s2 = Empty_set A.
+  Proof.
+    intros. apply Extensionality_Ensembles. split.
+      * intros x H1. inversion_clear H1. contradiction H2. intuition.
+      * intuition.
+  Qed.
+
 End Sets_as_an_algebra.
 
 Hint Resolve Empty_set_zero Empty_set_zero' Union_associative Union_add
diff --git a/theories/Unicode/Utf8_core.v b/theories/Unicode/Utf8_core.v
index a0545c0a4..95c8336d2 100644
--- a/theories/Unicode/Utf8_core.v
+++ b/theories/Unicode/Utf8_core.v
@@ -10,10 +10,12 @@
 
 
 (* Logic *)
-Notation "∀  x .. y , P" := (forall x, .. (forall y, P) ..)
-  (at level 200, x binder, y binder, right associativity) : type_scope.
-Notation "∃  x .. y , P" := (exists x, .. (exists y, P) ..)
-  (at level 200, x binder, y binder, right associativity) : type_scope.
+Notation "∀ x .. y , P" := (forall x, .. (forall y, P) ..)
+  (at level 200, x binder, y binder, right associativity,
+  format "'[  ' ∀  x  ..  y ']' ,  P") : type_scope.
+Notation "∃ x .. y , P" := (exists x, .. (exists y, P) ..)
+  (at level 200, x binder, y binder, right associativity,
+  format "'[  ' ∃  x  ..  y ']' ,  P") : type_scope.
 
 Notation "x ∨ y" := (x \/ y) (at level 85, right associativity) : type_scope.
 Notation "x ∧ y" := (x /\ y) (at level 80, right associativity) : type_scope.
@@ -25,5 +27,6 @@ Notation "¬ x" := (~x) (at level 75, right associativity) : type_scope.
 Notation "x ≠ y" := (x <> y) (at level 70) : type_scope.
 
 (* Abstraction *)
-Notation "'λ'  x .. y , t" := (fun x => .. (fun y => t) ..)
-  (at level 200, x binder, y binder, right associativity).
+Notation "'λ' x .. y , t" := (fun x => .. (fun y => t) ..)
+  (at level 200, x binder, y binder, right associativity,
+  format "'[  ' 'λ'  x  ..  y ']' ,  t").
diff --git a/theories/Vectors/Vector.v b/theories/Vectors/Vector.v
index 672858fa5..19d749fc8 100644
--- a/theories/Vectors/Vector.v
+++ b/theories/Vectors/Vector.v
@@ -21,4 +21,4 @@ Require VectorSpec.
 Require VectorEq.
 Include VectorDef.
 Include VectorSpec.
-Include VectorEq.
\ No newline at end of file
+Include VectorEq.
diff --git a/theories/ZArith/BinIntDef.v b/theories/ZArith/BinIntDef.v
index 7686fbae8..a0393f318 100644
--- a/theories/ZArith/BinIntDef.v
+++ b/theories/ZArith/BinIntDef.v
@@ -299,6 +299,23 @@ Definition to_pos (z:Z) : positive :=
     | _ => 1%positive
   end.
 
+(** Conversion with a decimal representation for printing/parsing *)
+
+Definition of_uint (d:Decimal.uint) := of_N (Pos.of_uint d).
+
+Definition of_int (d:Decimal.int) :=
+  match d with
+  | Decimal.Pos d => of_uint d
+  | Decimal.Neg d => opp (of_uint d)
+  end.
+
+Definition to_int n :=
+  match n with
+  | 0 => Decimal.Pos Decimal.zero
+  | pos p => Decimal.Pos (Pos.to_uint p)
+  | neg p => Decimal.Neg (Pos.to_uint p)
+  end.
+
 (** ** Iteration of a function
 
     By convention, iterating a negative number of times is identity.
@@ -616,4 +633,4 @@ Definition lxor a b :=
    | neg a, neg b => of_N (N.lxor (Pos.pred_N a) (Pos.pred_N b))
  end.
 
-End Z.
\ No newline at end of file
+End Z.
diff --git a/theories/ZArith/Zsqrt_compat.v b/theories/ZArith/Zsqrt_compat.v
index fb7f71b4b..cccd970da 100644
--- a/theories/ZArith/Zsqrt_compat.v
+++ b/theories/ZArith/Zsqrt_compat.v
@@ -229,4 +229,4 @@ Proof.
  symmetry. apply Z.sqrt_unique; trivial.
  now apply Zsqrt_interval.
  now destruct n.
-Qed.
\ No newline at end of file
+Qed.
diff --git a/tools/CoqMakefile.in b/tools/CoqMakefile.in
index f4d1118d0..727fd3ec3 100644
--- a/tools/CoqMakefile.in
+++ b/tools/CoqMakefile.in
@@ -34,11 +34,11 @@ LOCAL             := $(COQMF_LOCAL)
 COQLIB            := $(COQMF_COQLIB)
 DOCDIR            := $(COQMF_DOCDIR)
 OCAMLFIND         := $(COQMF_OCAMLFIND)
-CAMLP4            := $(COQMF_CAMLP4)
-CAMLP4O           := $(COQMF_CAMLP4O)
-CAMLP4BIN         := $(COQMF_CAMLP4BIN)
-CAMLP4LIB         := $(COQMF_CAMLP4LIB)
-CAMLP4OPTIONS     := $(COQMF_CAMLP4OPTIONS)
+CAMLP5O           := $(COQMF_CAMLP5O)
+CAMLP5BIN         := $(COQMF_CAMLP5BIN)
+CAMLP5LIB         := $(COQMF_CAMLP5LIB)
+CAMLP5OPTIONS     := $(COQMF_CAMLP5OPTIONS)
+CAMLFLAGS         := $(COQMF_CAMLFLAGS)
 HASNATDYNLINK     := $(COQMF_HASNATDYNLINK)
 
 @CONF_FILE@: @PROJECT_FILE@
@@ -86,7 +86,6 @@ COQCHK   ?= "$(COQBIN)coqchk"
 COQDEP   ?= "$(COQBIN)coqdep"
 GALLINA  ?= "$(COQBIN)gallina"
 COQDOC   ?= "$(COQBIN)coqdoc"
-COQMKTOP ?= "$(COQBIN)coqmktop"
 COQMKFILE ?= "$(COQBIN)coq_makefile"
 
 # Timing scripts
@@ -100,11 +99,11 @@ AFTER ?=
 CAMLDONTLINK=camlp5.gramlib,unix,str
 
 # OCaml binaries
-CAMLC       ?= "$(OCAMLFIND)" ocamlc -c -rectypes -thread
-CAMLOPTC    ?= "$(OCAMLFIND)" opt    -c -rectypes -thread
-CAMLLINK    ?= "$(OCAMLFIND)" ocamlc    -rectypes -thread -linkpkg -dontlink $(CAMLDONTLINK)
-CAMLOPTLINK ?= "$(OCAMLFIND)" opt       -rectypes -thread -linkpkg -dontlink $(CAMLDONTLINK)
-CAMLDOC     ?= "$(OCAMLFIND)" ocamldoc  -rectypes
+CAMLC       ?= "$(OCAMLFIND)" ocamlc   -c
+CAMLOPTC    ?= "$(OCAMLFIND)" opt      -c
+CAMLLINK    ?= "$(OCAMLFIND)" ocamlc   -linkpkg -dontlink $(CAMLDONTLINK)
+CAMLOPTLINK ?= "$(OCAMLFIND)" opt      -linkpkg -dontlink $(CAMLDONTLINK)
+CAMLDOC     ?= "$(OCAMLFIND)" ocamldoc
 CAMLDEP     ?= "$(OCAMLFIND)" ocamldep -slash -ml-synonym .ml4 -ml-synonym .mlpack
 
 # DESTDIR is prepended to all installation paths
@@ -114,13 +113,13 @@ DESTDIR ?=
 CAMLDEBUG ?=
 COQDEBUG ?=
 
-# Extra flags to the OCaml compiler
-CAMLFLAGS ?=
 # Extra packages to be linked in (as in findlib -package)
 CAMLPKGS ?=
 
 # Option for making timing files
 TIMING?=
+# Option for changing sorting of timing output file
+TIMING_SORT_BY ?= auto
 # Output file names for timed builds
 TIME_OF_BUILD_FILE               ?= time-of-build.log
 TIME_OF_BUILD_BEFORE_FILE        ?= time-of-build-before.log
@@ -169,29 +168,32 @@ endif
 
 COQFLAGS?=-q $(OPT) $(COQLIBS) $(OTHERFLAGS)
 COQCHKFLAGS?=-silent -o $(COQLIBS)
-COQDOCFLAGS?=-interpolate -utf8 $(COQLIBS_NOML)
+COQDOCFLAGS?=-interpolate -utf8
+COQDOCLIBS?=$(COQLIBS_NOML)
 
 # The version of Coq being run and the version of coq_makefile that
 # generated this makefile
-COQ_VERSION:=$(shell $(COQC) --print-version | cut -d ' ' -f 1)
+COQ_VERSION:=$(shell $(COQC) --print-version | cut -d " " -f 1)
 COQMAKEFILE_VERSION:=@COQ_VERSION@
 
 COQSRCLIBS?= $(foreach d,$(COQ_SRC_SUBDIRS), -I "$(COQLIB)$(d)")
 
-CAMLFLAGS+=$(OCAMLLIBS) $(COQSRCLIBS) -I $(CAMLP4LIB) $(OCAML_API_FLAGS)
+CAMLFLAGS+=$(OCAMLLIBS) $(COQSRCLIBS) -I $(CAMLP5LIB)
 
-CAMLLIB:=$(shell "$(OCAMLFIND)" printconf stdlib)
+# ocamldoc fails with unknown argument otherwise
+CAMLDOCFLAGS=$(filter-out -annot, $(filter-out -bin-annot, $(CAMLFLAGS)))
 
 # FIXME This should be generated by Coq
 GRAMMARS:=grammar.cma
-ifeq ($(CAMLP4),camlp5)
-CAMLP4EXTEND=pa_extend.cmo q_MLast.cmo pa_macro.cmo
+CAMLP5EXTEND=pa_extend.cmo q_MLast.cmo pa_macro.cmo
+
+CAMLLIB:=$(shell "$(OCAMLFIND)" printconf stdlib 2> /dev/null)
+ifeq (,$(CAMLLIB))
+PP=$(error "Cannot find the 'ocamlfind' binary used to build Coq ($(OCAMLFIND)). Pre-compiled binary packages of Coq do not support compiling plugins this way. Please download the sources of Coq and run the Windows build script.")
 else
-CAMLP4EXTEND=
+PP:=-pp '$(CAMLP5O) -I $(CAMLLIB) -I "$(COQLIB)/grammar" $(CAMLP5EXTEND) $(GRAMMARS) $(CAMLP5OPTIONS) -impl'
 endif
 
-PP:=-pp '$(CAMLP4O) -I $(CAMLLIB) -I "$(COQLIB)/grammar" $(CAMLP4EXTEND) $(GRAMMARS) $(CAMLP4OPTIONS) -impl'
-
 ifneq (,$(TIMING))
 TIMING_ARG=-time
 ifeq (after,$(TIMING))
@@ -207,8 +209,8 @@ else
 TIMING_ARG=
 endif
 
-# Retro compatibility (DESTDIR is standard on Unix, DESTROOT is not)
-ifneq "$(DSTROOT)" ""
+# Retro compatibility (DESTDIR is standard on Unix, DSTROOT is not)
+ifdef DSTROOT
 DESTDIR := $(DSTROOT)
 endif
 
@@ -223,8 +225,9 @@ COQTOPINSTALL = $(call concat_path,$(DESTDIR),$(COQLIB)toploop)
 # We here define a bunch of variables about the files being part of the
 # Coq project in order to ease the writing of build target and build rules
 
+VDFILE := .coqdeps
+
 ALLSRCFILES := \
-	$(VFILES) \
 	$(ML4FILES) \
 	$(MLFILES) \
 	$(MLPACKFILES) \
@@ -284,13 +287,15 @@ ALLNATIVEFILES = \
 	$(OBJFILES:.o=.cmi) \
 	$(OBJFILES:.o=.cmx) \
 	$(OBJFILES:.o=.cmxs)
-# trick: wildcard filters out non-existing files
-NATIVEFILESTOINSTALL = $(foreach f, $(ALLNATIVEFILES), $(wildcard $f))
+# trick: wildcard filters out non-existing files, so that `install` doesn't show
+# warnings and `clean` doesn't pass to rm a list of files that is too long for
+# the shell.
+NATIVEFILES = $(wildcard $(ALLNATIVEFILES))
 FILESTOINSTALL = \
 	$(VOFILES) \
 	$(VFILES) \
 	$(GLOBFILES) \
-	$(NATIVEFILESTOINSTALL) \
+	$(NATIVEFILES) \
 	$(CMIFILESTOINSTALL)
 BYTEFILESTOINSTALL = \
 	$(CMOFILESTOINSTALL) \
@@ -302,7 +307,7 @@ else
 DO_NATDYNLINK =
 endif
 
-ALLDFILES = $(addsuffix .d,$(ALLSRCFILES))
+ALLDFILES = $(addsuffix .d,$(ALLSRCFILES) $(VDFILE))
 
 # Compilation targets #########################################################
 
@@ -327,7 +332,7 @@ make-pretty-timed make-pretty-timed-before make-pretty-timed-after::
 print-pretty-timed::
 	$(HIDE)$(COQMAKE_ONE_TIME_FILE) $(TIME_OF_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES)
 print-pretty-timed-diff::
-	$(HIDE)$(COQMAKE_BOTH_TIME_FILES) $(TIME_OF_BUILD_BEFORE_FILE) $(TIME_OF_BUILD_AFTER_FILE) $(TIME_OF_PRETTY_BOTH_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES)
+	$(HIDE)$(COQMAKE_BOTH_TIME_FILES) --sort-by=$(TIMING_SORT_BY) $(TIME_OF_BUILD_BEFORE_FILE) $(TIME_OF_BUILD_AFTER_FILE) $(TIME_OF_PRETTY_BOTH_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES)
 ifeq (,$(BEFORE))
 print-pretty-single-time-diff::
 	@echo 'Error: Usage: $(MAKE) print-pretty-single-time-diff BEFORE=path/to/file.v.before-timing AFTER=path/to/file.v.after-timing'
@@ -339,7 +344,7 @@ print-pretty-single-time-diff::
 	$(HIDE)false
 else
 print-pretty-single-time-diff::
-	$(HIDE)$(COQMAKE_BOTH_SINGLE_TIMING_FILES) $(BEFORE) $(AFTER) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES)
+	$(HIDE)$(COQMAKE_BOTH_SINGLE_TIMING_FILES) --sort-by=$(TIMING_SORT_BY) $(BEFORE) $(AFTER) $(TIME_OF_PRETTY_BUILD_FILE) $(TIME_OF_PRETTY_BUILD_EXTRA_FILES)
 endif
 endif
 pretty-timed:
@@ -372,7 +377,7 @@ bytefiles: $(CMOFILES) $(CMAFILES)
 optfiles: $(if $(DO_NATDYNLINK),$(CMXSFILES))
 .PHONY: optfiles
 
-# FIXME, see Ralph's bugreport
+# FIXME, see Ralf's bugreport
 quick: $(VOFILES:.vo=.vio)
 .PHONY: quick
 
@@ -381,13 +386,25 @@ vio2vo:
 		-schedule-vio2vo $(J) $(VOFILES:%.vo=%.vio)
 .PHONY: vio2vo
 
+quick2vo:
+	$(HIDE)make -j $(J) quick
+	$(HIDE)VIOFILES=$$(for vofile in $(VOFILES); do \
+	  viofile="$$(echo "$$vofile" | sed "s/\.vo$$/.vio/")"; \
+	  if [ "$$vofile" -ot "$$viofile" -o ! -e "$$vofile" ]; then printf "$$viofile "; fi; \
+	done); \
+	echo "VIO2VO: $$VIOFILES"; \
+	if [ -n "$$VIOFILES" ]; then \
+	  $(TIMER) $(COQC) $(COQDEBUG) $(COQFLAGS) -schedule-vio2vo $(J) $$VIOFILES; \
+	fi
+.PHONY: quick2vo
+
 checkproofs:
 	$(TIMER) $(COQC) $(COQDEBUG) $(COQFLAGS) \
 		-schedule-vio-checking $(J) $(VOFILES:%.vo=%.vio)
 .PHONY: checkproofs
 
 validate: $(VOFILES)
-	$(TIMER) $(COQCHK) $(COQCHKFLAGS) $(notdir $(^:.vo=))
+	$(TIMER) $(COQCHK) $(COQCHKFLAGS) $^
 .PHONY: validate
 
 only: $(TGTS)
@@ -405,12 +422,12 @@ mlihtml: $(MLIFILES:.mli=.cmi)
 	$(SHOW)'CAMLDOC -d $@'
 	$(HIDE)mkdir $@ || rm -rf $@/*
 	$(HIDE)$(CAMLDOC) -html \
-		-d $@ -m A $(CAMLDEBUG) $(CAMLFLAGS) $(MLIFILES)
+		-d $@ -m A $(CAMLDEBUG) $(CAMLDOCFLAGS) $(MLIFILES)
 
 all-mli.tex: $(MLIFILES:.mli=.cmi)
 	$(SHOW)'CAMLDOC -latex $@'
 	$(HIDE)$(CAMLDOC) -latex \
-		-o $@ -m A $(CAMLDEBUG) $(CAMLFLAGS) $(MLIFILES)
+		-o $@ -m A $(CAMLDEBUG) $(CAMLDOCFLAGS) $(MLIFILES)
 
 gallina: $(GFILES)
 
@@ -427,7 +444,7 @@ all.pdf: $(VFILES)
 		-o $@ `$(COQDEP) -sort -suffix .v $(VFILES)`
 
 # FIXME: not quite right, since the output name is different
-gallinahtml: GAL=g
+gallinahtml: GAL=-g
 gallinahtml: html
 
 all-gal.ps: GAL=-g
@@ -500,7 +517,7 @@ uninstall::
 	 instf="$(COQLIBINSTALL)/$$df/`basename $$f`" &&\
 	 rm -f "$$instf" &&\
 	 echo RM "$$instf" &&\
-	 (rmdir "$(call concat_path,,$(COQLIBINSTALL)/$$df/)" || true); \
+	 (rmdir "$(call concat_path,,$(COQLIBINSTALL)/$$df/)" 2>/dev/null || true); \
 	done
 .PHONY: uninstall
 
@@ -530,7 +547,7 @@ clean::
 	$(HIDE)rm -f $(CMOFILES:.cmo=.o)
 	$(HIDE)rm -f $(CMXAFILES:.cmxa=.a)
 	$(HIDE)rm -f $(ALLDFILES)
-	$(HIDE)rm -f $(ALLNATIVEFILES)
+	$(HIDE)rm -f $(NATIVEFILES)
 	$(HIDE)find . -name .coq-native -type d -empty -delete
 	$(HIDE)rm -f $(VOFILES)
 	$(HIDE)rm -f $(VOFILES:.vo=.vio)
@@ -558,7 +575,7 @@ cleanall:: clean
 archclean::
 	@# Extension point
 	$(SHOW)'CLEAN *.cmx *.o'
-	$(HIDE)rm -f $(ALLNATIVEFILES)
+	$(HIDE)rm -f $(NATIVEFILES)
 	$(HIDE)rm -f $(CMOFILES:%.cmo=%.cmx)
 .PHONY: archclean
 
@@ -707,9 +724,9 @@ $(addsuffix .d,$(MLPACKFILES)): %.mlpack.d: %.mlpack
 	$(SHOW)'COQDEP $<'
 	$(HIDE)$(COQDEP) $(OCAMLLIBS) -c "$<" $(redir_if_ok)
 
-$(addsuffix .d,$(VFILES)): %.v.d: %.v
-	$(SHOW)'COQDEP $<'
-	$(HIDE)$(COQDEP) $(COQLIBS) -dyndep var -c "$<" $(redir_if_ok)
+$(VDFILE).d: $(VFILES)
+	$(SHOW)'COQDEP VFILES'
+	$(HIDE)$(COQDEP) $(COQLIBS) -dyndep var -c $(VFILES) $(redir_if_ok)
 
 # Misc ########################################################################
 
@@ -730,11 +747,10 @@ printenv::
 	@echo 'COQLIB = $(COQLIB)'
 	@echo 'DOCDIR = $(DOCDIR)'
 	@echo 'OCAMLFIND = $(OCAMLFIND)'
-	@echo 'CAMLP4 = $(CAMLP4)'
-	@echo 'CAMLP4O = $(CAMLP4O)'
-	@echo 'CAMLP4BIN = $(CAMLP4BIN)'
-	@echo 'CAMLP4LIB = $(CAMLP4LIB)'
-	@echo 'CAMLP4OPTIONS = $(CAMLP4OPTIONS)'
+	@echo 'CAMLP5O = $(CAMLP5O)'
+	@echo 'CAMLP5BIN = $(CAMLP5BIN)'
+	@echo 'CAMLP5LIB = $(CAMLP5LIB)'
+	@echo 'CAMLP5OPTIONS = $(CAMLP5OPTIONS)'
 	@echo 'HASNATDYNLINK = $(HASNATDYNLINK)'
 	@echo 'SRC_SUBDIRS = $(SRC_SUBDIRS)'
 	@echo 'COQ_SRC_SUBDIRS = $(COQ_SRC_SUBDIRS)'
@@ -749,7 +765,7 @@ printenv::
 # file you can extend the merlin-hook target in @LOCAL_FILE@
 .merlin:
 	$(SHOW)'FILL .merlin'
-	$(HIDE)echo 'FLG -rectypes -thread' > .merlin
+	$(HIDE)echo 'FLG $(COQMF_CAMLFLAGS)' > .merlin
 	$(HIDE)echo 'B $(COQLIB)' >> .merlin
 	$(HIDE)echo 'S $(COQLIB)' >> .merlin
 	$(HIDE)$(foreach d,$(COQ_SRC_SUBDIRS), \
diff --git a/tools/TimeFileMaker.py b/tools/TimeFileMaker.py
index a207c2171..0d24332f1 100644
--- a/tools/TimeFileMaker.py
+++ b/tools/TimeFileMaker.py
@@ -10,6 +10,20 @@ STRIP_REG = re.compile('^(coq/|contrib/|)(?:theories/|src/)?')
 STRIP_REP = r'\1'
 INFINITY  = '\xe2\x88\x9e'
 
+def parse_args(argv, USAGE, HELP_STRING):
+    sort_by = 'auto'
+    if any(arg.startswith('--sort-by=') for arg in argv[1:]):
+        sort_by = [arg for arg in argv[1:] if arg.startswith('--sort-by=')][-1][len('--sort-by='):]
+    args = [arg for arg in argv if not arg.startswith('--sort-by=')]
+    if len(args) < 3 or '--help' in args[1:] or '-h' in args[1:] or sort_by not in ('auto', 'absolute', 'diff'):
+        print(USAGE)
+        if '--help' in args[1:] or '-h' in args[1:]:
+            print(HELP_STRING)
+            if len(args) == 2: sys.exit(0)
+        sys.exit(1)
+    return sort_by, args
+
+
 def reformat_time_string(time):
     seconds, milliseconds = time.split('.')
     seconds = int(seconds)
@@ -28,10 +42,10 @@ def get_times(file_name):
     else:
         with open(file_name, 'r') as f:
             lines = f.read()
-    reg = re.compile(r'^([^\s]+) \([^\)]*?user: ([0-9\.]+)[^\)]*?\)$', re.MULTILINE)
+    reg = re.compile(r'^([^\s]+) \([^\)]*?user: ([0-9\.]+)[^\)]*?\)\s*$', re.MULTILINE)
     times = reg.findall(lines)
     if all(time in ('0.00', '0.01') for name, time in times):
-        reg = re.compile(r'^([^\s]*) \([^\)]*?real: ([0-9\.]+)[^\)]*?\)$', re.MULTILINE)
+        reg = re.compile(r'^([^\s]*) \([^\)]*?real: ([0-9\.]+)[^\)]*?\)\s*$', re.MULTILINE)
         times = reg.findall(lines)
     if all(STRIP_REG.search(name.strip()) for name, time in times):
         times = tuple((STRIP_REG.sub(STRIP_REP, name.strip()), time) for name, time in times)
@@ -55,12 +69,15 @@ def get_single_file_times(file_name):
     FORMAT = 'Chars %%0%dd - %%0%dd %%s' % (longest, longest)
     return dict((FORMAT % (int(start), int(stop), name), reformat_time_string(time)) for start, stop, name, time, extra in times)
 
+def fix_sign_for_sorting(num, descending=True):
+    return -num if descending else num
+
 def make_sorting_key(times_dict, descending=True):
     def get_key(name):
         minutes, seconds = times_dict[name].replace('s', '').split('m')
-        def fix_sign(num):
-            return -num if descending else num
-        return (fix_sign(int(minutes)), fix_sign(float(seconds)), name)
+        return (fix_sign_for_sorting(int(minutes), descending=descending),
+                fix_sign_for_sorting(float(seconds), descending=descending),
+                name)
     return get_key
 
 def get_sorted_file_list_from_times_dict(times_dict, descending=True):
@@ -105,6 +122,7 @@ def format_percentage(num, signed=True):
     return sign + '%d.%02d%%' % (whole_part, frac_part)
 
 def make_diff_table_string(left_times_dict, right_times_dict,
+                           sort_by='auto',
                            descending=True,
                            left_tag="After", tag="File Name", right_tag="Before", with_percent=True,
                            change_tag="Change", percent_change_tag="% Change"):
@@ -122,10 +140,15 @@ def make_diff_table_string(left_times_dict, right_times_dict,
                                            if rseconds != 0 else (INFINITY if lseconds > 0 else 'N/A')))
                                    for name, lseconds, rseconds in prediff_times)
     # update to sort by approximate difference, first
-    get_key = make_sorting_key(all_names_dict, descending=descending)
-    all_names_dict = dict((name, (abs(int(to_seconds(diff_times_dict[name]))), get_key(name)))
-                          for name in all_names_dict.keys())
-    names = sorted(all_names_dict.keys(), key=all_names_dict.get)
+    get_key_abs = make_sorting_key(all_names_dict, descending=descending)
+    get_key_diff = (lambda name: fix_sign_for_sorting(int(abs(to_seconds(diff_times_dict[name]))), descending=descending))
+    if sort_by == 'absolute':
+        get_key = get_key_abs
+    elif sort_by == 'diff':
+        get_key = get_key_diff
+    else: # sort_by == 'auto'
+        get_key = (lambda name: (get_key_diff(name), get_key_abs(name)))
+    names = sorted(all_names_dict.keys(), key=get_key)
     #names = get_sorted_file_list_from_times_dict(all_names_dict, descending=descending)
     # set the widths of each of the columns by the longest thing to go in that column
     left_sum = sum_times(left_times_dict.values())
diff --git a/tools/coq_makefile.ml b/tools/coq_makefile.ml
index de76bf98b..1e1862220 100644
--- a/tools/coq_makefile.ml
+++ b/tools/coq_makefile.ml
@@ -27,16 +27,8 @@ let rec print_prefix_list sep = function
   | x :: l -> print sep; print x; print_prefix_list sep l
   | [] -> ()
 
-let usage () =
-  output_string stderr "Usage summary:\
-\n\
-\ncoq_makefile .... [file.v] ... [file.ml[i4]?] ... [file.ml{lib,pack}]\
-\n  ... [any] ... [-extra[-phony] result dependencies command]\
-\n  ... [-I dir] ... [-R physicalpath logicalpath]\
-\n  ... [-Q physicalpath logicalpath] ... [VARIABLE = value]\
-\n  ...  [-arg opt] ... [-opt|-byte] [-no-install] [-f file] [-o file]\
-\n  [-h] [--help]\
-\n\
+let usage_common () =
+  output_string stderr "\
 \n[file.v]: Coq file to be compiled\
 \n[file.ml[i4]?]: Objective Caml file to be compiled\
 \n[file.ml{lib,pack}]: ocamlbuild file that describes a Objective Caml\
@@ -65,10 +57,28 @@ let usage () =
 \n[-install opt]: where opt is \"user\" to force install into user directory,\
 \n  \"none\" to build a makefile with no install target or\
 \n  \"global\" to force install in $COQLIB directory\
+\n"
+
+let usage_coq_project () =
+  output_string stderr "Available arguments:";
+  usage_common ();
+  exit 1
+
+let usage_coq_makefile () =
+  output_string stderr "Usage summary:\
+\n\
+\ncoq_makefile .... [file.v] ... [file.ml[i4]?] ... [file.ml{lib,pack}]\
+\n  ... [any] ... [-extra[-phony] result dependencies command]\
+\n  ... [-I dir] ... [-R physicalpath logicalpath]\
+\n  ... [-Q physicalpath logicalpath] ... [VARIABLE = value]\
+\n  ...  [-arg opt] ... [-opt|-byte] [-no-install] [-f file] [-o file]\
+\n  [-h] [--help]\
+\n";
+  usage_common ();
+  output_string stderr "\
 \n[-f file]: take the contents of file as arguments\
-\n[-o file]: output should go in file file\
+\n[-o file]: output should go in file file (recommended)\
 \n	Output file outside the current directory is forbidden.\
-\n[-bypass-API]: when compiling plugins, bypass Coq API\
 \n[-h]: print this usage summary\
 \n[--help]: equivalent to [-h]\n";
   exit 1
@@ -114,7 +124,7 @@ let read_whole_file s =
     close_in ic;
     Buffer.contents b
 
-let quote s = if String.contains s ' ' then "'" ^ s ^ "'" else s
+let quote s = if String.contains s ' ' || CString.is_empty s then "'" ^ s ^ "'" else s
 
 let generate_makefile oc conf_file local_file args project =
   let makefile_template =
@@ -122,7 +132,8 @@ let generate_makefile oc conf_file local_file args project =
     Envars.coqlib () ^ template in
   let s = read_whole_file makefile_template in
   let s = List.fold_left
-    (fun s (k,v) -> Str.global_replace (Str.regexp_string k) v s) s
+    (* We use global_substitute to avoid running into backslash issues due to \1 etc. *)
+    (fun s (k,v) -> Str.global_substitute (Str.regexp_string k) (fun _ -> v) s) s
     [ "@CONF_FILE@", conf_file;
       "@LOCAL_FILE@", local_file;
       "@COQ_VERSION@", Coq_config.version;
@@ -198,16 +209,10 @@ let windrive s =
   else s
 ;;
 
-let generate_conf_coq_config oc args bypass_API =
+let generate_conf_coq_config oc args =
   section oc "Coq configuration.";
-  let src_dirs = if bypass_API
-                 then Coq_config.all_src_dirs
-                 else Coq_config.api_dirs @ Coq_config.plugins_dirs in
+  let src_dirs = Coq_config.all_src_dirs in
   Envars.print_config ~prefix_var_name:"COQMF_" oc src_dirs;
-  if bypass_API then
-    Printf.fprintf oc "OCAML_API_FLAGS=\n"
-  else
-    Printf.fprintf oc "OCAML_API_FLAGS=-open API\n";
   fprintf oc "COQMF_WINDRIVE=%s\n" (windrive Coq_config.coqlib)
 ;;
 
@@ -266,7 +271,7 @@ let generate_conf oc project args  =
   fprintf oc "# %s\n\n" (String.concat " " (List.map quote args));
   generate_conf_files oc project;
   generate_conf_includes oc project;
-  generate_conf_coq_config oc args project.bypass_API;
+  generate_conf_coq_config oc args;
   generate_conf_defs oc project;
   generate_conf_doc oc project;
   generate_conf_extra_target oc project.extra_targets;
@@ -274,7 +279,7 @@ let generate_conf oc project args  =
 ;;
 
 let ensure_root_dir
-  ({ ml_includes; r_includes;
+  ({ ml_includes; r_includes; q_includes;
      v_files; ml_files; mli_files; ml4_files;
      mllib_files; mlpack_files } as project)
 =
@@ -283,6 +288,7 @@ let ensure_root_dir
   let not_tops = List.for_all (fun s -> s <> Filename.basename s) in
   if exists (fun { canonical_path = x } -> x = here) ml_includes
   || exists (fun ({ canonical_path = x },_) -> is_prefix x here) r_includes
+  || exists (fun ({ canonical_path = x },_) -> is_prefix x here) q_includes
   || (not_tops v_files &&
       not_tops mli_files && not_tops ml4_files && not_tops ml_files &&
       not_tops mllib_files && not_tops mlpack_files)
@@ -378,8 +384,8 @@ let share_prefix s1 s2 =
   | _ -> false
 
 let _ =
+  let _fhandle = Feedback.(add_feeder (console_feedback_listener Format.err_formatter)) in
   let prog, args =
-    if Array.length Sys.argv = 1 then usage ();
     let args = Array.to_list Sys.argv in
     let prog = List.hd args in
     prog, List.tl args in
@@ -390,7 +396,7 @@ let _ =
 
   let project = 
     try cmdline_args_to_project ~curdir:Filename.current_dir_name args
-    with Parsing_error s -> prerr_endline s; usage () in
+    with Parsing_error s -> prerr_endline s; usage_coq_project () in
 
   if only_destination <> None then begin
     destination_of project (Option.get only_destination);
diff --git a/tools/coqc.ml b/tools/coqc.ml
index 862225d3d..b381c5ba4 100644
--- a/tools/coqc.ml
+++ b/tools/coqc.ml
@@ -93,7 +93,7 @@ let parse_args () =
 
     | ("-bt"|"-debug"|"-nolib"|"-boot"|"-time"|"-profile-ltac"
       |"-batch"|"-noinit"|"-nois"|"-noglob"|"-no-glob"
-      |"-q"|"-profile"|"-just-parsing"|"-echo" |"-quiet"
+      |"-q"|"-profile"|"-echo" |"-quiet"
       |"-silent"|"-m"|"-beautify"|"-strict-implicit"
       |"-impredicative-set"|"-vm"|"-native-compiler"
       |"-indices-matter"|"-quick"|"-type-in-type"
diff --git a/tools/coqdep.ml b/tools/coqdep.ml
index fd4be08b1..ca14b11bc 100644
--- a/tools/coqdep.ml
+++ b/tools/coqdep.ml
@@ -455,7 +455,7 @@ let usage () =
   eprintf "  -coqlib dir : set the coq standard library directory\n";
   eprintf "  -suffix s : \n";
   eprintf "  -slash : deprecated, no effect\n";
-  eprintf "  -dyndep (opt|byte|both|no|var) : set how dependencies over ML modules are printed";
+  eprintf "  -dyndep (opt|byte|both|no|var) : set how dependencies over ML modules are printed\n";
   exit 1
 
 let split_period = Str.split (Str.regexp (Str.quote "."))
@@ -539,4 +539,4 @@ let _ =
     coqdep ()
   with CErrors.UserError(s,p) ->
     let pp = (match s with | None -> p | Some s -> Pp.(str s ++ str ": " ++ p))  in
-    Feedback.msg_error pp
+    Format.eprintf "%a@\n%!" Pp.pp_with pp
diff --git a/tools/coqdep_lexer.mll b/tools/coqdep_lexer.mll
index 8eeb59898..564e20d0e 100644
--- a/tools/coqdep_lexer.mll
+++ b/tools/coqdep_lexer.mll
@@ -25,8 +25,6 @@
   exception Fin_fichier
   exception Syntax_error of int*int
 
-  let field_name s = String.sub s 1 (String.length s - 1)
-
   let unquote_string s =
     String.sub s 1 (String.length s - 2)
 
@@ -40,6 +38,18 @@
   let syntax_error lexbuf =
     raise (Syntax_error (Lexing.lexeme_start lexbuf, Lexing.lexeme_end lexbuf))
 
+  let check_valid lexbuf s =
+    match Unicode.ident_refutation s with
+    | None -> s
+    | Some _ -> syntax_error lexbuf
+
+  let get_ident lexbuf =
+    let s = Lexing.lexeme lexbuf in check_valid lexbuf s
+
+  let get_field_name lexbuf =
+    let s = Lexing.lexeme lexbuf in
+    check_valid lexbuf (String.sub s 1 (String.length s - 1))
+
   [@@@ocaml.warning "-3"]       (* String.uncapitalize_ascii since 4.03.0 GPR#124 *)
   let uncapitalize = String.uncapitalize
   [@@@ocaml.warning "+3"]
@@ -52,20 +62,8 @@ let identchar = ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9']
 let caml_up_ident = uppercase identchar*
 let caml_low_ident = lowercase identchar*
 
-let coq_firstchar =
-  (* This is only an approximation, refer to lib/util.ml for correct def *)
-  ['A'-'Z' 'a'-'z' '_'] |
-  (* superscript 1 *)
-  '\194' '\185' |
-  (* utf-8 latin 1 supplement *)
-  '\195' ['\128'-'\150'] | '\195' ['\152'-'\182'] | '\195' ['\184'-'\191'] |
-  (* utf-8 letters *)
-  '\206' (['\145'-'\161'] | ['\163'-'\187'])
-  '\226' ('\130' [ '\128'-'\137' ] (* subscripts *)
-    | '\129' [ '\176'-'\187' ] (* superscripts *)
-    | '\132' ['\128'-'\191'] | '\133' ['\128'-'\143'])
-let coq_identchar = coq_firstchar | ['\'' '0'-'9']
-let coq_ident = coq_firstchar coq_identchar*
+(* This is an overapproximation, we check correctness afterwards *)
+let coq_ident = ['A'-'Z' 'a'-'z' '_' '\128'-'\255'] ['A'-'Z' 'a'-'z' '_' '\'' '0'-'9' '\128'-'\255']*
 let coq_field = '.' coq_ident
 
 let dot = '.' ( space+ | eof)
@@ -102,7 +100,7 @@ and from_rule = parse
   | space+
       { from_rule lexbuf }
   | coq_ident
-      { let from = coq_qual_id_tail [Lexing.lexeme lexbuf] lexbuf in
+      { let from = coq_qual_id_tail [get_ident lexbuf] lexbuf in
         consume_require (Some from) lexbuf }
   | eof
       { syntax_error lexbuf }
@@ -241,7 +239,7 @@ and load_file = parse
 	parse_dot lexbuf;
 	Load (unquote_vfile_string s) }
   | coq_ident
-      { let s = lexeme lexbuf in skip_to_dot lexbuf; Load s }
+      { let s = get_ident lexbuf in skip_to_dot lexbuf; Load s }
   | eof
       { syntax_error lexbuf }
   | _
@@ -253,7 +251,7 @@ and require_file from = parse
   | space+
       { require_file from lexbuf }
   | coq_ident
-      { let name = coq_qual_id_tail [Lexing.lexeme lexbuf] lexbuf in
+      { let name = coq_qual_id_tail [get_ident lexbuf] lexbuf in
         let qid = coq_qual_id_list [name] lexbuf in
         parse_dot lexbuf;
         Require (from, qid) }
@@ -278,7 +276,7 @@ and coq_qual_id = parse
   | space+
       { coq_qual_id lexbuf }
   | coq_ident
-      { coq_qual_id_tail [Lexing.lexeme lexbuf] lexbuf }
+      { coq_qual_id_tail [get_ident lexbuf] lexbuf }
   | _
       { syntax_error lexbuf }
 
@@ -288,7 +286,7 @@ and coq_qual_id_tail module_name = parse
   | space+
       { coq_qual_id_tail module_name lexbuf }
   | coq_field
-      { coq_qual_id_tail (field_name (Lexing.lexeme lexbuf) :: module_name) lexbuf }
+      { coq_qual_id_tail (get_field_name lexbuf :: module_name) lexbuf }
   | eof
       { syntax_error lexbuf }
   | _
@@ -301,7 +299,7 @@ and coq_qual_id_list module_names = parse
   | space+
       { coq_qual_id_list module_names lexbuf }
   | coq_ident
-      { let name = coq_qual_id_tail [Lexing.lexeme lexbuf] lexbuf in
+      { let name = coq_qual_id_tail [get_ident lexbuf] lexbuf in
         coq_qual_id_list (name :: module_names) lexbuf
       }
   | eof
diff --git a/tools/coqdoc/cpretty.mll b/tools/coqdoc/cpretty.mll
index 60a245dc4..186f6cf6c 100644
--- a/tools/coqdoc/cpretty.mll
+++ b/tools/coqdoc/cpretty.mll
@@ -682,7 +682,7 @@ and doc_bol = parse
   | space* nl+
       { Output.paragraph (); doc_bol lexbuf }
   | "<<" space*
-      { Output.start_verbatim false; verbatim false lexbuf; doc_bol lexbuf }
+      { Output.start_verbatim false; verbatim 0 false lexbuf; doc_bol lexbuf }
   | eof
       { true }
   | '_'
@@ -707,7 +707,7 @@ and doc_list_bol indents = parse
       }
   | "<<" space*
       { Output.start_verbatim false;
-        verbatim false lexbuf;
+        verbatim 0 false lexbuf;
         doc_list_bol indents lexbuf }
   | "[[" nl
       { formatted := true;
@@ -852,7 +852,7 @@ and doc indents = parse
         Output.char (lexeme_char lexbuf 1);
         doc indents lexbuf }
   | "<<" space*
-      { Output.start_verbatim true; verbatim true lexbuf; doc_bol lexbuf }
+      { Output.start_verbatim true; verbatim 0 true lexbuf; doc_bol lexbuf }
   | '"'
       { if !Cdglobals.plain_comments 
 	then Output.char '"' 
@@ -892,13 +892,20 @@ and escaped_html = parse
         { backtrack lexbuf }
   | _   { Output.html_char (lexeme_char lexbuf 0); escaped_html lexbuf }
 
-and verbatim inline = parse
+and verbatim depth inline = parse
   | nl ">>" space* nl { Output.verbatim_char inline '\n'; Output.stop_verbatim inline }
   | nl ">>" { Output.verbatim_char inline '\n'; Output.stop_verbatim inline }
   | ">>" { Output.stop_verbatim inline }
-  | "*)" { Output.stop_verbatim inline; backtrack lexbuf }
+  | "(*" { Output.verbatim_char inline '(';
+           Output.verbatim_char inline '*';
+           verbatim (depth+1) inline lexbuf }
+  | "*)" { if (depth == 0)
+           then (Output.stop_verbatim inline; backtrack lexbuf)
+           else (Output.verbatim_char inline '*';
+                 Output.verbatim_char inline ')';
+                 verbatim (depth-1) inline lexbuf) }
   | eof { Output.stop_verbatim inline }
-  | _ { Output.verbatim_char inline (lexeme_char lexbuf 0); verbatim inline lexbuf }
+  | _ { Output.verbatim_char inline (lexeme_char lexbuf 0); verbatim depth inline lexbuf }
 
 and url = parse
   | "}}" { Output.url (Buffer.contents url_buffer) None; Buffer.clear url_buffer }
diff --git a/tools/coqmktop.ml b/tools/coqmktop.ml
deleted file mode 100644
index 28a3c791c..000000000
--- a/tools/coqmktop.ml
+++ /dev/null
@@ -1,298 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(** {1 Coqmktop} *)
-
-(** coqmktop is a script to link Coq, analogous to ocamlmktop.
-   The command line contains options specific to coqmktop, options for the
-   Ocaml linker and files to link (in addition to the default Coq files). *)
-
-(** {6 Utilities} *)
-
-(** Split a string at each blank
-*)
-let split_list =
-  let spaces = Str.regexp "[ \t\n]+" in
-  fun str -> Str.split spaces str
-
-[@@@ocaml.warning "-3"]       (* String.uncapitalize_ascii since 4.03.0 GPR#124 *)
-let capitalize = String.capitalize
-[@@@ocaml.warning "+3"]
-
-let (/) = Filename.concat
-
-(** Which user files do we support (and propagate to ocamlopt) ?
-*)
-let supported_suffix f = match CUnix.get_extension f with
-  | ".ml" | ".cmx" | ".cmo" | ".cmxa" | ".cma" | ".c" -> true
-  | _ -> false
-
-(** From bytecode extension to native
-*)
-let native_suffix f = match CUnix.get_extension f with
-  | ".cmo" -> (Filename.chop_suffix f ".cmo") ^ ".cmx"
-  | ".cma" -> (Filename.chop_suffix f ".cma") ^ ".cmxa"
-  | ".a" -> f
-  | _ -> failwith ("File "^f^" has not extension .cmo, .cma or .a")
-
-(** Transforms a file name in the corresponding Caml module name.
-*)
-let module_of_file name =
-  capitalize (try Filename.chop_extension name with Invalid_argument _ -> name)
-
-(** Run a command [prog] with arguments [args].
-    We do not use [Sys.command] anymore, see comment in [CUnix.sys_command].
-*)
-let run_command prog args =
-  match CUnix.sys_command prog args with
-  | Unix.WEXITED 127 -> failwith ("no such command "^prog)
-  | Unix.WEXITED n -> n
-  | Unix.WSIGNALED n -> failwith (prog^" killed by signal "^string_of_int n)
-  | Unix.WSTOPPED n -> failwith (prog^" stopped by signal "^string_of_int n)
-
-
-
-(** {6 Coqmktop options} *)
-
-let opt        = ref false
-let top        = ref false
-let echo       = ref false
-let no_start   = ref false
-
-let is_ocaml4 = Coq_config.caml_version.[0] <> '3'
-
-(** {6 Includes options} *)
-
-(** Since the Coq core .cma are given with their relative paths
-    (e.g. "lib/clib.cma"), we only need to include directories mentionned in
-    the temp main ml file below (for accessing the corresponding .cmi). *)
-
-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 () ] @
-  (if is_ocaml4 then ["-I"; "+compiler-libs"] else [])
-
-(** For the -R option, visit all directories under [dir] and add
-    corresponding -I to the [opts] option list (in reversed order) *)
-let incl_all_subdirs dir opts =
-  let l = ref opts in
-  let add f = l := f :: "-I" :: !l in
-  let rec traverse dir =
-    if Sys.file_exists dir && Sys.is_directory dir then
-      let () = add dir in
-      let subdirs = try Sys.readdir dir with any -> [||] in
-      Array.iter (fun f -> traverse (dir/f)) subdirs
-  in
-  traverse dir; !l
-
-
-(** {6 Objects to link} *)
-
-(** NB: dynlink is now always linked, it is used for loading plugins
-    and compiled vm code (see native-compiler). We now reject platforms
-    with ocamlopt but no dynlink.cmxa during ./configure, and give
-    instructions there about how to build a dummy dynlink.cmxa,
-    cf. dev/dynlink.ml. *)
-
-(** OCaml + CamlpX libraries *)
-
-let ocaml_libs = ["str.cma";"unix.cma";"nums.cma";"dynlink.cma";"threads.cma"]
-let camlp4_libs = ["gramlib.cma"]
-let libobjs = ocaml_libs @ camlp4_libs
-
-(** Toplevel objects *)
-
-let ocaml_topobjs =
-  if is_ocaml4 then
-    ["ocamlcommon.cma";"ocamlbytecomp.cma";"ocamltoplevel.cma"]
-  else
-    ["toplevellib.cma"]
-
-let camlp4_topobjs = ["camlp5_top.cma"; "pa_o.cmo"; "pa_extend.cmo"]
-
-let topobjs = ocaml_topobjs @ camlp4_topobjs
-
-(** Coq Core objects *)
-
-let copts = (split_list Coq_config.osdeplibs) @ (split_list Tolink.copts)
-let core_objs = split_list Tolink.core_objs
-let core_libs = split_list Tolink.core_libs
-
-(** Build the list of files to link and the list of modules names
-*)
-let files_to_link userfiles =
-  let top = if !top then topobjs else [] in
-  let modules = List.map module_of_file (top @ core_objs @ userfiles) in
-  let objs = libobjs @ top @ core_libs in
-  let objs' = (if !opt then List.map native_suffix objs else objs) @ userfiles
-  in (modules, objs')
-
-
-(** {6 Parsing of the command-line} *)
-
-let usage () =
-  prerr_endline "Usage: coqmktop <options> <ocaml options> files\
-\nFlags are:\
-\n  -coqlib dir    Specify where the Coq object files are\
-\n  -ocamlfind dir Specify where the ocamlfind binary is\
-\n  -camlp4bin dir Specify where the Camlp4/5 binaries are\
-\n  -o exec-file   Specify the name of the resulting toplevel\
-\n  -boot          Run in boot mode\
-\n  -echo          Print calls to external commands\
-\n  -opt           Compile in native code\
-\n  -top           Build Coq on a OCaml toplevel (incompatible with -opt)\
-\n  -R dir         Add recursively dir to OCaml search path\
-\n";
-  exit 1
-
-let parse_args () =
-  let rec parse (op,fl) = function
-    | [] -> List.rev op, List.rev fl
-
-    (* Directories *)
-    | "-coqlib" :: d :: rem ->
-	Flags.coqlib_spec := true; Flags.coqlib := d ; parse (op,fl) rem
-    | "-ocamlfind" :: d :: rem ->
-	Flags.ocamlfind_spec := true; Flags.ocamlfind := d ; parse (op,fl) rem
-    | "-camlp4bin" :: d :: rem ->
-	Flags.camlp4bin_spec := true; Flags.camlp4bin := d ; parse (op,fl) rem
-    | "-R" :: d :: rem -> parse (incl_all_subdirs d op,fl) rem
-    | ("-coqlib"|"-camlbin"|"-camlp4bin"|"-R") :: [] -> usage ()
-
-    (* Boolean options of coqmktop *)
-    | "-boot" :: rem -> Flags.boot := true; parse (op,fl) rem
-    | "-opt" :: rem -> opt := true ; parse (op,fl) rem
-    | "-top" :: rem -> top := true ; parse (op,fl) rem
-    | "-no-start" :: rem -> no_start:=true; parse (op, fl) rem
-    | "-echo" :: rem -> echo := true ; parse (op,fl) rem
-
-    (* Extra options with arity 0 or 1, directly passed to ocamlc/ocamlopt *)
-    | ("-noassert"|"-compact"|"-g"|"-p"|"-thread"|"-dtypes" as o) :: rem ->
-        parse (o::op,fl) rem
-    | ("-cclib"|"-ccopt"|"-I"|"-o"|"-w" as o) :: rem' ->
-	begin
-	  match rem' with
-	    | a :: rem -> parse (a::o::op,fl) rem
-	    | []       -> usage ()
-	end
-
-    | ("-h"|"-help"|"--help") :: _ -> usage ()
-    | f :: rem when supported_suffix f -> parse (op,f::fl) rem
-    | f :: _ -> prerr_endline ("Don't know what to do with " ^ f); exit 1
-  in
-  parse ([],[]) (List.tl (Array.to_list Sys.argv))
-
-
-(** {6 Temporary main file} *)
-
-(** remove the temporary main file
-*)
-let clean file =
-  let rm f = if Sys.file_exists f then Sys.remove f in
-  let basename = Filename.chop_suffix file ".ml" in
-  if not !echo then begin
-    rm file;
-    rm (basename ^ ".o");
-    rm (basename ^ ".cmi");
-    rm (basename ^ ".cmo");
-    rm (basename ^ ".cmx")
-  end
-
-(** Initializes the kind of loading in the main program
-*)
-let declare_loading_string () =
-  if not !top then
-    "Mltop.remove ();;"
-  else
-    "begin try\
-\n       (* Enable rectypes in the toplevel if it has the directive #rectypes *)\
-\n       begin match Hashtbl.find Toploop.directive_table \"rectypes\" with\
-\n         | Toploop.Directive_none f -> f ()\
-\n         | _ -> ()\
-\n       end\
-\n     with\
-\n       | Not_found -> ()\
-\n     end;;\
-\n\
-\n     let ppf = Format.std_formatter;;\
-\n     Mltop.set_top\
-\n       {Mltop.load_obj=\
-\n         (fun f -> if not (Topdirs.load_file ppf f)\
-\n                   then CErrors.user_err Pp.(str (\"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) };;\
-\n"
-
-(** create a temporary main file to link
-*)
-let create_tmp_main_file modules =
-  let main_name,oc = Filename.open_temp_file "coqmain" ".ml" in
-  try
-    (* Add the pre-linked modules *)
-    output_string oc "List.iter Mltop.add_known_module [\"";
-    output_string oc (String.concat "\";\"" modules);
-    output_string oc "\"];;\n";
-    (* Initializes the kind of loading *)
-    output_string oc (declare_loading_string());
-    (* Start the toplevel loop *)
-    if not !no_start then output_string oc "Coqtop.start();;\n";
-    close_out oc;
-    main_name
-  with reraise ->
-    clean main_name; raise reraise
-
-
-(** {6 Main } *)
-
-let main () =
-  let (options, userfiles) = parse_args () in
-  (* Directories: *)
-  let () = Envars.set_coqlib ~fail:(fun x -> CErrors.user_err Pp.(str x)) 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
-  (* Which arguments ? *)
-  if !opt && !top then failwith "no custom toplevel in native code!";
-  let flags = if !opt then [] else Coq_config.vmbyteflags in
-  let topstart = if !top then [ "topstart.cmo" ] else [] in
-  let (modules, tolink) = files_to_link userfiles in
-  let main_file = create_tmp_main_file modules in
-  try
-    (* - We add topstart.cmo explicitly because we shunted ocamlmktop wrapper.
-       - With the coq .cma, we MUST use the -linkall option. *)
-    let args =
-      "-linkall" :: "-rectypes" :: "-w" :: "-31" :: flags @ copts @ options @
-      (std_includes basedir) @ tolink @ [ main_file ] @ topstart
-    in
-    if !echo then begin
-      let command = String.concat " " (Envars.ocamlfind ()::prog::args) in
-      print_endline command;
-      print_endline
-	("(command length is " ^
-	    (string_of_int (String.length command)) ^ " characters)");
-      flush Pervasives.stdout
-    end;
-    let exitcode = run_command (Envars.ocamlfind ()) (prog::args) in
-    clean main_file;
-    exitcode
-  with reraise -> clean main_file; raise reraise
-
-let pr_exn = function
-  | Failure msg -> msg
-  | Unix.Unix_error (err,fn,arg) -> fn^" "^arg^" : "^Unix.error_message err
-  | any -> Printexc.to_string any
-
-let _ =
-  try exit (main ())
-  with any -> Printf.eprintf "Error: %s\n" (pr_exn any); exit 1
diff --git a/tools/coqwc.mll b/tools/coqwc.mll
index a0b6bfbbe..6ddeeb9b2 100644
--- a/tools/coqwc.mll
+++ b/tools/coqwc.mll
@@ -94,7 +94,7 @@ let rcs = "\036" rcs_keyword [^ '$']* "\036"
 let stars = "(*" '*'* "*)"
 let dot = '.' (' ' | '\t' | '\n' | '\r' | eof)
 let proof_start =
-  "Theorem" | "Lemma" | "Fact" | "Remark" | "Goal" | "Correctness" | "Obligation" | "Next"
+  "Theorem" | "Lemma" | "Fact" | "Remark" | "Goal" | "Correctness" | "Obligation" space+ (['0' - '9'])+ | "Next" space+ "Obligation"
 let def_start =
   "Definition" | "Fixpoint" | "Instance"
 let proof_end =
diff --git a/tools/coqworkmgr.ml b/tools/coqworkmgr.ml
index e1d1c60d7..f4777c4fb 100644
--- a/tools/coqworkmgr.ml
+++ b/tools/coqworkmgr.ml
@@ -14,7 +14,7 @@ type party = {
           sock     : Unix.file_descr;
           cout     : out_channel;
   mutable tokens   : int;
-          priority : Flags.priority;
+          priority : priority;
 }
 
 let answer party msg =
@@ -42,10 +42,10 @@ end = struct
   let is_empty q = !q = []
   let rec split acc = function
     | [] -> List.rev acc, []
-    | (_, { priority = Flags.Low }) :: _ as l -> List.rev acc, l
+    | (_, { priority = Low }) :: _ as l -> List.rev acc, l
     | x :: xs -> split (x :: acc) xs
   let push (_,{ priority } as item) q =
-    if priority = Flags.Low then q := !q @ [item]
+    if priority = Low then q := !q @ [item]
     else
       let high, low = split [] !q in
       q := high @ (item :: low)
@@ -148,7 +148,7 @@ let check_alive s =
   | Some s ->
       let cout = Unix.out_channel_of_descr s in
       set_binary_mode_out cout true;
-      output_string cout (print_request (Hello Flags.Low)); flush cout;
+      output_string cout (print_request (Hello Low)); flush cout;
       output_string cout (print_request Ping); flush cout;
       begin match Unix.select [s] [] [] 1.0 with
       | [s],_,_ ->
diff --git a/tools/fake_ide.ml b/tools/fake_ide.ml
index a9da27ba2..b5c5b2b96 100644
--- a/tools/fake_ide.ml
+++ b/tools/fake_ide.ml
@@ -252,11 +252,9 @@ let eval_print l coq =
       let to_id, _ = get_id id in
       eval_call (query (0,(phrase, to_id))) coq
   | [ Tok(_,"WAIT") ] ->
-      let phrase = "Stm Wait." in
-      eval_call (query (0,(phrase,tip_id()))) coq
+      eval_call (wait ()) coq
   | [ Tok(_,"JOIN") ] ->
-      let phrase = "Stm JoinDocument." in
-      eval_call (query (0,(phrase,tip_id()))) coq
+      eval_call (status true) coq
   | [ Tok(_,"ASSERT"); Tok(_,"TIP"); Tok(_,id) ] ->
       let to_id, _ = get_id id in
       if not(Stateid.equal (Document.tip doc) to_id) then error "Wrong tip"
@@ -290,7 +288,7 @@ let usage () =
      (Filename.basename Sys.argv.(0))
      (Parser.print grammar))
 
-module Coqide = Spawn.Sync(struct end)
+module Coqide = Spawn.Sync ()
 
 let main =
   if Sys.os_type = "Unix" then Sys.set_signal Sys.sigpipe
diff --git a/tools/coq-inferior.el b/tools/inferior-coq.el
index b79d97d66..b79d97d66 100644
--- a/tools/coq-inferior.el
+++ b/tools/inferior-coq.el
diff --git a/tools/make-both-single-timing-files.py b/tools/make-both-single-timing-files.py
index 2d33503c3..32c52c7a1 100755
--- a/tools/make-both-single-timing-files.py
+++ b/tools/make-both-single-timing-files.py
@@ -3,16 +3,10 @@ import sys
 from TimeFileMaker import *
 
 if __name__ == '__main__':
-    USAGE = 'Usage: %s AFTER_FILE_NAME BEFORE_FILE_NAME [OUTPUT_FILE_NAME ..]' % sys.argv[0]
+    USAGE = 'Usage: %s [--sort-by=auto|absolute|diff] AFTER_FILE_NAME BEFORE_FILE_NAME [OUTPUT_FILE_NAME ..]' % sys.argv[0]
     HELP_STRING = r'''Formats timing information from the output of two invocations of `coqc -time` into a sorted table'''
-    if len(sys.argv) < 3 or '--help' in sys.argv[1:] or '-h' in sys.argv[1:]:
-        print(USAGE)
-        if '--help' in sys.argv[1:] or '-h' in sys.argv[1:]:
-            print(HELP_STRING)
-            if len(sys.argv) == 2: sys.exit(0)
-        sys.exit(1)
-    else:
-        left_dict = get_single_file_times(sys.argv[1])
-        right_dict = get_single_file_times(sys.argv[2])
-        table = make_diff_table_string(left_dict, right_dict, tag="Code")
-        print_or_write_table(table, sys.argv[3:])
+    sort_by, args = parse_args(sys.argv, USAGE, HELP_STRING)
+    left_dict = get_single_file_times(args[1])
+    right_dict = get_single_file_times(args[2])
+    table = make_diff_table_string(left_dict, right_dict, tag="Code", sort_by=sort_by)
+    print_or_write_table(table, args[3:])
diff --git a/tools/make-both-time-files.py b/tools/make-both-time-files.py
index 69ec5a663..f730a8d6b 100755
--- a/tools/make-both-time-files.py
+++ b/tools/make-both-time-files.py
@@ -3,20 +3,14 @@ import sys
 from TimeFileMaker import *
 
 if __name__ == '__main__':
-    USAGE = 'Usage: %s AFTER_FILE_NAME BEFORE_FILE_NAME [OUTPUT_FILE_NAME ..]' % sys.argv[0]
+    USAGE = 'Usage: %s [--sort-by=auto|absolute|diff] AFTER_FILE_NAME BEFORE_FILE_NAME [OUTPUT_FILE_NAME ..]' % sys.argv[0]
     HELP_STRING = r'''Formats timing information from the output of two invocations of `make TIMED=1` into a sorted table.
 
 The input is expected to contain lines in the format:
 FILE_NAME (...user: NUMBER_IN_SECONDS...)
 '''
-    if len(sys.argv) < 3 or '--help' in sys.argv[1:] or '-h' in sys.argv[1:]:
-        print(USAGE)
-        if '--help' in sys.argv[1:] or '-h' in sys.argv[1:]:
-            print(HELP_STRING)
-            if len(sys.argv) == 2: sys.exit(0)
-        sys.exit(1)
-    else:
-        left_dict = get_times(sys.argv[1])
-        right_dict = get_times(sys.argv[2])
-        table = make_diff_table_string(left_dict, right_dict)
-        print_or_write_table(table, sys.argv[3:])
+    sort_by, args = parse_args(sys.argv, USAGE, HELP_STRING)
+    left_dict = get_times(args[1])
+    right_dict = get_times(args[2])
+    table = make_diff_table_string(left_dict, right_dict, sort_by=sort_by)
+    print_or_write_table(table, args[3:])
diff --git a/tools/md5sum.ml b/tools/md5sum.ml
new file mode 100644
index 000000000..2fdcacc83
--- /dev/null
+++ b/tools/md5sum.ml
@@ -0,0 +1,24 @@
+let get_content file =
+  let ic = open_in_bin file in
+  let buf = Buffer.create 2048 in
+  let rec fill () =
+    match input_char ic with
+    | '\r' -> fill () (* NOTE: handles the case on Windows where the
+                         git checkout has included return characters.
+                         See: https://github.com/coq/coq/pull/6305 *)
+    | c -> Buffer.add_char buf c; fill ()
+    | exception End_of_file -> close_in ic; Buffer.contents buf
+  in
+  fill ()
+
+let () =
+  match Sys.argv with
+  | [|_; file|] ->
+      let content = get_content file in
+      let md5 = Digest.to_hex (Digest.string content) in
+      print_string (md5 ^ " " ^ file)
+  | _ ->
+      prerr_endline "Error: This program needs exactly one parameter.";
+      prerr_endline "Usage: ocaml md5sum.ml <FILE>";
+      prerr_endline "Print MD5 (128-bit) checksum of the file content modulo \\r.";
+      exit 1
diff --git a/toplevel/coqargs.ml b/toplevel/coqargs.ml
new file mode 100644
index 000000000..5b73471c5
--- /dev/null
+++ b/toplevel/coqargs.ml
@@ -0,0 +1,575 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2018     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+let warning s = Flags.(with_option warn Feedback.msg_warning (Pp.strbrk s))
+
+let fatal_error ?extra exn =
+  Topfmt.print_err_exn ?extra exn;
+  let exit_code = if CErrors.(is_anomaly exn || not (handled exn)) then 129 else 1 in
+  exit exit_code
+
+let error_missing_arg s =
+  prerr_endline ("Error: extra argument expected after option "^s);
+  prerr_endline "See -help for the syntax of supported options";
+  exit 1
+
+(******************************************************************************)
+(* Imperative effects! This must be fixed at some point.                      *)
+(******************************************************************************)
+let set_worker_id opt s =
+  assert (s <> "master");
+  Flags.async_proofs_worker_id := s
+
+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 }
+
+(******************************************************************************)
+
+type compilation_mode = BuildVo | BuildVio | Vio2Vo
+type color = [`ON | `AUTO | `OFF]
+
+type coq_cmdopts = {
+
+  load_init   : bool;
+  load_rcfile : bool;
+  rcfile      : string option;
+
+  ml_includes : string list;
+  vo_includes : (string * Names.DirPath.t * bool) list;
+  vo_requires : (string * string option * bool option) list;
+  (* None = No Import; Some false = Import; Some true = Export *)
+
+  (* XXX: Fusion? *)
+  batch_mode : bool;
+  compilation_mode : compilation_mode;
+
+  toplevel_name : Names.DirPath.t;
+  toploop : string option;
+
+  compile_list: (string * bool) list;  (* bool is verbosity  *)
+  compilation_output_name : string option;
+
+  load_vernacular_list : (string * bool) list;
+
+  vio_checking: bool;
+  vio_tasks   : (int list * string) list;
+  vio_files   : string list;
+  vio_files_j : int;
+
+  color : color;
+
+  impredicative_set : Declarations.set_predicativity;
+  stm_flags   : Stm.AsyncOpts.stm_opt;
+  debug       : bool;
+  time        : bool;
+
+  filter_opts : bool;
+
+  glob_opt    : bool;
+
+  memory_stat : bool;
+  print_tags  : bool;
+  print_where : bool;
+  print_config: bool;
+  output_context : bool;
+
+  inputstate  : string option;
+  outputstate : string option;
+
+}
+
+let init_args = {
+
+  load_init   = true;
+  load_rcfile = true;
+  rcfile      = None;
+
+  ml_includes = [];
+  vo_includes = [];
+  vo_requires = [];
+
+  batch_mode = false;
+  compilation_mode = BuildVo;
+
+  toplevel_name = Names.(DirPath.make [Id.of_string "Top"]);
+  toploop = None;
+
+  compile_list = [];
+  compilation_output_name = None;
+
+  load_vernacular_list = [];
+
+  vio_checking = false;
+  vio_tasks    = [];
+  vio_files    = [];
+  vio_files_j  = 0;
+
+  color = `AUTO;
+
+  impredicative_set = Declarations.PredicativeSet;
+  stm_flags    = Stm.AsyncOpts.default_opts;
+  debug        = false;
+  time         = false;
+
+  filter_opts  = false;
+
+  glob_opt     = false;
+
+  memory_stat  = false;
+  print_tags   = false;
+  print_where  = false;
+  print_config = false;
+  output_context = false;
+
+  inputstate  = None;
+  outputstate = None;
+}
+
+(******************************************************************************)
+(* Functional arguments                                                       *)
+(******************************************************************************)
+let add_ml_include opts s =
+  { opts with ml_includes = s :: opts.ml_includes }
+
+let add_vo_include opts d p implicit =
+  let p = Libnames.dirpath_of_string p in
+  { opts with vo_includes = (d, p, implicit) :: opts.vo_includes }
+
+let add_vo_require opts d p export =
+  { opts with vo_requires = (d, p, export) :: opts.vo_requires }
+
+let add_compat_require opts v =
+  match v with
+  | Flags.V8_5 -> add_vo_require opts "Coq.Compat.Coq85" None (Some false)
+  | Flags.V8_6 -> add_vo_require opts "Coq.Compat.Coq86" None (Some false)
+  | Flags.V8_7 -> add_vo_require opts "Coq.Compat.Coq87" None (Some false)
+  | Flags.VOld | Flags.Current -> opts
+
+let set_batch_mode opts =
+  Flags.quiet := true;
+  System.trust_file_cache := false;
+  { opts with batch_mode = true }
+
+let add_compile opts verbose s =
+  let opts = set_batch_mode opts in
+  if not opts.glob_opt then Dumpglob.dump_to_dotglob ();
+  (** make the file name explicit; needed not to break up Coq loadpath stuff. *)
+  let s =
+    let open Filename in
+    if is_implicit s
+    then concat current_dir_name s
+    else s
+  in
+  { opts with compile_list = (s,verbose) :: opts.compile_list }
+
+let add_load_vernacular opts verb s =
+  { opts with load_vernacular_list = (CUnix.make_suffix s ".v",verb) :: opts.load_vernacular_list }
+
+let add_vio_task opts f =
+  let opts = set_batch_mode opts in
+  { opts with vio_tasks = f :: opts.vio_tasks }
+
+let add_vio_file opts f =
+  let opts = set_batch_mode opts in
+  { opts with vio_files = f :: opts.vio_files }
+
+let set_vio_checking_j opts opt j =
+  try { opts with vio_files_j = int_of_string j }
+  with Failure _ ->
+    prerr_endline ("The first argument of " ^ opt ^ " must the number");
+    prerr_endline "of concurrent workers to be used (a positive integer).";
+    prerr_endline "Makefiles generated by coq_makefile should be called";
+    prerr_endline "setting the J variable like in 'make vio2vo J=3'";
+    exit 1
+
+(** Options for proof general *)
+let set_emacs opts =
+  if not (Option.is_empty opts.toploop) then
+    CErrors.user_err Pp.(str "Flag -emacs is incompatible with a custom toplevel loop");
+  Coqloop.print_emacs := true;
+  Printer.enable_goal_tags_printing := true;
+  { opts with color = `OFF }
+
+let set_color opts = function
+| "yes" | "on" -> { opts with color = `ON }
+| "no" | "off" -> { opts with color = `OFF }
+| "auto" -> { opts with color = `AUTO }
+| _ -> prerr_endline ("Error: on/off/auto expected after option color"); exit 1
+
+let warn_deprecated_inputstate =
+  CWarnings.create ~name:"deprecated-inputstate" ~category:"deprecated"
+         (fun () -> Pp.strbrk "The inputstate option is deprecated and discouraged.")
+
+let set_inputstate opts s =
+  warn_deprecated_inputstate ();
+  { opts with inputstate = Some s }
+
+let warn_deprecated_outputstate =
+  CWarnings.create ~name:"deprecated-outputstate" ~category:"deprecated"
+         (fun () ->
+          Pp.strbrk "The outputstate option is deprecated and discouraged.")
+
+let set_outputstate opts s =
+  warn_deprecated_outputstate ();
+  { opts with outputstate = Some s }
+
+let exitcode opts = if opts.filter_opts then 2 else 0
+
+(******************************************************************************)
+(* Parsing helpers                                                            *)
+(******************************************************************************)
+let get_task_list s = List.map int_of_string (Str.split (Str.regexp ",") s)
+
+let get_bool opt = function
+  | "yes" | "on" -> true
+  | "no" | "off" -> false
+  | _ -> prerr_endline ("Error: yes/no expected after option "^opt); exit 1
+
+let get_int opt n =
+  try int_of_string 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: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 (CString.split ',' s)
+
+let get_priority opt s =
+  try CoqworkmgrApi.priority_of_string s
+  with Invalid_argument _ ->
+    prerr_endline ("Error: low/high expected after "^opt); exit 1
+
+let get_async_proofs_mode opt = let open Stm.AsyncOpts in function
+  | "no" | "off" -> APoff
+  | "yes" | "on" -> APon
+  | "lazy" -> APonLazy
+  | _ -> prerr_endline ("Error: on/off/lazy expected after "^opt); exit 1
+
+let get_cache opt = function
+  | "force" -> Some Stm.AsyncOpts.Force
+  | _ -> prerr_endline ("Error: force expected after "^opt); exit 1
+
+let is_not_dash_option = function
+  | Some f when String.length f > 0 && f.[0] <> '-' -> true
+  | _ -> false
+
+let rec add_vio_args peek next oval =
+  if is_not_dash_option (peek ()) then
+    let oval = add_vio_file oval (next ()) in
+    add_vio_args peek next oval
+  else oval
+
+let get_native_name s =
+  (* We ignore even critical errors because this mode has to be super silent *)
+  try
+    String.concat "/" [Filename.dirname s;
+      Nativelib.output_dir; Library.native_name_from_filename s]
+  with _ -> ""
+
+(*s Parsing of the command line.
+    We no longer use [Arg.parse], in order to use share [Usage.print_usage]
+    between coqtop and coqc. *)
+
+let usage_no_coqlib = CWarnings.create ~name:"usage-no-coqlib" ~category:"filesystem"
+    (fun () -> Pp.str "cannot guess a path for Coq libraries; dynaminally loaded flags will not be mentioned")
+
+exception NoCoqLib
+
+let usage batch =
+  begin
+    try Envars.set_coqlib ~fail:(fun x -> raise NoCoqLib)
+    with NoCoqLib -> usage_no_coqlib ()
+  end;
+  let lp = Coqinit.toplevel_init_load_path () in
+  (* Necessary for finding the toplevels below *)
+  List.iter Mltop.add_coq_path lp;
+  if batch then Usage.print_usage_coqc ()
+  else begin
+    Mltop.load_ml_objects_raw_rex
+      (Str.regexp (if Mltop.is_native then "^.*top.cmxs$" else "^.*top.cma$"));
+    Usage.print_usage_coqtop ()
+  end
+
+(* Main parsing routine *)
+let parse_args arglist : coq_cmdopts * string list =
+  let args = ref arglist in
+  let extras = ref [] in
+  let rec parse oval = match !args with
+  | [] ->
+    (oval, List.rev !extras)
+  | opt :: rem ->
+    args := rem;
+    let next () = match !args with
+      | x::rem -> args := rem; x
+      | [] -> error_missing_arg opt
+    in
+    let peek_next () = match !args with
+      | x::_ -> Some x
+      | [] -> None
+    in
+    let noval = begin match opt with
+
+    (* Complex options with many args *)
+    |"-I"|"-include" ->
+      begin match rem with
+      | d :: rem ->
+        args := rem;
+        add_ml_include oval d
+      | [] -> error_missing_arg opt
+      end
+    |"-Q" ->
+      begin match rem with
+      | d :: p :: rem ->
+        args := rem;
+        add_vo_include oval d p false
+      | _ -> error_missing_arg opt
+      end
+    |"-R" ->
+      begin match rem with
+      | d :: p :: rem ->
+        args := rem;
+        add_vo_include oval d p true
+      | _ -> error_missing_arg opt
+      end
+
+    (* Options with two arg *)
+    |"-check-vio-tasks" ->
+      let tno = get_task_list (next ()) in
+      let tfile = next () in
+      add_vio_task oval (tno,tfile)
+
+    |"-schedule-vio-checking" ->
+      let oval = { oval with vio_checking = true } in
+      let oval = set_vio_checking_j oval opt (next ()) in
+      let oval = add_vio_file oval (next ()) in
+      add_vio_args peek_next next oval
+
+    |"-schedule-vio2vo" ->
+      let oval = set_vio_checking_j oval opt (next ()) in
+      let oval = add_vio_file oval (next ()) in
+      add_vio_args peek_next next oval
+
+    (* Options with one arg *)
+    |"-coqlib" ->
+      Flags.coqlib_spec := true;
+      Flags.coqlib := (next ());
+      oval
+
+    |"-async-proofs" ->
+      { oval with stm_flags = { oval.stm_flags with
+        Stm.AsyncOpts.async_proofs_mode = get_async_proofs_mode opt (next())
+      }}
+    |"-async-proofs-j" ->
+      { oval with stm_flags = { oval.stm_flags with
+        Stm.AsyncOpts.async_proofs_n_workers = (get_int opt (next ()))
+      }}
+    |"-async-proofs-cache" ->
+      { oval with stm_flags = { oval.stm_flags with
+        Stm.AsyncOpts.async_proofs_cache = get_cache opt (next ())
+      }}
+
+    |"-async-proofs-tac-j" ->
+      { oval with stm_flags = { oval.stm_flags with
+        Stm.AsyncOpts.async_proofs_n_tacworkers = (get_int opt (next ()))
+      }}
+
+    |"-async-proofs-worker-priority" ->
+      WorkerLoop.async_proofs_worker_priority := get_priority opt (next ());
+      oval
+
+    |"-async-proofs-private-flags" ->
+      { oval with stm_flags = { oval.stm_flags with
+        Stm.AsyncOpts.async_proofs_private_flags = Some (next ());
+      }}
+
+    |"-async-proofs-tactic-error-resilience" ->
+      { oval with stm_flags = { oval.stm_flags with
+        Stm.AsyncOpts.async_proofs_tac_error_resilience = get_error_resilience opt (next ())
+      }}
+
+    |"-async-proofs-command-error-resilience" ->
+      { oval with stm_flags = { oval.stm_flags with
+        Stm.AsyncOpts.async_proofs_cmd_error_resilience = get_bool opt (next ())
+      }}
+
+    |"-async-proofs-delegation-threshold" ->
+      { oval with stm_flags = { oval.stm_flags with
+        Stm.AsyncOpts.async_proofs_delegation_threshold = get_float opt (next ())
+      }}
+
+    |"-worker-id" -> set_worker_id opt (next ()); oval
+
+    |"-compat" ->
+      let v = G_vernac.parse_compat_version ~allow_old:false (next ()) in
+      Flags.compat_version := v;
+      add_compat_require oval v
+
+    |"-compile" ->
+      add_compile oval false (next ())
+
+    |"-compile-verbose" ->
+      add_compile oval true (next ())
+
+    |"-dump-glob" ->
+      Dumpglob.dump_into_file (next ());
+      { oval with glob_opt = true }
+
+    |"-feedback-glob" ->
+      Dumpglob.feedback_glob (); oval
+
+    |"-exclude-dir" ->
+      System.exclude_directory (next ()); oval
+
+    |"-init-file" ->
+      { oval with rcfile = Some (next ()); }
+
+    |"-inputstate"|"-is" ->
+      set_inputstate oval (next ())
+
+    |"-outputstate" ->
+      set_outputstate oval (next ())
+
+    |"-load-ml-object" ->
+      Mltop.dir_ml_load (next ()); oval
+
+    |"-load-ml-source" ->
+      Mltop.dir_ml_use (next ()); oval
+
+    |"-load-vernac-object" ->
+      add_vo_require oval (next ()) None None
+
+    |"-load-vernac-source"|"-l" ->
+      add_load_vernacular oval false (next ())
+
+    |"-load-vernac-source-verbose"|"-lv" ->
+      add_load_vernacular oval true (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 ());
+      oval
+
+    |"-require" -> add_vo_require oval (next ()) None (Some false)
+
+    |"-top" ->
+      let topname = Libnames.dirpath_of_string (next ()) in
+      if Names.DirPath.is_empty topname then
+        CErrors.user_err Pp.(str "Need a non empty toplevel module name");
+      { oval with toplevel_name = topname }
+
+    |"-main-channel" ->
+      Spawned.main_channel := get_host_port opt (next()); oval
+
+    |"-control-channel" ->
+      Spawned.control_channel := get_host_port opt (next()); oval
+
+    |"-vio2vo" ->
+      let oval = add_compile oval false (next ()) in
+      { oval with compilation_mode = Vio2Vo }
+
+    |"-toploop" ->
+      if !Coqloop.print_emacs then
+        CErrors.user_err Pp.(str "Flags -toploop and -emacs are incompatible");
+      { oval with toploop = Some (next ()) }
+
+    |"-w" | "-W" ->
+      let w = next () in
+      if w = "none" then
+        (CWarnings.set_flags w; oval)
+      else
+        let w = CWarnings.get_flags () ^ "," ^ w in
+        CWarnings.set_flags (CWarnings.normalize_flags_string w);
+        oval
+
+    |"-o" -> { oval with compilation_output_name = Some (next()) }
+
+    (* Options with zero arg *)
+    |"-async-queries-always-delegate"
+    |"-async-proofs-always-delegate"
+    |"-async-proofs-full" ->
+      { oval with stm_flags = { oval.stm_flags with
+        Stm.AsyncOpts.async_proofs_full = true;
+      }}
+    |"-async-proofs-never-reopen-branch" ->
+      { oval with stm_flags = { oval.stm_flags with
+        Stm.AsyncOpts.async_proofs_never_reopen_branch = true
+      }}
+    |"-batch" -> set_batch_mode oval
+    |"-test-mode" -> Flags.test_mode := true; oval
+    |"-beautify" -> Flags.beautify := true; oval
+    |"-boot" -> Flags.boot := true; { oval with load_rcfile = false; }
+    |"-bt" -> Backtrace.record_backtrace true; oval
+    |"-color" -> set_color oval (next ())
+    |"-config"|"--config" -> { oval with print_config = true }
+    |"-debug" -> Coqinit.set_debug (); oval
+    |"-stm-debug" -> Stm.stm_debug := true; oval
+    |"-emacs" -> set_emacs oval
+    |"-filteropts" -> { oval with filter_opts = true }
+    |"-ideslave" ->
+      if !Coqloop.print_emacs then
+        CErrors.user_err Pp.(str "Flags -ideslave and -emacs are incompatible");
+      Flags.ide_slave := true;
+      { oval with toploop = Some "coqidetop" }
+
+    |"-impredicative-set" ->
+      { oval with impredicative_set = Declarations.ImpredicativeSet }
+    |"-indices-matter" -> Indtypes.enforce_indices_matter (); oval
+    |"-m"|"--memory" -> { oval with memory_stat = true }
+    |"-noinit"|"-nois" -> { oval with load_init = false }
+    |"-no-glob"|"-noglob" -> Dumpglob.noglob (); { oval with glob_opt = true }
+    |"-native-compiler" ->
+      if not Coq_config.native_compiler then
+        warning "Native compilation was disabled at configure time."
+      else Flags.output_native_objects := true; oval
+    |"-output-context" -> { oval with output_context = true }
+    |"-profile-ltac" -> Flags.profile_ltac := true; oval
+    |"-q" -> { oval with load_rcfile = false; }
+    |"-quiet"|"-silent" ->
+      Flags.quiet := true;
+      Flags.make_warn false;
+      oval
+    |"-quick" -> { oval with compilation_mode = BuildVio }
+    |"-list-tags" -> { oval with print_tags = true }
+    |"-time" -> { oval with time = true }
+    |"-type-in-type" -> set_type_in_type (); oval
+    |"-unicode" -> add_vo_require oval "Utf8_core" None (Some false)
+    |"-where" -> { oval with print_where = true }
+    |"-h"|"-H"|"-?"|"-help"|"--help" -> usage oval.batch_mode; oval
+    |"-v"|"--version" -> Usage.version (exitcode oval)
+    |"-print-version"|"--print-version" ->
+      Usage.machine_readable_version (exitcode oval)
+
+    (* Unknown option *)
+    | s ->
+      extras := s :: !extras;
+      oval
+    end in
+    parse noval
+  in
+  try
+    parse init_args
+  with any -> fatal_error any
diff --git a/toplevel/coqargs.mli b/toplevel/coqargs.mli
new file mode 100644
index 000000000..8ee1a8f55
--- /dev/null
+++ b/toplevel/coqargs.mli
@@ -0,0 +1,63 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2018     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+type compilation_mode = BuildVo | BuildVio | Vio2Vo
+type color = [`ON | `AUTO | `OFF]
+
+type coq_cmdopts = {
+
+  load_init   : bool;
+  load_rcfile : bool;
+  rcfile      : string option;
+
+  ml_includes : string list;
+  vo_includes : (string * Names.DirPath.t * bool) list;
+  vo_requires : (string * string option * bool option) list;
+
+  (* Fuse these two? Currently, [batch_mode] is only used to
+     distinguish coqc / coqtop in help display. *)
+  batch_mode : bool;
+  compilation_mode : compilation_mode;
+
+  toplevel_name : Names.DirPath.t;
+  toploop : string option;
+
+  compile_list: (string * bool) list;  (* bool is verbosity  *)
+  compilation_output_name : string option;
+
+  load_vernacular_list : (string * bool) list;
+
+  vio_checking: bool;
+  vio_tasks   : (int list * string) list;
+  vio_files   : string list;
+  vio_files_j : int;
+
+  color : color;
+
+  impredicative_set : Declarations.set_predicativity;
+  stm_flags   : Stm.AsyncOpts.stm_opt;
+  debug       : bool;
+  time        : bool;
+
+  filter_opts : bool;
+
+  glob_opt    : bool;
+
+  memory_stat : bool;
+  print_tags  : bool;
+  print_where : bool;
+  print_config: bool;
+  output_context : bool;
+
+  inputstate  : string option;
+  outputstate : string option;
+
+}
+
+val parse_args : string list -> coq_cmdopts * string list
+val exitcode : coq_cmdopts -> int
diff --git a/toplevel/coqinit.ml b/toplevel/coqinit.ml
index 5ca886965..d8aaf3db8 100644
--- a/toplevel/coqinit.ml
+++ b/toplevel/coqinit.ml
@@ -20,21 +20,15 @@ let set_debug () =
   does not exist. *)
 
 let rcdefaultname = "coqrc"
-let rcfile = ref ""
-let rcfile_specified = ref false
-let set_rcfile s = rcfile := s; rcfile_specified := true
 
-let load_rc = ref true
-let no_load_rc () = load_rc := false
-
-let load_rcfile sid =
-  if !load_rc then
+let load_rcfile ~rcfile ~time ~state =
     try
-      if !rcfile_specified then
-        if CUnix.file_readable_p !rcfile then
-          Vernac.load_vernac false sid !rcfile
-        else raise (Sys_error ("Cannot read rcfile: "^ !rcfile))
-      else
+      match rcfile with
+      | Some rcfile ->
+        if CUnix.file_readable_p rcfile then
+          Vernac.load_vernac ~time ~verbosely:false ~interactive:false ~check:true ~state rcfile
+        else raise (Sys_error ("Cannot read rcfile: "^ rcfile))
+      | None ->
 	try
 	  let warn x = Feedback.msg_warning (str x) in
 	  let inferedrc = List.find CUnix.file_readable_p [
@@ -43,8 +37,8 @@ let load_rcfile sid =
 	    Envars.home ~warn / "."^rcdefaultname^"."^Coq_config.version;
 	    Envars.home ~warn / "."^rcdefaultname
 	  ] in
-          Vernac.load_vernac false sid inferedrc
-	with Not_found -> sid
+          Vernac.load_vernac ~time ~verbosely:false ~interactive:false ~check:true ~state inferedrc
+        with Not_found -> state
 	(*
 	Flags.if_verbose
 	  mSGNL (str ("No coqrc or coqrc."^Coq_config.version^
@@ -54,74 +48,79 @@ let load_rcfile sid =
       let reraise = CErrors.push reraise in
       let () = Feedback.msg_info (str"Load of rcfile failed.") in
       iraise reraise
-  else
-    (Flags.if_verbose Feedback.msg_info (str"Skipping rcfile loading.");
-     sid)
 
 (* Recursively puts dir in the LoadPath if -nois was not passed *)
-let add_stdlib_path ~unix_path ~coq_root ~with_ml =
-  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 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 []
-let push_include s alias implicit =
-  includes := (s, alias, implicit) :: !includes
-let ml_includes = ref []
-let push_ml_include s = ml_includes := s :: !ml_includes
-
-(* Initializes the LoadPath *)
-let init_load_path () =
+let build_stdlib_path ~load_init ~unix_path ~coq_path ~with_ml =
+  let open Mltop in
+  let add_ml = if with_ml then AddRecML else AddNoML in
+  { recursive = true;
+    path_spec = VoPath { unix_path; coq_path ; has_ml = add_ml; implicit = load_init }
+  }
+
+let build_userlib_path ~unix_path =
+  let open Mltop in
+  { recursive = true;
+    path_spec = VoPath {
+        unix_path;
+        coq_path = Libnames.default_root_prefix;
+        has_ml = Mltop.AddRecML;
+        implicit = false;
+      }
+  }
+
+let ml_path_if c p =
+  let open Mltop in
+  let f x = { recursive = false; path_spec = MlPath x } in
+  if c then List.map f p else []
+
+(* LoadPath for toploop toplevels *)
+let toplevel_init_load_path () =
+  let coqlib = Envars.coqlib () in
+  (* NOTE: These directories are searched from last to first *)
+  (* first, developer specific directory to open *)
+  ml_path_if Coq_config.local [coqlib/"dev"] @
+
+  (* main loops *)
+  ml_path_if (Coq_config.local || !Flags.boot) [coqlib/"stm"; coqlib/"ide"] @
+  ml_path_if (System.exists_dir (coqlib/"toploop")) [coqlib/"toploop"]
+
+(* LoadPath for Coq user libraries *)
+let libs_init_load_path ~load_init =
+
+  let open Mltop in
   let coqlib = Envars.coqlib () in
   let user_contrib = coqlib/"user-contrib" in
   let xdg_dirs = Envars.xdg_dirs ~warn:(fun x -> Feedback.msg_warning (str x)) in
   let coqpath = Envars.coqpath in
-  let coq_root = Names.DirPath.make [Nameops.coq_root] in
-    (* NOTE: These directories are searched from last to first *)
-    (* first, developer specific directory to open *)
-    if Coq_config.local then
-      Mltop.add_ml_dir (coqlib/"dev");
-    (* main loops *)
-    if Coq_config.local || !Flags.boot then begin
-      Mltop.add_ml_dir (coqlib/"stm");
-      Mltop.add_ml_dir (coqlib/"ide")
-    end;
-    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 *)
-    add_stdlib_path ~unix_path:(coqlib/"plugins") ~coq_root ~with_ml:true;
-    (* then user-contrib *)
-    if Sys.file_exists user_contrib then
-      add_userlib_path ~unix_path:user_contrib;
-    (* then directories in XDG_DATA_DIRS and XDG_DATA_HOME *)
-    List.iter (fun s -> add_userlib_path ~unix_path:s) xdg_dirs;
-    (* then directories in COQPATH *)
-    List.iter (fun s -> add_userlib_path ~unix_path:s) coqpath;
-    (* then current directory (not recursively!) *)
-    Mltop.add_ml_dir ".";
-    Loadpath.add_load_path "." Nameops.default_root_prefix ~implicit:false;
-    (* additional loadpath, given with options -Q and -R *)
-    List.iter
-      (fun (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)
-
-let init_library_roots () =
-  includes := []
+  let coq_path = Names.DirPath.make [Libnames.coq_root] in
+
+  (* then standard library and plugins *)
+  [build_stdlib_path ~load_init ~unix_path:(coqlib/"theories") ~coq_path ~with_ml:false;
+   build_stdlib_path ~load_init ~unix_path:(coqlib/"plugins")  ~coq_path ~with_ml:true ] @
+
+  (* then user-contrib *)
+  (if Sys.file_exists user_contrib then
+     [build_userlib_path ~unix_path:user_contrib] else []
+  ) @
+
+  (* then directories in XDG_DATA_DIRS and XDG_DATA_HOME and COQPATH *)
+  List.map (fun s -> build_userlib_path ~unix_path:s) (xdg_dirs @ coqpath) @
+
+  (* then current directory (not recursively!) *)
+  [ { recursive = false;
+      path_spec = VoPath { unix_path = ".";
+                           coq_path = Libnames.default_root_prefix;
+                           implicit = false;
+                           has_ml = AddTopML }
+    } ]
 
 (* Initialises the Ocaml toplevel before launching it, so that it can
    find the "include" file in the *source* directory *)
 let init_ocaml_path () =
+  let open Mltop in
+  let lp s = { recursive = false; path_spec = MlPath s } in
   let add_subdir dl =
-    Mltop.add_ml_dir (List.fold_left (/) Envars.coqroot [dl])
+    Mltop.add_coq_path (lp (List.fold_left (/) Envars.coqroot [dl]))
   in
-    Mltop.add_ml_dir (Envars.coqlib ());
+    Mltop.add_coq_path (lp (Envars.coqlib ()));
     List.iter add_subdir Coq_config.all_src_dirs
diff --git a/toplevel/coqinit.mli b/toplevel/coqinit.mli
index 3432e79cc..14f39170c 100644
--- a/toplevel/coqinit.mli
+++ b/toplevel/coqinit.mli
@@ -10,17 +10,12 @@
 
 val set_debug : unit -> unit
 
-val set_rcfile : string -> unit
+val load_rcfile : rcfile:(string option) -> time:bool -> state:Vernac.State.t -> Vernac.State.t
 
-val no_load_rc : unit -> unit
-val load_rcfile : Stateid.t -> Stateid.t
-
-val push_include : string -> Names.DirPath.t -> bool -> unit
-(** [push_include phys_path log_path implicit] *)
-
-val push_ml_include : string -> unit
+val init_ocaml_path : unit -> unit
 
-val init_load_path : unit -> unit
-val init_library_roots : unit -> unit
+(* LoadPath for toploop toplevels *)
+val toplevel_init_load_path : unit ->  Mltop.coq_path list
 
-val init_ocaml_path : unit -> unit
+(* LoadPath for Coq user libraries *)
+val libs_init_load_path : load_init:bool -> Mltop.coq_path list
diff --git a/toplevel/coqloop.ml b/toplevel/coqloop.ml
index d76703d98..ae0b94476 100644
--- a/toplevel/coqloop.ml
+++ b/toplevel/coqloop.ml
@@ -17,7 +17,7 @@ let top_stderr x =
  * entered to be able to report errors without pretty-printing. *)
 
 type input_buffer = {
-  mutable prompt : unit -> string;
+  mutable prompt : Stm.doc -> string;
   mutable str : Bytes.t; (* 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 *)
@@ -52,12 +52,12 @@ let emacs_prompt_endstring   () = if !print_emacs then "</prompt>" else ""
 
 (* Read a char in an input channel, displaying a prompt at every
    beginning of line. *)
-let prompt_char ic ibuf count =
+let prompt_char doc ic ibuf count =
   let bol = match ibuf.bols with
     | ll::_ -> Int.equal ibuf.len ll
     | [] -> Int.equal ibuf.len 0
   in
-  if bol && not !print_emacs then top_stderr (str (ibuf.prompt()));
+  if bol && not !print_emacs then top_stderr (str (ibuf.prompt doc));
   try
     let c = input_char ic in
     if c == '\n' then ibuf.bols <- (ibuf.len+1) :: ibuf.bols;
@@ -70,11 +70,11 @@ let prompt_char ic ibuf count =
 
 (* Reinitialize the char stream (after a Drop) *)
 
-let reset_input_buffer ic ibuf =
+let reset_input_buffer doc ic ibuf =
   ibuf.str <- Bytes.empty;
   ibuf.len <- 0;
   ibuf.bols <- [];
-  ibuf.tokens <- Pcoq.Gram.parsable (Stream.from (prompt_char ic ibuf));
+  ibuf.tokens <- Pcoq.Gram.parsable (Stream.from (prompt_char doc ic ibuf));
   ibuf.start <- 0
 
 (* Functions to print underlined locations from an input buffer. *)
@@ -155,14 +155,16 @@ let error_info_for_buffer ?loc buf =
       let fname = loc.Loc.fname in
       let hl, loc =
         (* We are in the toplevel *)
-        if CString.equal fname "" then
+        match fname with
+        | Loc.ToplevelInput ->
           let nloc = adjust_loc_buf buf loc in
           if valid_buffer_loc buf loc then
             (fnl () ++ print_highlight_location buf nloc, nloc)
             (* in the toplevel, but not a valid buffer *)
           else (mt (), nloc)
           (* we are in batch mode, don't adjust location *)
-        else (mt (), loc)
+        | Loc.InFile _ ->
+           (mt (), loc)
       in Topfmt.pr_loc loc ++ hl
     ) loc
 
@@ -199,10 +201,10 @@ let make_prompt () =
 
    "n |lem1|lem2|lem3| p < "
 *)
-let make_emacs_prompt() =
-  let statnum = Stateid.to_string (Stm.get_current_state ()) in
-  let dpth = Stm.current_proof_depth() in
-  let pending = Stm.get_all_proof_names() in
+let make_emacs_prompt doc =
+  let statnum = Stateid.to_string (Stm.get_current_state ~doc) in
+  let dpth = Stm.current_proof_depth ~doc in
+  let pending = Stm.get_all_proof_names ~doc in
   let pendingprompt =
     List.fold_left
       (fun acc x -> acc ^ (if CString.is_empty acc then "" else "|") ^ Names.Id.to_string x)
@@ -215,10 +217,10 @@ let make_emacs_prompt() =
  * initialized when a vernac command is immediately followed by "\n",
  * or after a Drop. *)
 let top_buffer =
-  let pr() =
+  let pr doc =
     emacs_prompt_startstring()
     ^ make_prompt()
-    ^ make_emacs_prompt()
+    ^ make_emacs_prompt doc
     ^ emacs_prompt_endstring()
   in
   { prompt = pr;
@@ -230,7 +232,7 @@ let top_buffer =
 
 let set_prompt prompt =
   top_buffer.prompt
-  <- (fun () ->
+  <- (fun doc ->
     emacs_prompt_startstring()
     ^ prompt ()
     ^ emacs_prompt_endstring())
@@ -256,8 +258,9 @@ let rec discard_to_dot () =
     | Stm.End_of_input -> raise Stm.End_of_input
     | e when CErrors.noncritical e -> ()
 
-let read_sentence sid input =
-  try Stm.parse_sentence sid input
+let read_sentence ~state input =
+  let open Vernac.State in
+  try Stm.parse_sentence ~doc:state.doc state.sid input
   with reraise ->
     let reraise = CErrors.push reraise in
     discard_to_dot ();
@@ -298,19 +301,20 @@ let coqloop_feed (fb : Feedback.feedback) = let open Feedback in
     is caught and handled (i.e. not re-raised).
 *)
 
-let do_vernac sid =
+let do_vernac ~time ~state =
+  let open Vernac.State in
   top_stderr (fnl());
-  if !print_emacs then top_stderr (str (top_buffer.prompt()));
+  if !print_emacs then top_stderr (str (top_buffer.prompt state.doc));
   resynch_buffer top_buffer;
   try
     let input = (top_buffer.tokens, None) in
-    Vernac.process_expr sid (read_sentence sid (fst input))
+    Vernac.process_expr ~time ~state (read_sentence ~state (fst input))
   with
     | Stm.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."); sid)
+        else (Feedback.msg_warning (str "There is no ML toplevel."); state)
     (* Exception printing should be done by the feedback listener,
        however this is not yet ready so we rely on the exception for
        now. *)
@@ -319,7 +323,7 @@ let do_vernac sid =
       let loc = Loc.get_loc info in
       let msg = CErrors.iprint (e, info) in
       TopErr.print_error_for_buffer ?loc Feedback.Error msg top_buffer;
-      sid
+      state
 
 (** Main coq loop : read vernacular expressions until Drop is entered.
     Ctrl-C is handled internally as Sys.Break instead of aborting Coq.
@@ -335,25 +339,26 @@ let loop_flush_all () =
   Format.pp_print_flush !Topfmt.std_ft ();
   Format.pp_print_flush !Topfmt.err_ft ()
 
-let rec loop () =
+let rec loop ~time ~state =
+  let open Vernac.State in
   Sys.catch_break true;
   try
-    reset_input_buffer stdin top_buffer;
+    reset_input_buffer state.doc stdin top_buffer;
     (* Be careful to keep this loop tail-recursive *)
-    let rec vernac_loop sid =
-      let nsid = do_vernac sid in
+    let rec vernac_loop ~state =
+      let nstate = do_vernac ~time ~state in
       loop_flush_all ();
-      vernac_loop nsid
+      vernac_loop ~state:nstate
     (* We recover the current stateid, threading from the caller is
        not possible due exceptions. *)
-    in vernac_loop (Stm.get_current_state ())
+    in vernac_loop ~state
   with
-    | CErrors.Drop -> ()
+    | CErrors.Drop -> state
     | CErrors.Quit -> exit 0
     | any ->
-      Feedback.msg_error (str "Anomaly: main loop exited with exception: " ++
+      top_stderr (str "Anomaly: main loop exited with exception: " ++
                   str (Printexc.to_string any) ++
                   fnl() ++
                   str"Please report" ++
                   strbrk" at " ++ str Coq_config.wwwbugtracker ++ str ".");
-      loop ()
+      loop ~time ~state
diff --git a/toplevel/coqloop.mli b/toplevel/coqloop.mli
index 8eaa68914..1c1309051 100644
--- a/toplevel/coqloop.mli
+++ b/toplevel/coqloop.mli
@@ -15,7 +15,7 @@ val print_emacs : bool ref
  * entered to be able to report errors without pretty-printing. *)
 
 type input_buffer = {
-  mutable prompt : unit -> string;
+  mutable prompt : Stm.doc -> string;
   mutable str : Bytes.t; (** 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 *)
@@ -31,9 +31,7 @@ val set_prompt : (unit -> string) -> unit
 val coqloop_feed : Feedback.feedback -> unit
 
 (** Parse and execute one vernac command. *)
-
-val do_vernac : Stateid.t -> Stateid.t
+val do_vernac : time:bool -> state:Vernac.State.t -> Vernac.State.t
 
 (** Main entry point of Coq: read and execute vernac commands. *)
-
-val loop : unit -> unit
+val loop : time:bool -> state:Vernac.State.t -> Vernac.State.t
diff --git a/toplevel/coqtop.ml b/toplevel/coqtop.ml
index 0f8524e92..26ede1834 100644
--- a/toplevel/coqtop.ml
+++ b/toplevel/coqtop.ml
@@ -7,10 +7,7 @@
 (************************************************************************)
 
 open Pp
-open CErrors
-open Flags
-open Libnames
-open Coqinit
+open Coqargs
 
 let () = at_exit flush_all
 
@@ -31,67 +28,25 @@ let print_header () =
   Feedback.msg_notice (str "Welcome to Coq " ++ str ver ++ str " (" ++ str rev ++ str ")");
   flush_all ()
 
-let warning s = with_option Flags.warn Feedback.msg_warning (strbrk s)
-
-let toploop = ref None
-
-let color : [`ON | `AUTO | `OFF] ref = ref `AUTO
-let set_color = function
-| "yes" | "on" -> color := `ON
-| "no" | "off" -> color := `OFF
-| "auto" -> color := `AUTO
-| _ -> prerr_endline ("Error: on/off/auto expected after option color"); exit 1
-
-let init_color () =
-  let has_color = match !color with
-  | `OFF -> false
-  | `ON -> true
-  | `AUTO ->
-    Terminal.has_style Unix.stdout &&
-    Terminal.has_style Unix.stderr &&
-    (* emacs compilation buffer does not support colors by default,
-       its TERM variable is set to "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 *)
-      Topfmt.init_terminal_output ~color:true
-    | Some "" ->
-      (** No color output *)
-      Topfmt.init_terminal_output ~color:false
-    | Some s ->
-      (** Overwrite all colors *)
-      Topfmt.clear_styles ();
-      Topfmt.parse_color_config s;
-      Topfmt.init_terminal_output ~color:true
-  end
-  else
-    Topfmt.init_terminal_output ~color:false
-
-let toploop_init = ref begin fun x ->
-  let () = init_color () in
-  let () = CoqworkmgrApi.(init !Flags.async_proofs_worker_priority) in
-  x
-  end
+let warning s = Flags.(with_option warn Feedback.msg_warning (strbrk s))
 
 (* Feedback received in the init stage, this is different as the STM
    will not be generally be initialized, thus stateid, etc... may be
    bogus. For now we just print to the console too *)
 let coqtop_init_feed = Coqloop.coqloop_feed
+let drop_last_doc = ref None
 
 (* Default toplevel loop *)
-let console_toploop_run () =
+let console_toploop_run opts ~state =
   (* We initialize the console only if we run the toploop_run *)
   let tl_feed = Feedback.add_feeder Coqloop.coqloop_feed in
   if Dumpglob.dump () then begin
-    if_verbose warning "Dumpglob cannot be used in interactive mode.";
+    Flags.if_verbose warning "Dumpglob cannot be used in interactive mode.";
     Dumpglob.noglob ()
   end;
-  Coqloop.loop();
+  let state = Coqloop.loop ~time:opts.time ~state in
   (* Initialise and launch the Ocaml toplevel *)
+  drop_last_doc := Some state;
   Coqinit.init_ocaml_path();
   Mltop.ocaml_toploop();
   (* We let the feeder in place for users of Drop *)
@@ -99,10 +54,7 @@ let console_toploop_run () =
 
 let toploop_run = ref console_toploop_run
 
-let output_context = ref false
-
 let memory_stat = ref false
-
 let print_memory_stat () =
   begin (* -m|--memory from the command-line *)
     if !memory_stat then
@@ -122,147 +74,310 @@ let print_memory_stat () =
 
 let _ = at_exit print_memory_stat
 
-let impredicative_set = ref Declarations.PredicativeSet
-let set_impredicative_set c = impredicative_set := Declarations.ImpredicativeSet
-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
-
-let set_batch_mode () = batch_mode := true
-
-let toplevel_default_name = Names.(DirPath.make [Id.of_string "Top"])
-let toplevel_name = ref toplevel_default_name
-let set_toplevel_name dir =
-  if Names.DirPath.is_empty dir then user_err Pp.(str "Need a non empty toplevel module name");
-  toplevel_name := dir
-
-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 =
-  warn_deprecated_inputstate ();
-  inputstate:=s
-let inputstate () =
-  if not (CString.is_empty !inputstate) then
-    let fname = Loadpath.locate_file (CUnix.make_suffix !inputstate ".coq") in
-    States.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 =
-  warn_deprecated_outputstate ();
-  outputstate:=s
-let outputstate () =
-  if not (CString.is_empty !outputstate) then
-    let fname = CUnix.make_suffix !outputstate ".coq" in
-    States.extern_state fname
-
-let set_include d p implicit =
-  let p = dirpath_of_string p in
-  push_include d p implicit
-
-let load_vernacular_list = ref ([] : (string * bool) list)
-let add_load_vernacular verb s =
-  load_vernacular_list := ((CUnix.make_suffix s ".v"),verb) :: !load_vernacular_list
-let load_vernacular sid =
+(******************************************************************************)
+(* Input/Output State                                                         *)
+(******************************************************************************)
+let inputstate opts =
+  Option.iter (fun istate_file ->
+    let fname = Loadpath.locate_file (CUnix.make_suffix istate_file ".coq") in
+    States.intern_state fname) opts.inputstate
+
+let outputstate opts =
+  Option.iter (fun ostate_file ->
+    let fname = CUnix.make_suffix ostate_file ".coq" in
+    States.extern_state fname) opts.outputstate
+
+(******************************************************************************)
+(* Interactive Load File Simulation                                           *)
+(******************************************************************************)
+let load_vernacular opts ~state =
   List.fold_left
-    (fun sid (s,v) ->
-      let s = Loadpath.locate_file s in
-      if !Flags.beautify then
-	with_option beautify_file (Vernac.load_vernac v sid) s
-      else
-	Vernac.load_vernac v sid s)
-    sid (List.rev !load_vernacular_list)
-
-let load_vernacular_obj = ref ([] : string list)
-let add_vernac_obj s = load_vernacular_obj := s :: !load_vernacular_obj
-let load_vernac_obj () =
-  let map dir = Qualid (Loc.tag @@ qualid_of_string dir) in
-  Vernacentries.vernac_require None None (List.rev_map map !load_vernacular_obj)
-
-let require_prelude () =
-  let vo = Envars.coqlib () / "theories/Init/Prelude.vo" in
-  let vio = Envars.coqlib () / "theories/Init/Prelude.vio" in
-  let m =
-    if Sys.file_exists vo then vo else
-    if Sys.file_exists vio then vio else vo in
-  Library.require_library_from_dirpath [Coqlib.prelude_module,m] (Some true)
-
-let require_list = ref ([] : string list)
-let add_require s = require_list := s :: !require_list
-let require () =
-  let () = if !load_init then silently require_prelude () in
-  let map dir = Qualid (Loc.tag @@ qualid_of_string dir) in
-  Vernacentries.vernac_require None (Some false) (List.rev_map map !require_list)
-
-let add_compat_require v =
-  match v with
-  | Flags.V8_5 -> add_require "Coq.Compat.Coq85"
-  | Flags.V8_6 -> add_require "Coq.Compat.Coq86"
-  | Flags.V8_7 -> add_require "Coq.Compat.Coq87"
-  | Flags.VOld | Flags.Current -> ()
-
-let compile_list = ref ([] : (bool * string) list)
-
-let glob_opt = ref false
-
-let add_compile verbose s =
-  set_batch_mode ();
-  Flags.quiet := true;
-  if not !glob_opt then Dumpglob.dump_to_dotglob ();
-  (** make the file name explicit; needed not to break up Coq loadpath stuff. *)
-  let s =
-    let open Filename in
-    if is_implicit s
-    then concat current_dir_name s
-    else s
+    (fun state (f_in, verbosely) ->
+      let s = Loadpath.locate_file f_in in
+      (* Should make the beautify logic clearer *)
+      let load_vernac f = Vernac.load_vernac ~time:opts.time ~verbosely ~interactive:false ~check:true ~state f in
+      if !Flags.beautify
+      then Flags.with_option Flags.beautify_file load_vernac f_in
+      else load_vernac s
+    ) state (List.rev opts.load_vernacular_list)
+
+let load_init_vernaculars opts ~state =
+  let state = if opts.load_rcfile then
+      Coqinit.load_rcfile ~rcfile:opts.rcfile ~time:opts.time ~state
+    else begin
+      Flags.if_verbose Feedback.msg_info (str"Skipping rcfile loading.");
+      state
+    end in
+
+  load_vernacular opts ~state
+
+(******************************************************************************)
+(* Startup LoadPath and Modules                                               *)
+(******************************************************************************)
+(* prelude_data == From Coq Require Export Prelude. *)
+let prelude_data = "Prelude", Some "Coq", Some true
+
+let require_libs opts =
+  if opts.load_init then prelude_data :: opts.vo_requires else opts.vo_requires
+
+let cmdline_load_path opts =
+  let open Mltop in
+  (* loadpaths given by options -Q and -R *)
+  List.map
+    (fun (unix_path, coq_path, implicit) ->
+       { recursive = true;
+         path_spec = VoPath { unix_path; coq_path; has_ml = Mltop.AddNoML; implicit } })
+      (List.rev opts.vo_includes) @
+
+  (* additional ml directories, given with option -I *)
+  List.map (fun s -> {recursive = false; path_spec = MlPath s}) (List.rev opts.ml_includes)
+
+let build_load_path opts =
+  Coqinit.libs_init_load_path ~load_init:opts.load_init @
+  cmdline_load_path opts
+
+(******************************************************************************)
+(* Fatal Errors                                                               *)
+(******************************************************************************)
+
+(** Prints info which is either an error or an anomaly and then exits
+    with the appropriate error code *)
+let fatal_error msg =
+  Topfmt.std_logger Feedback.Error msg;
+  flush_all ();
+  exit 1
+
+let fatal_error_exn ?extra exn =
+  Topfmt.print_err_exn ?extra exn;
+  flush_all ();
+  let exit_code =
+    if CErrors.(is_anomaly exn || not (handled exn)) then 129 else 1
   in
-  compile_list := (verbose,s) :: !compile_list
+  exit exit_code
 
-let compile_file (v,f) =
-  if !Flags.beautify then
-    with_option beautify_file (Vernac.compile v) f
-  else
-    Vernac.compile v f
+(******************************************************************************)
+(* File Compilation                                                           *)
+(******************************************************************************)
+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_ext ext f =
+  if Filename.check_suffix f ext then f
+  else begin
+    warn_file_no_extension (f,ext);
+    f ^ ext
+  end
 
-let compile_files () =
-  if !compile_list == [] then ()
+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
+    fatal_error (str "Source and target file names must coincide, directories can differ" ++ fnl () ++
+                   str "Source: " ++ str src                                                ++ fnl () ++
+                   str "Target: " ++ str tgt)
+
+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
+    fatal_error (hov 0 (str "Can't find file" ++ spc () ++ str f))
+
+(* Compile a vernac file *)
+let compile opts ~verbosely ~f_in ~f_out =
+  let open Vernac.State in
+  let check_pending_proofs () =
+    let pfs = Proof_global.get_all_proof_names () in
+    if not (CList.is_empty pfs) then
+      fatal_error (str "There are pending proofs: "
+                    ++ (pfs
+                        |> List.rev
+                        |> prlist_with_sep pr_comma Names.Id.print)
+                    ++ str ".")
+  in
+  let iload_path = build_load_path opts in
+  let require_libs = require_libs opts in
+  let stm_options = opts.stm_flags in
+  match opts.compilation_mode with
+  | BuildVo ->
+      Flags.record_aux_file := true;
+      let long_f_dot_v = ensure_v f_in in
+      ensure_exists long_f_dot_v;
+      let long_f_dot_vo =
+        match f_out with
+        | None -> long_f_dot_v ^ "o"
+        | Some f -> ensure_vo long_f_dot_v f in
+
+      let doc, sid = Stm.(new_doc
+          { doc_type = VoDoc long_f_dot_vo;
+            iload_path; require_libs; stm_options;
+          }) in
+
+      let state = { doc; sid; proof = None } in
+      let state = load_init_vernaculars opts ~state in
+      let ldir = Stm.get_ldir ~doc:state.doc in
+      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");
+      let wall_clock1 = Unix.gettimeofday () in
+      let state = Vernac.load_vernac ~time:opts.time ~verbosely ~check:true ~interactive:false ~state long_f_dot_v in
+      let _doc = Stm.join ~doc:state.doc in
+      let wall_clock2 = Unix.gettimeofday () in
+      check_pending_proofs ();
+      Library.save_library_to ldir long_f_dot_vo (Global.opaque_tables ());
+      Aux_file.record_in_aux_at "vo_compile_time"
+        (Printf.sprintf "%.3f" (wall_clock2 -. wall_clock1));
+      Aux_file.stop_aux_file ();
+      Dumpglob.end_dump_glob ()
+
+  | BuildVio ->
+      Flags.record_aux_file := false;
+      Dumpglob.noglob ();
+
+      let long_f_dot_v = ensure_v f_in in
+      ensure_exists long_f_dot_v;
+
+      let long_f_dot_vio =
+        match f_out with
+        | None -> long_f_dot_v ^ "io"
+        | Some f -> ensure_vio long_f_dot_v f in
+
+      (* We need to disable error resiliency, otherwise some errors
+         will be ignored in batch mode. c.f. #6707
+
+         This is not necessary in the vo case as it fully checks the
+         document anyways. *)
+      let stm_options = let open Stm.AsyncOpts in
+        { stm_options with
+          async_proofs_cmd_error_resilience = false;
+          async_proofs_tac_error_resilience = `None;
+        } in
+
+      let doc, sid = Stm.(new_doc
+          { doc_type = VioDoc long_f_dot_vio;
+            iload_path; require_libs; stm_options;
+          }) in
+
+      let state = { doc; sid; proof = None } in
+      let state = load_init_vernaculars opts ~state in
+      let ldir = Stm.get_ldir ~doc:state.doc in
+      let state = Vernac.load_vernac ~time:opts.time ~verbosely ~check:false ~interactive:false ~state long_f_dot_v in
+      let doc = Stm.finish ~doc:state.doc in
+      check_pending_proofs ();
+      let _doc = Stm.snapshot_vio ~doc ldir long_f_dot_vio in
+      Stm.reset_task_queue ()
+
+  | Vio2Vo ->
+      let open Filename in
+      Flags.record_aux_file := false;
+      Dumpglob.noglob ();
+      let f = if check_suffix f_in ".vio" then chop_extension f_in else f_in in
+      let lfdv, sum, lib, univs, disch, tasks, proofs = Library.load_library_todo f in
+      let univs, proofs = Stm.finish_tasks lfdv univs disch proofs tasks in
+      Library.save_library_raw lfdv sum lib univs proofs
+
+let compile opts ~verbosely ~f_in ~f_out =
+  ignore(CoqworkmgrApi.get 1);
+  compile opts ~verbosely ~f_in ~f_out;
+  CoqworkmgrApi.giveback 1
+
+let compile_file opts (f_in, verbosely) =
+  if !Flags.beautify then
+    Flags.with_option Flags.beautify_file
+      (fun f_in -> compile opts ~verbosely ~f_in ~f_out:None) f_in
   else
-    let init_state = States.freeze ~marshallable:`No in
-    List.iter (fun vf ->
-        States.unfreeze init_state;
-        compile_file vf)
-      (List.rev !compile_list)
-
-(** Options for proof general *)
+    compile opts ~verbosely ~f_in ~f_out:None
 
-let set_emacs () =
-  if not (Option.is_empty !toploop) then
-    user_err Pp.(str "Flag -emacs is incompatible with a custom toplevel loop");
-  Coqloop.print_emacs := true;
-  Printer.enable_goal_tags_printing := true;
-  color := `OFF
+let compile_files opts =
+  let compile_list = List.rev opts.compile_list in
+  List.iter (compile_file opts) compile_list
 
-(** Options for CoqIDE *)
+(******************************************************************************)
+(* VIO Dispatching                                                            *)
+(******************************************************************************)
+let check_vio_tasks opts =
+  let rc =
+    List.fold_left (fun acc t -> Vio_checking.check_vio t && acc)
+      true (List.rev opts.vio_tasks) in
+  if not rc then fatal_error Pp.(str "VIO Task Check failed")
+
+(* vio files *)
+let schedule_vio opts =
+  (* We must add update the loadpath here as the scheduling process
+     happens outside of the STM *)
+  let iload_path = build_load_path opts in
+  List.iter Mltop.add_coq_path iload_path;
+
+  if opts.vio_checking then
+    Vio_checking.schedule_vio_checking opts.vio_files_j opts.vio_files
+  else
+    Vio_checking.schedule_vio_compilation opts.vio_files_j opts.vio_files
 
-let set_ideslave () =
-  if !Coqloop.print_emacs then user_err Pp.(str "Flags -ideslave and -emacs are incompatible");
-  toploop := Some "coqidetop";
-  Flags.ide_slave := true
+(******************************************************************************)
+(* Color Options                                                              *)
+(******************************************************************************)
+let init_color color_mode =
+  let has_color = match color_mode with
+  | `OFF -> false
+  | `ON -> true
+  | `AUTO ->
+    Terminal.has_style Unix.stdout &&
+    Terminal.has_style Unix.stderr &&
+    (* emacs compilation buffer does not support colors by default,
+       its TERM variable is set to "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 *)
+      Topfmt.init_terminal_output ~color:true
+    | Some "" ->
+      (** No color output *)
+      Topfmt.init_terminal_output ~color:false
+    | Some s ->
+      (** Overwrite all colors *)
+      Topfmt.clear_styles ();
+      Topfmt.parse_color_config s;
+      Topfmt.init_terminal_output ~color:true
+  end
+  else
+    Topfmt.init_terminal_output ~color:false
 
-(** Options for slaves *)
+let toploop_init = ref begin fun opts x ->
+  let () = init_color opts.color in
+  let () = CoqworkmgrApi.init !WorkerLoop.async_proofs_worker_priority in
+  x
+  end
 
-let set_toploop name =
-  if !Coqloop.print_emacs then user_err Pp.(str "Flags -toploop and -emacs are incompatible");
-  toploop := Some name
+let print_style_tags opts =
+  let () = init_color opts.color in
+  let tags = Topfmt.dump_tags () in
+  let iter (t, st) =
+    let opt = Terminal.eval st ^ t ^ Terminal.reset ^ "\n" in
+    print_string opt
+  in
+  let make (t, st) =
+    let tags = List.map string_of_int (Terminal.repr st) in
+    (t ^ "=" ^ String.concat ";" tags)
+  in
+  let repr = List.map make tags in
+  let () = Printf.printf "COQ_COLORS=\"%s\"\n" (String.concat ":" repr) in
+  let () = List.iter iter tags in
+  flush_all ()
 
 (** GC tweaking *)
 
@@ -289,382 +404,113 @@ let init_gc () =
              Gc.minor_heap_size = 33554432; (** 4M *)
              Gc.space_overhead = 120}
 
-(*s Parsing of the command line.
-    We no longer use [Arg.parse], in order to use share [Usage.print_usage]
-    between coqtop and coqc. *)
-
-let usage_no_coqlib = CWarnings.create ~name:"usage-no-coqlib" ~category:"filesystem"
-    (fun () -> Pp.str "cannot guess a path for Coq libraries; dynaminally loaded flags will not be mentioned")
-
-exception NoCoqLib
-let usage () =
-  begin
-  try
-  Envars.set_coqlib ~fail:(fun x -> raise NoCoqLib);
-  init_load_path ();
-  with NoCoqLib -> usage_no_coqlib ()
-  end;
-  if !batch_mode then Usage.print_usage_coqc ()
-  else begin
-    Mltop.load_ml_objects_raw_rex
-      (Str.regexp (if Mltop.is_native then "^.*top.cmxs$" else "^.*top.cma$"));
-    Usage.print_usage_coqtop ()
-  end
-
-let print_style_tags () =
-  let () = init_color () in
-  let tags = Topfmt.dump_tags () in
-  let iter (t, st) =
-    let opt = Terminal.eval st ^ t ^ Terminal.reset ^ "\n" in
-    print_string opt
-  in
-  let make (t, st) =
-    let tags = List.map string_of_int (Terminal.repr st) in
-    (t ^ "=" ^ String.concat ";" tags)
-  in
-  let repr = List.map make tags in
-  let () = Printf.printf "COQ_COLORS=\"%s\"\n" (String.concat ":" repr) in
-  let () = List.iter iter tags in
-  flush_all ()
-
-let error_missing_arg s =
-  prerr_endline ("Error: extra argument expected after option "^s);
-  prerr_endline "See -help for the syntax of supported options";
-  exit 1
-
-let filter_opts = ref false
-let exitcode () = if !filter_opts then 2 else 0
-
-let print_where = ref false
-let print_config = ref false
-let print_tags = ref false
-
-let get_priority opt s =
-  try Flags.priority_of_string s
-  with Invalid_argument _ ->
-    prerr_endline ("Error: low/high expected after "^opt); exit 1
-
-let get_async_proofs_mode opt = function
-  | "no" | "off" -> Flags.APoff
-  | "yes" | "on" -> Flags.APon
-  | "lazy" -> Flags.APonLazy
-  | _ -> prerr_endline ("Error: on/off/lazy expected after "^opt); exit 1
-
-let get_cache opt = function
-  | "force" -> Some Flags.Force
-  | _ -> prerr_endline ("Error: force expected after "^opt); exit 1
-
-
-let set_worker_id opt s =
-  assert (s <> "master");
-  Flags.async_proofs_worker_id := s
-
-let get_bool opt = function
-  | "yes" | "on" -> true
-  | "no" | "off" -> false
-  | _ -> prerr_endline ("Error: yes/no expected after option "^opt); exit 1
-
-let get_int opt n =
-  try int_of_string 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: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 (CString.split ',' s)
-
-let get_task_list s = List.map int_of_string (Str.split (Str.regexp ",") s)
-
-let vio_tasks = ref []
-
-let add_vio_task f =
-  set_batch_mode ();
-  Flags.quiet := true;
-  vio_tasks := f :: !vio_tasks
-
-let check_vio_tasks () =
-  let rc =
-    List.fold_left (fun acc t -> Vio_checking.check_vio t && acc)
-      true (List.rev !vio_tasks) in
-  if not rc then exit 1
-
-let vio_files = ref []
-let vio_files_j = ref 0
-let vio_checking = ref false
-let add_vio_file f =
-  set_batch_mode ();
-  Flags.quiet := true;
-  vio_files := f :: !vio_files
-
-let set_vio_checking_j opt j =
-  try vio_files_j := int_of_string j
-  with Failure _ ->
-    prerr_endline ("The first argument of " ^ opt ^ " must the number");
-    prerr_endline "of concurrent workers to be used (a positive integer).";
-    prerr_endline "Makefiles generated by coq_makefile should be called";
-    prerr_endline "setting the J variable like in 'make vio2vo J=3'";
-    exit 1
-
-let is_not_dash_option = function
-  | Some f when String.length f > 0 && f.[0] <> '-' -> true
-  | _ -> false
-
-let schedule_vio_checking () =
-  if !vio_files <> [] && !vio_checking then
-    Vio_checking.schedule_vio_checking !vio_files_j !vio_files
-let schedule_vio_compilation () =
-  if !vio_files <> [] && not !vio_checking then
-    Vio_checking.schedule_vio_compilation !vio_files_j !vio_files
-
-let get_native_name s =
-  (* We ignore even critical errors because this mode has to be super silent *)
-  try
-    String.concat "/" [Filename.dirname s;
-      Nativelib.output_dir; Library.native_name_from_filename s]
-  with _ -> ""
-
-(** Prints info which is either an error or an anomaly and then exits
-    with the appropriate error code *)
-let fatal_error ?extra exn =
-  Topfmt.print_err_exn ?extra exn;
-  let exit_code = if CErrors.(is_anomaly exn || not (handled exn)) then 129 else 1 in
-  exit exit_code
-
-let parse_args arglist =
-  let args = ref arglist in
-  let extras = ref [] in
-  let rec parse () = match !args with
-  | [] -> List.rev !extras
-  | opt :: rem ->
-    args := rem;
-    let next () = match !args with
-      | x::rem -> args := rem; x
-      | [] -> error_missing_arg opt
-    in
-    let peek_next () = match !args with
-      | x::_ -> Some x
-      | [] -> None
-    in
-    begin match opt with
-
-    (* Complex options with many args *)
-    |"-I"|"-include" ->
-      begin match rem with
-      | d :: rem -> push_ml_include d; args := rem
-      | [] -> error_missing_arg opt
-      end
-    |"-Q" ->
-      begin match rem with
-      | d :: p :: rem -> set_include d p false; args := rem
-      | _ -> error_missing_arg opt
-      end
-    |"-R" ->
-      begin match rem with
-      | d :: p :: rem -> set_include d p true; args := rem
-      | _ -> error_missing_arg opt
-      end
-
-    (* Options with two arg *)
-    |"-check-vio-tasks" ->
-        let tno = get_task_list (next ()) in
-        let tfile = next () in
-        add_vio_task (tno,tfile)
-    |"-schedule-vio-checking" ->
-        vio_checking := true;
-        set_vio_checking_j opt (next ());
-        add_vio_file (next ());
-        while is_not_dash_option (peek_next ()) do add_vio_file (next ()); done
-    |"-schedule-vio2vo" ->
-        set_vio_checking_j opt (next ());
-        add_vio_file (next ());
-        while is_not_dash_option (peek_next ()) do add_vio_file (next ()); done
-
-    (* Options with one arg *)
-    |"-coqlib" -> Flags.coqlib_spec:=true; Flags.coqlib:=(next ())
-    |"-async-proofs" ->
-        Flags.async_proofs_mode := get_async_proofs_mode opt (next())
-    |"-async-proofs-j" ->
-        Flags.async_proofs_n_workers := (get_int opt (next ()))
-    |"-async-proofs-cache" ->
-        Flags.async_proofs_cache := get_cache opt (next ())
-    |"-async-proofs-tac-j" ->
-        Flags.async_proofs_n_tacworkers := (get_int opt (next ()))
-    |"-async-proofs-worker-priority" ->
-        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 = G_vernac.parse_compat_version ~allow_old:false (next ()) in
-        Flags.compat_version := v; add_compat_require v
-    |"-compile" -> add_compile false (next ())
-    |"-compile-verbose" -> add_compile true (next ())
-    |"-dump-glob" -> Dumpglob.dump_into_file (next ()); glob_opt := true
-    |"-feedback-glob" -> Dumpglob.feedback_glob ()
-    |"-exclude-dir" -> System.exclude_directory (next ())
-    |"-init-file" -> set_rcfile (next ())
-    |"-inputstate"|"-is" -> set_inputstate (next ())
-    |"-load-ml-object" -> Mltop.dir_ml_load (next ())
-    |"-load-ml-source" -> Mltop.dir_ml_use (next ())
-    |"-load-vernac-object" -> add_vernac_obj (next ())
-    |"-load-vernac-source"|"-l" -> add_load_vernacular false (next ())
-    |"-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 ())
-    |"-main-channel" -> Spawned.main_channel := get_host_port opt (next())
-    |"-control-channel" -> Spawned.control_channel := get_host_port opt (next())
-    |"-vio2vo" -> add_compile false (next ()); Flags.compilation_mode := Vio2Vo
-    |"-toploop" -> set_toploop (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"
-    |"-async-proofs-always-delegate"
-    |"-async-proofs-full" ->
-        Flags.async_proofs_full := true;
-    |"-async-proofs-never-reopen-branch" ->
-        Flags.async_proofs_never_reopen_branch := true;
-    |"-batch" -> set_batch_mode ()
-    |"-test-mode" -> test_mode := true
-    |"-beautify" -> beautify := true
-    |"-boot" -> boot := true; no_load_rc ()
-    |"-bt" -> Backtrace.record_backtrace true
-    |"-color" -> set_color (next ())
-    |"-config"|"--config" -> print_config := true
-    |"-debug" -> set_debug ()
-    |"-stm-debug" -> Flags.stm_debug := true
-    |"-emacs" -> set_emacs ()
-    |"-filteropts" -> filter_opts := true
-    |"-h"|"-H"|"-?"|"-help"|"--help" -> usage ()
-    |"-ideslave" -> set_ideslave ()
-    |"-impredicative-set" -> set_impredicative_set ()
-    |"-indices-matter" -> Indtypes.enforce_indices_matter ()
-    |"-just-parsing" -> warning "-just-parsing option has been removed in 8.6"
-    |"-m"|"--memory" -> memory_stat := true
-    |"-noinit"|"-nois" -> load_init := false
-    |"-no-glob"|"-noglob" -> Dumpglob.noglob (); glob_opt := true
-    |"-native-compiler" ->
-      if Coq_config.no_native_compiler then
-	warning "Native compilation was disabled at configure time."
-      else native_compiler := true
-    |"-output-context" -> output_context := true
-    |"-profile-ltac" -> Flags.profile_ltac := true
-    |"-q" -> no_load_rc ()
-    |"-quiet"|"-silent" -> Flags.quiet := true; Flags.make_warn false
-    |"-quick" -> Flags.compilation_mode := BuildVio
-    |"-list-tags" -> print_tags := true
-    |"-time" -> Flags.time := true
-    |"-type-in-type" -> set_type_in_type ()
-    |"-unicode" -> add_require "Utf8_core"
-    |"-v"|"--version" -> Usage.version (exitcode ())
-    |"-print-version"|"--print-version" -> Usage.machine_readable_version (exitcode ())
-    |"-where" -> print_where := true
-
-    (* Unknown option *)
-    | s -> extras := s :: !extras
-    end;
-    parse ()
-  in
-  try
-    parse ()
-  with any -> fatal_error any
-
+(** Main init routine *)
 let init_toplevel arglist =
-  Profile.init_profile ();
+  (* Coq's init process, phase 1:
+     OCaml parameters, basic structures, and IO
+   *)
+  CProfile.init_profile ();
   init_gc ();
   Sys.catch_break false; (* Ctrl-C is fatal during the initialisation *)
   let init_feeder = Feedback.add_feeder coqtop_init_feed in
   Lib.init();
-  begin
+
+  (* Coq's init process, phase 2:
+     Basic Coq environment, load-path, plugins.
+   *)
+  let res = begin
     try
-      let extras = parse_args arglist in
+      let opts,extras = parse_args arglist in
+      memory_stat := opts.memory_stat;
+
       (* 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 ~fail:(fun msg -> CErrors.user_err Pp.(str msg));
-      if !print_where then (print_endline(Envars.coqlib ()); exit(exitcode ()));
-      if !print_config then (Envars.print_config stdout Coq_config.all_src_dirs; exit (exitcode ()));
-      if !print_tags then (print_style_tags (); exit (exitcode ()));
-      if !filter_opts then (print_string (String.concat "\n" extras); exit 0);
-      init_load_path ();
-      Option.iter Mltop.load_ml_object_raw !toploop;
-      let extras = !toploop_init extras in
+      if opts.print_where then (print_endline(Envars.coqlib ()); exit(exitcode opts));
+      if opts.print_config then (Envars.print_config stdout Coq_config.all_src_dirs; exit (exitcode opts));
+      if opts.print_tags then (print_style_tags opts; exit (exitcode opts));
+      if opts.filter_opts then (print_string (String.concat "\n" extras); exit 0);
+      let top_lp = Coqinit.toplevel_init_load_path () in
+      List.iter Mltop.add_coq_path top_lp;
+      Option.iter Mltop.load_ml_object_raw opts.toploop;
+      let extras = !toploop_init opts extras in
       if not (CList.is_empty extras) then begin
         prerr_endline ("Don't know what to do with "^String.concat " " extras);
         prerr_endline "See -help for the list of supported options";
         exit 1
       end;
-      if_verbose print_header ();
-      inputstate ();
+      Flags.if_verbose print_header ();
       Mltop.init_known_plugins ();
-      engage ();
-      if (not !batch_mode || CList.is_empty !compile_list)
-         && Global.env_is_initial ()
-      then Declaremods.start_library !toplevel_name;
-      init_library_roots ();
-      load_vernac_obj ();
-      require ();
-      (* XXX: This is incorrect in batch mode, as we will initialize
-         the STM before having done Declaremods.start_library, thus
-         state 1 is invalid. This bug was present in 8.5/8.6. *)
-      Stm.init ();
-      let sid  = load_rcfile (Stm.get_current_state ()) in
-      (* XXX: We ignore this for now, but should be threaded to the toplevels *)
-      let _sid = load_vernacular sid in
-      compile_files ();
-      schedule_vio_checking ();
-      schedule_vio_compilation ();
-      check_vio_tasks ();
-      outputstate ()
+      Global.set_engagement opts.impredicative_set;
+
+      (* Allow the user to load an arbitrary state here *)
+      inputstate opts;
+
+      (* This state will be shared by all the documents *)
+      Stm.init_core ();
+
+      (* Coq init process, phase 3: Stm initialization, backtracking state.
+
+         It is essential that the module system is in a consistent
+         state before we take the first snapshot. This was not
+         guaranteed in the past, but now is thanks to the STM API.
+
+         We split the codepath here depending whether coqtop is called
+         in interactive mode or not.  *)
+
+      (* The condition for starting the interactive mode is a bit
+         convoluted, we should really refactor batch/compilation_mode
+         more. *)
+      if (not opts.batch_mode
+          || CList.(is_empty opts.compile_list && is_empty opts.vio_files && is_empty opts.vio_tasks))
+      (* Interactive *)
+      then begin
+        let iload_path = build_load_path opts in
+        let require_libs = require_libs opts in
+        let stm_options = opts.stm_flags in
+        try
+          let open Vernac.State in
+          let doc, sid =
+            Stm.(new_doc
+                   { doc_type = Interactive opts.toplevel_name;
+                     iload_path; require_libs; stm_options;
+                   }) in
+          let state = { doc; sid; proof = None } in
+          Some (load_init_vernaculars opts ~state), opts
+        with any -> flush_all(); fatal_error_exn any
+      (* Non interactive: we perform a sequence of compilation steps *)
+      end else begin
+        try
+          compile_files opts;
+          (* Vio compile pass *)
+          if opts.vio_files <> [] then schedule_vio opts;
+          (* Vio task pass *)
+          check_vio_tasks opts;
+          (* Allow the user to output an arbitrary state *)
+          outputstate opts;
+          None, opts
+        with any -> flush_all(); fatal_error_exn any
+      end;
     with any ->
       flush_all();
-      let extra =
-        if !batch_mode && not Stateid.(equal (Stm.get_current_state ()) dummy)
-        then None
-        else Some (str "Error during initialization: ")
-      in
-      fatal_error ?extra any
-  end;
-  if !batch_mode then begin
-    flush_all();
-    if !output_context then
-      Feedback.msg_notice (with_option raw_print Prettyp.print_full_pure_context () ++ fnl ());
-    Profile.print_profile ();
-    exit 0
-  end;
-  Feedback.del_feeder init_feeder
+      let extra = Some (str "Error during initialization: ") in
+      fatal_error_exn ?extra any
+  end in
+  Feedback.del_feeder init_feeder;
+  res
 
 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 ...  *)
-  !toploop_run ();
-  exit 1
-
-(* [Coqtop.start] will be called by the code produced by coqmktop *)
+  match init_toplevel (List.tl (Array.to_list Sys.argv)) with
+  (* Batch mode *)
+  | Some state, opts when not opts.batch_mode ->
+    !toploop_run opts ~state;
+    exit 1
+  | _ , opts ->
+    flush_all();
+    if opts.output_context then begin
+      let sigma, env = Pfedit.get_current_context () in
+      Feedback.msg_notice (Flags.(with_option raw_print (Prettyp.print_full_pure_context env) sigma) ++ fnl ())
+    end;
+    CProfile.print_profile ();
+    exit 0
diff --git a/toplevel/coqtop.mli b/toplevel/coqtop.mli
index 892d64d91..dedb298e2 100644
--- a/toplevel/coqtop.mli
+++ b/toplevel/coqtop.mli
@@ -11,12 +11,13 @@
    state, load the files given on the command line, load the resource file,
    produce the output state if any, and finally will launch [Coqloop.loop]. *)
 
-val init_toplevel : string list -> unit
+val init_toplevel : string list -> Vernac.State.t option * Coqargs.coq_cmdopts
 
 val start : unit -> unit
 
+(* Last document seen after `Drop` *)
+val drop_last_doc : Vernac.State.t option ref
 
 (* For other toploops *)
-val toploop_init : (string list -> string list) ref
-val toploop_run : (unit -> unit) ref
-
+val toploop_init : (Coqargs.coq_cmdopts -> string list -> string list) ref
+val toploop_run : (Coqargs.coq_cmdopts -> state:Vernac.State.t -> unit) ref
diff --git a/toplevel/coqtop_bin.ml b/toplevel/coqtop_bin.ml
new file mode 100644
index 000000000..56aced92a
--- /dev/null
+++ b/toplevel/coqtop_bin.ml
@@ -0,0 +1,2 @@
+(* Main coqtop initialization *)
+let () = Coqtop.start()
diff --git a/toplevel/coqtop_byte_bin.ml b/toplevel/coqtop_byte_bin.ml
new file mode 100644
index 000000000..7d8354ec3
--- /dev/null
+++ b/toplevel/coqtop_byte_bin.ml
@@ -0,0 +1,21 @@
+let drop_setup () =
+  begin try
+    (* Enable rectypes in the toplevel if it has the directive #rectypes *)
+    begin match Hashtbl.find Toploop.directive_table "rectypes" with
+      | Toploop.Directive_none f -> f ()
+      | _ -> ()
+    end
+    with
+    | Not_found -> ()
+  end;
+  let ppf = Format.std_formatter in
+  Mltop.(set_top
+           { load_obj = (fun f -> if not (Topdirs.load_file ppf f)
+                          then CErrors.user_err Pp.(str ("Could not load plugin "^f))
+                        );
+             use_file = Topdirs.dir_use ppf;
+             add_dir  = Topdirs.dir_directory;
+             ml_loop  = (fun () -> Toploop.loop ppf);
+           })
+
+let _ = drop_setup ()
diff --git a/toplevel/coqtop_opt_bin.ml b/toplevel/coqtop_opt_bin.ml
new file mode 100644
index 000000000..410b4679a
--- /dev/null
+++ b/toplevel/coqtop_opt_bin.ml
@@ -0,0 +1,3 @@
+let drop_setup () = Mltop.remove ()
+
+let _ = drop_setup ()
diff --git a/toplevel/toplevel.mllib b/toplevel/toplevel.mllib
index 10bf48647..9fb2e33d7 100644
--- a/toplevel/toplevel.mllib
+++ b/toplevel/toplevel.mllib
@@ -2,4 +2,5 @@ Vernac
 Usage
 Coqloop
 Coqinit
+Coqargs
 Coqtop
diff --git a/toplevel/usage.ml b/toplevel/usage.ml
index d596e36f3..f0215b678 100644
--- a/toplevel/usage.ml
+++ b/toplevel/usage.ml
@@ -74,7 +74,6 @@ let print_usage_channel co command =
 \n  -emacs                 tells Coq it is executed under Emacs\
 \n  -noglob                do not dump globalizations\
 \n  -dump-glob f           dump globalizations in file f (to be used by coqdoc)\
-\n  -with-geoproof (yes|no) to (de)activate special functions for Geoproof within Coqide (default is yes)\
 \n  -impredicative-set     set sort Set impredicative\
 \n  -indices-matter        levels of indices (and nonuniform parameters) contribute to the level of inductives\
 \n  -type-in-type          disable universe consistency checking\
diff --git a/toplevel/vernac.ml b/toplevel/vernac.ml
index bfab44770..92dee84f3 100644
--- a/toplevel/vernac.ml
+++ b/toplevel/vernac.ml
@@ -11,7 +11,6 @@
 open Pp
 open CErrors
 open Util
-open Flags
 open Vernacexpr
 open Vernacprop
 
@@ -48,35 +47,29 @@ let beautify_suffix = ".beautified"
 
 let set_formatter_translator ch =
   let out s b e = output_substring ch s b e in
-  Format.set_formatter_output_functions out (fun () -> flush ch);
-  Format.set_max_boxes max_int
+  let ft = Format.make_formatter out (fun () -> flush ch) in
+  Format.pp_set_max_boxes ft max_int;
+  ft
 
-let pr_new_syntax_in_context ?loc chan_beautify ocom =
+let pr_new_syntax_in_context ?loc ft_beautify ocom =
   let loc = Option.cata Loc.unloc (0,0) loc in
-  if !beautify_file then set_formatter_translator chan_beautify;
   let fs = States.freeze ~marshallable:`No in
-  (* 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.pp_with !Topfmt.std_ft (hov 0 (before ++ com ++ after));
-       Format.pp_print_flush !Topfmt.std_ft ())
-    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 ?loc po chan_beautify ocom =
+  (* 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 !Flags.beautify_file then
+    (Pp.pp_with ft_beautify (hov 0 (before ++ com ++ after));
+     Format.pp_print_flush ft_beautify ())
+  else
+    Feedback.msg_info (hov 4 (str"New Syntax:" ++ fnl() ++ (hov 0 com)));
+  States.unfreeze fs
+
+let pr_new_syntax ?loc po ft_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 ?loc chan_beautify) ocom
+  Pcoq.Gram.with_parsable po (pr_new_syntax_in_context ?loc ft_beautify) ocom
 
 (* For coqtop -time, we display the position in the file,
    and a glimpse of the executed command *)
@@ -107,68 +100,82 @@ let print_cmd_header ?loc com =
   Format.pp_print_flush !Topfmt.std_ft ()
 
 let pr_open_cur_subgoals () =
-  try Printer.pr_open_subgoals ()
+  try
+    let proof = Proof_global.give_me_the_proof () in
+    Printer.pr_open_subgoals ~proof
   with Proof_global.NoCurrentProof -> Pp.str ""
 
-let vernac_error msg =
-  Topfmt.std_logger Feedback.Error msg;
-  flush_all ();
-  exit 1
-
 (* Reenable when we get back to feedback printing *)
 (* let is_end_of_input any = match any with *)
 (*     Stm.End_of_input -> true *)
 (*   | _ -> false *)
 
-let rec interp_vernac sid (loc,com) =
-  let interp = function
+module State = struct
+
+  type t = {
+    doc : Stm.doc;
+    sid : Stateid.t;
+    proof : Proof.t option;
+  }
+
+end
+
+let rec interp_vernac ~time ~check ~interactive ~state (loc,com) =
+  let open State in
+  let interp v =
+    match under_control v with
     | VernacLoad (verbosely, fname) ->
-	let fname = Envars.expand_path_macros ~warn:(fun x -> Feedback.msg_warning (str x)) fname in
+        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
-        load_vernac verbosely sid f
-    | v ->
-
+        load_vernac ~time ~verbosely ~check ~interactive ~state f
+    | _ ->
       (* XXX: We need to run this before add as the classification is
          highly dynamic and depends on the structure of the
-         document. Hopefully this is fixed when VtBack can be removed
+         document. Hopefully this is fixed when VtMeta can be removed
          and Undo etc... are just interpreted regularly. *)
+
+      (* XXX: The classifier can emit warnings so we need to guard
+         against that... *)
+      let wflags = CWarnings.get_flags () in
+      CWarnings.set_flags "none";
       let is_proof_step = match fst (Vernac_classifier.classify_vernac v) with
-        | VtProofStep _ | VtStm (VtBack _, _) | VtStartProof _ -> true
+        | VtProofStep _ | VtMeta | VtStartProof _ -> true
         | _ -> false
       in
+      CWarnings.set_flags wflags;
 
-      let nsid, ntip = Stm.add ~ontop:sid (not !Flags.quiet) (loc,v) in
+      let doc, nsid, ntip = Stm.add ~doc:state.doc ~ontop:state.sid (not !Flags.quiet) (loc,v) in
 
       (* Main STM interaction *)
       if ntip <> `NewTip then
         anomaly (str "vernac.ml: We got an unfocus operation on the toplevel!");
+
       (* Due to bug #5363 we cannot use observe here as we should,
          it otherwise reveals bugs *)
       (* Stm.observe nsid; *)
-
-      let check_proof = Flags.(!compilation_mode = BuildVo || not !batch_mode) in
-      if check_proof then Stm.finish ();
+      let ndoc = if check then Stm.finish ~doc else doc in
 
       (* We could use a more refined criteria that depends on the
          vernac. For now we imitate the old approach and rely on the
          classification. *)
-      let print_goals = not !Flags.batch_mode && not !Flags.quiet &&
+      let print_goals = interactive && not !Flags.quiet &&
                         is_proof_step && Proof_global.there_are_pending_proofs () in
 
       if print_goals then Feedback.msg_notice (pr_open_cur_subgoals ());
-      nsid
+      let new_proof = Proof_global.give_me_the_proof_opt () in
+      { doc = ndoc; sid = nsid; proof = new_proof }
   in
     try
       (* The -time option is only supported from console-based
          clients due to the way it prints. *)
-      if !Flags.time then print_cmd_header ?loc com;
-      let com = if !Flags.time then VernacTime (loc,com) else com in
+      if time then print_cmd_header ?loc com;
+      let com = if time then VernacTime(time, CAst.make ?loc com) else com in
       interp com
     with reraise ->
       (* XXX: In non-interactive mode edit_at seems to do very weird
          things, so we better avoid it while we investigate *)
-      if not !Flags.batch_mode then ignore(Stm.edit_at sid);
+      if interactive then ignore(Stm.edit_at ~doc:state.doc state.sid);
       let (reraise, info) = CErrors.push reraise in
       let info = begin
         match Loc.get_loc info with
@@ -177,19 +184,25 @@ let rec interp_vernac sid (loc,com) =
       end in iraise (reraise, info)
 
 (* Load a vernac file. CErrors are annotated with file and location *)
-and load_vernac verbosely sid file =
-  let chan_beautify =
-    if !Flags.beautify_file then open_out (file^beautify_suffix) else stdout in
+and load_vernac ~time ~verbosely ~check ~interactive ~state file =
+  let ft_beautify, close_beautify =
+    if !Flags.beautify_file then
+      let chan_beautify = open_out (file^beautify_suffix) in
+      set_formatter_translator chan_beautify, fun () -> close_out chan_beautify;
+    else
+      !Topfmt.std_ft, fun () -> ()
+  in
   let in_chan = open_utf8_file_in file in
   let in_echo = if verbosely then Some (open_utf8_file_in file) else None in
-  let in_pa   = Pcoq.Gram.parsable ~file (Stream.of_channel in_chan) in
-  let rsid = ref sid in
+  let in_pa   = Pcoq.Gram.parsable ~file:(Loc.InFile file) (Stream.of_channel in_chan) in
+  let rstate  = ref state in
+  let open State 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 =
-          Stm.parse_sentence !rsid in_pa
+          Stm.parse_sentence ~doc:!rstate.doc !rstate.sid in_pa
         (* If an error in parsing occurs, we propagate the exception
            so the caller of load_vernac will take care of it. However,
            in the future it could be possible that we want to handle
@@ -209,14 +222,14 @@ and load_vernac verbosely sid file =
        *)
       in
       (* Printing of vernacs *)
-      if !beautify then pr_new_syntax ?loc in_pa chan_beautify (Some ast);
+      if !Flags.beautify then pr_new_syntax ?loc in_pa ft_beautify (Some ast);
       Option.iter (vernac_echo ?loc) in_echo;
 
       checknav_simple (loc, ast);
-      let nsid = Flags.silently (interp_vernac !rsid) (loc, ast) in
-      rsid := nsid
+      let state = Flags.silently (interp_vernac ~time ~check ~interactive ~state:!rstate) (loc, ast) in
+      rstate := state;
     done;
-    !rsid
+    !rstate
   with any ->   (* whatever the exception *)
     let (e, info) = CErrors.push any in
     close_in in_chan;
@@ -224,12 +237,12 @@ and load_vernac verbosely sid file =
     match e with
       | Stm.End_of_input ->
           (* Is this called so comments at EOF are printed? *)
-          if !beautify then
-            pr_new_syntax ~loc:(Loc.make_loc (max_int,max_int)) in_pa chan_beautify None;
-          if !Flags.beautify_file then close_out chan_beautify;
-          !rsid
+          if !Flags.beautify then
+            pr_new_syntax ~loc:(Loc.make_loc (max_int,max_int)) in_pa ft_beautify None;
+          if !Flags.beautify_file then close_beautify ();
+          !rstate
       | reraise ->
-         if !Flags.beautify_file then close_out chan_beautify;
+         if !Flags.beautify_file then close_beautify ();
 	 iraise (disable_drop e, info)
 
 (** [eval_expr : ?preserving:bool -> Loc.t * Vernacexpr.vernac_expr -> unit]
@@ -239,107 +252,6 @@ and load_vernac verbosely sid file =
    of a new state label). An example of state-preserving command is one coming
    from the query panel of Coqide. *)
 
-let process_expr sid loc_ast =
+let process_expr ~time ~state loc_ast =
   checknav_deep loc_ast;
-  interp_vernac sid loc_ast
-
-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_ext ext f =
-  if Filename.check_suffix f ext then f
-  else begin
-    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
-    vernac_error (str "Source and target file names must coincide, directories can differ" ++ fnl () ++
-                  str "Source: " ++ str src                                                ++ fnl () ++
-                  str "Target: " ++ str tgt)
-
-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
-    vernac_error (hov 0 (str "Can't find file" ++ spc () ++ str f))
-
-(* Compile a vernac file *)
-let compile verbosely f =
-  let check_pending_proofs () =
-    let pfs = Proof_global.get_all_proof_names () in
-    if not (List.is_empty pfs) then
-      vernac_error (str "There are pending proofs: "
-                    ++ (pfs
-                        |> List.rev
-                        |> prlist_with_sep pr_comma Names.Id.print)
-                    ++ str ".")
-  in
-  match !Flags.compilation_mode with
-  | BuildVo ->
-      let long_f_dot_v = ensure_v f in
-      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");
-      let wall_clock1 = Unix.gettimeofday () in
-      let _ = load_vernac verbosely (Stm.get_current_state ()) long_f_dot_v in
-      Stm.join ();
-      let wall_clock2 = Unix.gettimeofday () in
-      check_pending_proofs ();
-      Library.save_library_to ldir long_f_dot_vo (Global.opaque_tables ());
-      Aux_file.record_in_aux_at "vo_compile_time"
-        (Printf.sprintf "%.3f" (wall_clock2 -. wall_clock1));
-      Aux_file.stop_aux_file ();
-      Dumpglob.end_dump_glob ()
-  | BuildVio ->
-      let long_f_dot_v = ensure_v f 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_vio;
-      let _ = load_vernac verbosely (Stm.get_current_state ()) long_f_dot_v in
-      Stm.finish ();
-      check_pending_proofs ();
-      Stm.snapshot_vio ldir long_f_dot_vio;
-      Stm.reset_task_queue ()
-  | Vio2Vo ->
-      let open Filename in
-      let open Library in
-      Dumpglob.noglob ();
-      let f = if check_suffix f ".vio" then chop_extension f else f in
-      let lfdv, sum, lib, univs, disch, tasks, proofs = load_library_todo f in
-      Stm.set_compilation_hints lfdv;
-      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 =
-  ignore(CoqworkmgrApi.get 1);
-  compile v f;
-  CoqworkmgrApi.giveback 1
+  interp_vernac ~time ~interactive:true ~check:true ~state loc_ast
diff --git a/toplevel/vernac.mli b/toplevel/vernac.mli
index bccf560e1..e909ada1e 100644
--- a/toplevel/vernac.mli
+++ b/toplevel/vernac.mli
@@ -7,17 +7,24 @@
 (************************************************************************)
 
 (** Parsing of vernacular. *)
+module State : sig
+
+  type t = {
+    doc : Stm.doc;
+    sid : Stateid.t;
+    proof : Proof.t option;
+  }
+
+end
 
 (** [process_expr sid cmd] Executes vernac command [cmd]. Callers are
     expected to handle and print errors in form of exceptions, however
     care is taken so the state machine is left in a consistent
     state. *)
-val process_expr : Stateid.t -> Vernacexpr.vernac_expr Loc.located -> Stateid.t
+val process_expr : time:bool -> state:State.t -> Vernacexpr.vernac_control Loc.located -> State.t
 
 (** [load_vernac echo sid file] Loads [file] on top of [sid], will
     echo the commands if [echo] is set. Callers are expected to handle
     and print errors in form of exceptions. *)
-val load_vernac : bool -> Stateid.t -> string -> Stateid.t
-
-(** Compile a vernac file, (f is assumed without .v suffix) *)
-val compile : bool -> string -> unit
+val load_vernac : time:bool -> verbosely:bool -> check:bool -> interactive:bool ->
+  state:State.t -> string -> State.t
diff --git a/vernac/assumptions.ml b/vernac/assumptions.ml
index 6711b14da..d22024568 100644
--- a/vernac/assumptions.ml
+++ b/vernac/assumptions.ml
@@ -18,7 +18,7 @@ open Pp
 open CErrors
 open Util
 open Names
-open Term
+open Constr
 open Declarations
 open Mod_subst
 open Globnames
@@ -89,7 +89,7 @@ and fields_of_mp mp =
   let mb = lookup_module_in_impl mp in
   let fields,inner_mp,subs = fields_of_mb empty_subst mb [] in
   let subs =
-    if mp_eq inner_mp mp then subs
+    if ModPath.equal inner_mp mp then subs
     else add_mp inner_mp mp mb.mod_delta subs
   in
   Modops.subst_structure subs fields
@@ -118,7 +118,7 @@ and fields_of_expression x = fields_of_functor fields_of_expr x
 
 let lookup_constant_in_impl cst fallback =
   try
-    let mp,dp,lab = repr_kn (canonical_con cst) in
+    let mp,dp,lab = KerName.repr (Constant.canonical cst) in
     let fields = memoize_fields_of_mp mp in
     (* A module found this way is necessarily closed, in particular
        our constant cannot be in an opened section : *)
@@ -131,7 +131,7 @@ let lookup_constant_in_impl cst fallback =
        - The label has not been found in the structure. This is an error *)
     match fallback with
       | Some cb -> cb
-      | None -> anomaly (str "Print Assumption: unknown constant " ++ pr_con cst ++ str ".")
+      | None -> anomaly (str "Print Assumption: unknown constant " ++ Constant.print cst ++ str ".")
 
 let lookup_constant cst =
   try
@@ -142,7 +142,7 @@ let lookup_constant cst =
 
 let lookup_mind_in_impl mind =
   try
-    let mp,dp,lab = repr_kn (canonical_mind mind) in
+    let mp,dp,lab = KerName.repr (MutInd.canonical mind) in
     let fields = memoize_fields_of_mp mp in
       search_mind_label lab fields
   with Not_found ->
@@ -156,14 +156,14 @@ let lookup_mind mind =
     traversed objects *)
 
 let label_of = function
-  | ConstRef kn -> pi3 (repr_con kn)
+  | ConstRef kn -> pi3 (Constant.repr3 kn)
   | IndRef (kn,_)
-  | ConstructRef ((kn,_),_) -> pi3 (repr_mind kn)
+  | ConstructRef ((kn,_),_) -> pi3 (MutInd.repr3 kn)
   | VarRef id -> Label.of_id id
 
 let fold_constr_with_full_binders g f n acc c =
   let open Context.Rel.Declaration in
-  match kind_of_term c with
+  match Constr.kind c with
   | Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _ | Construct _ -> acc
   | Cast (c,_, t) -> f n (f n acc c) t
   | Prod (na,t,c) -> f (g (LocalAssum (na,t)) n) (f n acc t) c
@@ -182,7 +182,7 @@ let fold_constr_with_full_binders g f n acc c =
       let fd = Array.map2 (fun t b -> (t,b)) tl bl in
       Array.fold_left (fun acc (t,b) -> f n' (f n acc t) b) acc fd
 
-let rec traverse current ctx accu t = match kind_of_term t with
+let rec traverse current ctx accu t = match Constr.kind t with
 | Var id ->
   let body () = id |> Global.lookup_named |> NamedDecl.get_value in
   traverse_object accu body (VarRef id)
diff --git a/vernac/assumptions.mli b/vernac/assumptions.mli
index 46730f824..afe932ead 100644
--- a/vernac/assumptions.mli
+++ b/vernac/assumptions.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Globnames
 open Printer
 
@@ -21,11 +21,11 @@ open Printer
 val traverse :
   Label.t -> constr ->
     (Refset_env.t * Refset_env.t Refmap_env.t *
-     (label * Context.Rel.t * types) list Refmap_env.t)
+     (Label.t * Context.Rel.t * types) list Refmap_env.t)
 
 (** Collects all the assumptions (optionally including opaque definitions)
    on which a term relies (together with their type). The above warning of
    {!traverse} also applies. *)
 val assumptions :
   ?add_opaque:bool -> ?add_transparent:bool -> transparent_state ->
-     global_reference -> constr -> Term.types ContextObjectMap.t
+     global_reference -> constr -> types ContextObjectMap.t
diff --git a/vernac/auto_ind_decl.ml b/vernac/auto_ind_decl.ml
index 59920742d..ec6b62ee2 100644
--- a/vernac/auto_ind_decl.ml
+++ b/vernac/auto_ind_decl.ml
@@ -13,12 +13,12 @@ open CErrors
 open Util
 open Pp
 open Term
+open Constr
 open Vars
 open Termops
 open Declarations
 open Names
 open Globnames
-open Nameops
 open Inductiveops
 open Tactics
 open Ind_tables
@@ -91,6 +91,15 @@ let destruct_on_using c id =
 let destruct_on_as c l =
   destruct false None c (Some (Loc.tag l)) None
 
+let inj_flags = Some {
+    Equality.keep_proof_equalities = true; (* necessary *)
+    injection_in_context = true; (* does not matter here *)
+    Equality.injection_pattern_l2r_order = true; (* does not matter here *)
+  }
+
+let my_discr_tac = Equality.discr_tac false None
+let my_inj_tac x = Equality.inj inj_flags None false None (EConstr.mkVar x,NoBindings)
+
 (* reconstruct the inductive with the correct de Bruijn indexes *)
 let mkFullInd (ind,u) n =
   let mib = Global.lookup_mind (fst ind) in
@@ -181,7 +190,7 @@ let build_beq_scheme mode kn =
 	match EConstr.kind sigma c with
         | Rel x -> mkRel (x-nlist+ndx), Safe_typing.empty_private_constants
         | Var x ->
-          let eid = id_of_string ("eq_"^(string_of_id x)) in
+          let eid = Id.of_string ("eq_"^(Id.to_string x)) in
           let () =
             try ignore (Environ.lookup_named eid env)
             with Not_found -> raise (ParameterWithoutEquality (VarRef x))
@@ -190,7 +199,7 @@ let build_beq_scheme mode kn =
         | Cast (x,_,_) -> aux (EConstr.applist (x,a))
         | App _ -> assert false
         | Ind ((kn',i as ind'),u) (*FIXME: universes *) -> 
-            if eq_mind kn kn' then mkRel(eqA-nlist-i+nb_ind-1), Safe_typing.empty_private_constants
+            if MutInd.equal kn kn' then mkRel(eqA-nlist-i+nb_ind-1), Safe_typing.empty_private_constants
             else begin
               try
                 let eq, eff =
@@ -308,7 +317,7 @@ 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
+        if mib.mind_finite = CoFinite then
 	  raise NoDecidabilityCoInductive;
         let fix = mkFix (((Array.make nb_ind 0),i),(names,types,cores)) in
         create_input fix),
@@ -351,15 +360,15 @@ let do_replace_lb mode lb_scheme_key aavoid narg p q =
       if Id.equal avoid.(n-i) s then avoid.(n-i-x)
       else (if i<n then find (i+1)
             else user_err ~hdr:"AutoIndDecl.do_replace_lb"
-                   (str "Var " ++ pr_id s ++ str " seems unknown.")
+                   (str "Var " ++ Id.print s ++ str " seems unknown.")
       )
     in mkVar (find 1)
   with e when CErrors.noncritical e ->
       (* if this happen then the args have to be already declared as a
               Parameter*)
       (
-        let mp,dir,lbl = repr_con (fst (destConst sigma v)) in
-          mkConst (make_con mp dir (mk_label (
+        let mp,dir,lbl = Constant.repr3 (fst (destConst sigma v)) in
+          mkConst (Constant.make3 mp dir (Label.make (
           if Int.equal offset 1 then ("eq_"^(Label.to_string lbl))
                        else ((Label.to_string lbl)^"_lb")
         )))
@@ -368,6 +377,7 @@ let do_replace_lb mode lb_scheme_key aavoid narg p q =
   Proofview.Goal.enter begin fun gl ->
     let type_of_pq = Tacmach.New.pf_unsafe_type_of gl p in
     let sigma = Tacmach.New.project gl in
+    let env = Tacmach.New.pf_env gl in
     let u,v = destruct_ind sigma type_of_pq
     in let lb_type_of_p =
         try
@@ -380,7 +390,7 @@ let do_replace_lb mode lb_scheme_key aavoid narg p q =
 	    (str "Leibniz->boolean:" ++
              str "You have to declare the" ++
 	     str "decidability over " ++
-	     Printer.pr_econstr type_of_pq ++
+             Printer.pr_econstr_env env sigma type_of_pq ++
 	     str " first.")
           in
           Tacticals.New.tclZEROMSG err_msg
@@ -412,15 +422,15 @@ let do_replace_bl mode bl_scheme_key (ind,u as indu) aavoid narg lft rgt =
       if Id.equal avoid.(n-i) s then avoid.(n-i-x)
       else (if i<n then find (i+1)
             else user_err ~hdr:"AutoIndDecl.do_replace_bl"
-                   (str "Var " ++ pr_id s ++ str " seems unknown.")
+                   (str "Var " ++ Id.print s ++ str " seems unknown.")
       )
     in mkVar (find 1)
   with e when CErrors.noncritical e ->
       (* if this happen then the args have to be already declared as a
          Parameter*)
       (
-        let mp,dir,lbl = repr_con (fst (destConst sigma v)) in
-          mkConst (make_con mp dir (mk_label (
+        let mp,dir,lbl = Constant.repr3 (fst (destConst sigma v)) in
+          mkConst (Constant.make3 mp dir (Label.make (
           if Int.equal offset 1 then ("eq_"^(Label.to_string lbl))
                        else ((Label.to_string lbl)^"_bl")
         )))
@@ -433,6 +443,7 @@ let do_replace_bl mode bl_scheme_key (ind,u as indu) aavoid narg lft rgt =
         Proofview.Goal.enter begin fun gl ->
         let tt1 = Tacmach.New.pf_unsafe_type_of gl t1 in
         let sigma = Tacmach.New.project gl in
+        let env = Tacmach.New.pf_env gl in
         if EConstr.eq_constr sigma t1 t2 then aux q1 q2
         else (
           let u,v = try  destruct_ind sigma tt1
@@ -452,7 +463,7 @@ let do_replace_bl mode bl_scheme_key (ind,u as indu) aavoid narg lft rgt =
 	                                (str "boolean->Leibniz:" ++
                                          str "You have to declare the" ++
 			   	         str "decidability over " ++
-				         Printer.pr_econstr tt1 ++
+                                         Printer.pr_econstr_env env sigma tt1 ++
 				         str " first.")
 		 in
 		 user_err err_msg
@@ -495,7 +506,7 @@ let do_replace_bl mode bl_scheme_key (ind,u as indu) aavoid narg lft rgt =
         with DestKO -> Tacticals.New.tclZEROMSG (str "The expected type is an inductive one.")
       end
   end >>= fun (sp2,i2) ->
-  if not (eq_mind sp1 sp2) || not (Int.equal i1 i2)
+  if not (MutInd.equal sp1 sp2) || not (Int.equal i1 i2)
   then Tacticals.New.tclZEROMSG (str "Eq should be on the same type")
   else aux (Array.to_list ca1) (Array.to_list ca2)
 
@@ -522,8 +533,8 @@ let eqI ind l =
   and e, eff = 
     try let c, eff = find_scheme beq_scheme_kind ind in mkConst c, eff 
     with Not_found -> user_err ~hdr:"AutoIndDecl.eqI"
-      (str "The boolean equality on " ++ pr_mind (fst ind) ++ str " is needed.");
-  in (if Array.equal Term.eq_constr eA [||] then e else mkApp(e,eA)), eff
+      (str "The boolean equality on " ++ MutInd.print (fst ind) ++ str " is needed.");
+  in (if Array.equal Constr.equal eA [||] then e else mkApp(e,eA)), eff
 
 (**********************************************************************)
 (* Boolean->Leibniz *)
@@ -533,7 +544,7 @@ 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_right (fun id l -> id::l)) (List.map RelDecl.get_name lnamesparrec) [] in
+  let avoid = List.fold_right (Nameops.Name.fold_right (fun id l -> Id.Set.add id l)) (List.map RelDecl.get_name lnamesparrec) Id.Set.empty in
   let create_input c =
     let x = next_ident_away (Id.of_string "x") avoid and
         y = next_ident_away (Id.of_string "y") avoid in
@@ -578,7 +589,7 @@ let compute_bl_tact mode bl_scheme_key ind lnamesparrec nparrec =
         ( List.map (fun (_,_,sbl,_ ) -> sbl) list_id )
       in
       let fresh_id s gl =
-          let fresh = fresh_id_in_env (!avoid) s (Proofview.Goal.env gl) in
+          let fresh = fresh_id_in_env (Id.Set.of_list !avoid) s (Proofview.Goal.env gl) in
           avoid := fresh::(!avoid); fresh
       in
       Proofview.Goal.enter begin fun gl ->
@@ -595,7 +606,7 @@ let compute_bl_tact mode bl_scheme_key ind lnamesparrec nparrec =
                      intro_using freshz;
                      intros;
                      Tacticals.New.tclTRY (
-                      Tacticals.New.tclORELSE reflexivity (Equality.discr_tac false None)
+                      Tacticals.New.tclORELSE reflexivity my_discr_tac
                      );
                      simpl_in_hyp (freshz,Locus.InHyp);
 (*
@@ -676,7 +687,7 @@ 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_right (fun id l -> id::l)) (List.map RelDecl.get_name lnamesparrec) [] in
+  let avoid = List.fold_right (Nameops.Name.fold_right (fun id l -> Id.Set.add id l)) (List.map RelDecl.get_name lnamesparrec) Id.Set.empty in
   let eqI, eff = eqI ind lnamesparrec in
     let create_input c =
       let x = next_ident_away (Id.of_string "x") avoid and
@@ -722,7 +733,7 @@ let compute_lb_tact mode lb_scheme_key ind lnamesparrec nparrec =
         ( List.map (fun (_,_,_,slb) -> slb) list_id )
       in
       let fresh_id s gl =
-          let fresh = fresh_id_in_env (!avoid) s (Proofview.Goal.env gl) in
+          let fresh = fresh_id_in_env (Id.Set.of_list !avoid) s (Proofview.Goal.env gl) in
           avoid := fresh::(!avoid); fresh
       in
       Proofview.Goal.enter begin fun gl ->
@@ -739,9 +750,9 @@ let compute_lb_tact mode lb_scheme_key ind lnamesparrec nparrec =
                      intro_using freshz;
                      intros;
                      Tacticals.New.tclTRY (
-                      Tacticals.New.tclORELSE reflexivity (Equality.discr_tac false None)
+                      Tacticals.New.tclORELSE reflexivity my_discr_tac
                      );
-                     Equality.inj None false None (EConstr.mkVar freshz,NoBindings);
+                     my_inj_tac freshz;
 		     intros; simpl_in_concl;
                      Auto.default_auto;
                      Tacticals.New.tclREPEAT (
@@ -806,7 +817,7 @@ 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_right (fun id l -> id::l)) (List.map RelDecl.get_name lnamesparrec) [] in
+  let avoid = List.fold_right (Nameops.Name.fold_right (fun id l -> Id.Set.add id l)) (List.map RelDecl.get_name lnamesparrec) Id.Set.empty in
     let create_input c =
       let x = next_ident_away (Id.of_string "x") avoid and
           y = next_ident_away (Id.of_string "y") avoid in
@@ -870,7 +881,7 @@ let compute_dec_tact ind lnamesparrec nparrec =
       ( List.map (fun (_,_,_,slb) -> slb) list_id )
   in
   let fresh_id s gl =
-      let fresh = fresh_id_in_env (!avoid) s (Proofview.Goal.env gl) in
+      let fresh = fresh_id_in_env (Id.Set.of_list !avoid) s (Proofview.Goal.env gl) in
       avoid := fresh::(!avoid); fresh
   in
   Proofview.Goal.enter begin fun gl ->
@@ -936,7 +947,7 @@ let compute_dec_tact ind lnamesparrec nparrec =
                                 NoBindings
                               )
                               true;
-              Equality.discr_tac false None
+              my_discr_tac
 	    ]
             end
 	  ]
diff --git a/vernac/class.ml b/vernac/class.ml
index be682977e..943da8fa8 100644
--- a/vernac/class.ml
+++ b/vernac/class.ml
@@ -11,6 +11,7 @@ open Util
 open Pp
 open Names
 open Term
+open Constr
 open Vars
 open Termops
 open Entries
@@ -83,16 +84,9 @@ let check_target clt = function
 
 (* condition d'heritage uniforme *)
 
-let uniform_cond sigma nargs lt =
-  let open EConstr in
-  let rec aux = function
-    | (0,[]) -> true
-    | (n,t::l) ->
-      let t = strip_outer_cast sigma t in
-      isRel sigma t && Int.equal (destRel sigma t) n && aux ((n-1),l)
-    | _ -> false
-  in
-  aux (nargs,lt)
+let uniform_cond sigma ctx lt =
+  List.for_all2eq (EConstr.eq_constr sigma)
+    lt (Context.Rel.to_extended_list EConstr.mkRel 0 ctx)
 
 let class_of_global = function
   | ConstRef sp -> 
@@ -118,24 +112,29 @@ l'indice de la classe source dans la liste lp
 *)
 
 let get_source lp source =
+  let open Context.Rel.Declaration in
   match source with
     | None ->
-	let (cl1,u1,lv1) =
-          match lp with
-	    | [] -> raise Not_found
-            | t1::_ -> find_class_type Evd.empty (EConstr.of_constr t1)
-        in
-	(cl1,u1,lv1,1)
+       (* Take the latest non let-in argument *)
+       let rec aux = function
+         | [] -> raise Not_found
+         | LocalDef _ :: lt -> aux lt
+         | LocalAssum (_,t1) :: lt ->
+            let cl1,u1,lv1 = find_class_type Evd.empty (EConstr.of_constr t1) in
+            cl1,lt,lv1,1
+       in aux lp
     | Some cl ->
-	let rec aux = function
-	  | [] -> raise Not_found
-	  | t1::lt ->
-	      try
-		let cl1,u1,lv1 = find_class_type Evd.empty (EConstr.of_constr t1) in
-		if cl_typ_eq cl cl1 then cl1,u1,lv1,(List.length lt+1)
-		else raise Not_found
-              with Not_found -> aux lt
-	in aux (List.rev lp)
+       (* Take the first argument that matches *)
+       let rec aux acc = function
+         | [] -> raise Not_found
+         | LocalDef _ as decl :: lt -> aux (decl::acc) lt
+         | LocalAssum (_,t1) as decl :: lt ->
+            try
+              let cl1,u1,lv1 = find_class_type Evd.empty (EConstr.of_constr t1) in
+              if cl_typ_eq cl cl1 then cl1,acc,lv1,Context.Rel.nhyps lt+1
+              else raise Not_found
+            with Not_found -> aux (decl::acc) lt
+       in aux [] (List.rev lp)
 
 let get_target t ind =
   if (ind > 1) then
@@ -146,15 +145,6 @@ let get_target t ind =
       CL_PROJ p
     | x -> x
       
-
-let prods_of t =
-  let rec aux acc d = match kind_of_term d with
-    | Prod (_,c1,c2) -> aux (c1::acc) c2
-    | Cast (c,_,_) -> aux acc c
-    | _ -> (d,acc)
-  in
-  aux [] t
-
 let strength_of_cl = function
   | CL_CONST kn -> `GLOBAL
   | CL_SECVAR id -> `LOCAL
@@ -173,8 +163,8 @@ let get_strength stre ref cls clt =
 let ident_key_of_class = function
   | CL_FUN -> "Funclass"
   | CL_SORT -> "Sortclass"
-  | CL_CONST sp | CL_PROJ sp -> Label.to_string (con_label sp)
-  | CL_IND (sp,_) -> Label.to_string (mind_label sp)
+  | CL_CONST sp | CL_PROJ sp -> Label.to_string (Constant.label sp)
+  | CL_IND (sp,_) -> Label.to_string (MutInd.label sp)
   | CL_SECVAR id -> Id.to_string id
 
 (* Identity coercion *)
@@ -222,9 +212,10 @@ let build_id_coercion idf_opt source poly =
 	  Id.of_string ("Id_"^(ident_key_of_class source)^"_"^
                         (ident_key_of_class cl))
   in
+  let univs = Evd.const_univ_entry ~poly sigma in
   let constr_entry = (* Cast is necessary to express [val_f] is identity *)
     DefinitionEntry
-      (definition_entry ~types:typ_f ~poly ~univs:(snd (Evd.universe_context sigma))
+      (definition_entry ~types:typ_f ~univs
 	 ~inline:true (mkCast (val_f, DEFAULTcast, typ_f)))
   in
   let decl = (constr_entry, IsDefinition IdentityCoercion) in
@@ -256,17 +247,18 @@ let add_new_coercion_core coef stre poly source target isid =
   check_source source;
   let t, _ = Global.type_of_global_in_context (Global.env ()) coef in
   if coercion_exists coef then raise (CoercionError AlreadyExists);
-  let tg,lp = prods_of t in
+  let lp,tg = decompose_prod_assum t in
   let llp = List.length lp in
   if Int.equal llp 0 then raise (CoercionError NotAFunction);
-  let (cls,us,lvs,ind) =
+  let (cls,ctx,lvs,ind) =
     try
       get_source lp source
     with Not_found ->
       raise (CoercionError (NoSource source))
   in
   check_source (Some cls);
-  if not (uniform_cond Evd.empty (** FIXME *) (llp-ind) lvs) then
+  if not (uniform_cond Evd.empty (** FIXME - for when possibly called with unresolved evars in the future *)
+                       ctx lvs) then
     warn_uniform_inheritance coef;
   let clt =
     try
diff --git a/vernac/classes.ml b/vernac/classes.ml
index ab1892a18..695be74bb 100644
--- a/vernac/classes.ml
+++ b/vernac/classes.ml
@@ -8,9 +8,7 @@
 
 (*i*)
 open Names
-open Term
-open Vars
-open Environ
+open EConstr
 open Nametab
 open CErrors
 open Util
@@ -69,10 +67,9 @@ 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_in_context (Global.env ()) c in
-  let _, r = decompose_prod_assum instance in
+  let _, r = Term.decompose_prod_assum instance in
     match class_of_constr Evd.empty (EConstr.of_constr r) with
-      | Some (_, ((tc,u), _)) -> add_instance (new_instance tc info glob
-  (*FIXME*) (Flags.use_polymorphic_flag ()) c)
+      | Some (_, ((tc,u), _)) -> add_instance (new_instance tc info glob c)
       | None -> user_err ?loc:(loc_of_reference g)
                          ~hdr:"declare_instance"
                          (Pp.str "Constant does not build instances of a declared type class.")
@@ -82,23 +79,24 @@ let mismatched_props env n m = mismatched_ctx_inst env Properties n m
 
 (* Declare everything in the parameters as implicit, and the class instance as well *)
 
-let type_ctx_instance evars env ctx inst subst =
-  let rec aux (subst, instctx) l = function
+let type_ctx_instance env sigma ctx inst subst =
+  let open Vars in
+  let rec aux (sigma, subst, instctx) l = function
     decl :: ctx ->
       let t' = substl subst (RelDecl.get_type decl) in
-      let c', l =
+      let (sigma, c'), l =
 	match decl with
-	| LocalAssum _ -> EConstr.Unsafe.to_constr (interp_casted_constr_evars env evars (List.hd l) t'), List.tl l
-	| LocalDef (_,b,_) -> substl subst b, l
+        | LocalAssum _ -> interp_casted_constr_evars env sigma (List.hd l) t', List.tl l
+        | LocalDef (_,b,_) -> (sigma, substl subst b), l
       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)
+        aux (sigma, c' :: subst, d :: instctx) l ctx
+    | [] -> sigma, subst
+  in aux (sigma, subst, []) inst (List.rev ctx)
 
 let id_of_class cl =
   match cl.cl_impl with
-    | ConstRef kn -> let _,_,l = repr_con kn in Label.to_id l
+    | ConstRef kn -> let _,_,l = Constant.repr3 kn in Label.to_id l
     | IndRef (kn,i) ->
 	let mip = (Environ.lookup_mind kn (Global.env ())).Declarations.mind_packets in
 	  mip.(0).Declarations.mind_typename
@@ -111,38 +109,38 @@ let instance_hook k info global imps ?hook cst =
   Typeclasses.declare_instance (Some info) (not global) cst;
   (match hook with Some h -> h cst | None -> ())
 
-let declare_instance_constant k info global imps ?hook id pl poly evm term termtype =
+let declare_instance_constant k info global imps ?hook id decl poly sigma term termtype =
   let kind = IsDefinition Instance in
-  let evm = 
-    let levels = Univ.LSet.union (Univops.universes_of_constr termtype) 
-				 (Univops.universes_of_constr term) in
-    Evd.restrict_universe_context evm levels 
+  let sigma =
+    let env = Global.env () in
+    let levels = Univ.LSet.union (Univops.universes_of_constr env termtype)
+                                 (Univops.universes_of_constr env term) in
+    Evd.restrict_universe_context sigma levels
   in
-  let pl, uctx = Evd.universe_context ?names:pl evm in
+  let uctx = Evd.check_univ_decl ~poly sigma decl in
   let entry = 
-    Declare.definition_entry ~types:termtype ~poly ~univs:uctx term
+    Declare.definition_entry ~types:termtype ~univs:uctx term
   in
   let cdecl = (DefinitionEntry entry, kind) in
   let kn = Declare.declare_constant id cdecl in
     Declare.definition_message id;
-    Universes.register_universe_binders (ConstRef kn) pl;
+    Declare.declare_univ_binders (ConstRef kn) (Evd.universe_binders sigma);
     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
-    ?(generalize=true)
-    ?(tac:unit Proofview.tactic option) ?hook pri =
+let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance)
+  ~program_mode poly ctx (instid, bk, cl) props ?(generalize=true)
+  ?(tac:unit Proofview.tactic option) ?hook pri =
   let env = Global.env() in
-  let ((loc, instid), pl) = instid in
-  let uctx = Evd.make_evar_universe_context env pl in
-  let evars = ref (Evd.from_ctx uctx) in
+  let ({CAst.loc;v=instid}, pl) = instid in
+  let sigma, decl = Univdecls.interp_univ_decl_opt env pl in
   let tclass, ids =
     match bk with
     | Decl_kinds.Implicit ->
 	Implicit_quantifiers.implicit_application Id.Set.empty ~allow_partial:false
 	  (fun avoid (clname, _) ->
 	    match clname with
-	    | Some (cl, b) ->
+            | Some cl ->
 		let t = CAst.make @@ CHole (None, Misctypes.IntroAnonymous, None) in
 		  t, avoid
 	    | None -> failwith ("new instance: under-applied typeclass"))
@@ -153,42 +151,41 @@ let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) p
     if generalize then CAst.make @@ CGeneralization (Implicit, Some AbsPi, tclass) 
     else tclass 
   in
-  let k, u, cty, ctx', ctx, len, imps, subst =
-    let impls, ((env', ctx), imps) = interp_context_evars env evars ctx in
-    let ctx = List.map (fun d -> Termops.map_rel_decl EConstr.Unsafe.to_constr d) ctx in
-    let c', imps' = interp_type_evars_impls ~impls env' evars tclass in
-    let c' = EConstr.Unsafe.to_constr c' in
+  let sigma, k, u, cty, ctx', ctx, len, imps, subst =
+    let sigma, (impls, ((env', ctx), imps)) = interp_context_evars env sigma ctx in
+    let sigma, (c', imps') = interp_type_evars_impls ~impls env' sigma tclass in
     let len = List.length ctx in
     let imps = imps @ Impargs.lift_implicits len imps' in
-    let ctx', c = decompose_prod_assum c' in
+    let ctx', c = decompose_prod_assum sigma c' in
     let ctx'' = ctx' @ ctx in
-    let (k, u), args = Typeclasses.dest_class_app (push_rel_context ctx'' env) !evars (EConstr.of_constr c) in
-    let u = EConstr.EInstance.kind !evars u in
-    let cl = Typeclasses.typeclass_univ_instance (k, u) in
-    let _, args = 
+    let (k, u), args = Typeclasses.dest_class_app (push_rel_context ctx'' env) sigma c in
+    let u_s = EInstance.kind sigma u in
+    let cl = Typeclasses.typeclass_univ_instance (k, u_s) in
+    let args = List.map of_constr args in
+    let cl_context = List.map (Termops.map_rel_decl of_constr) (snd cl.cl_context) in
+    let _, args =
       List.fold_right (fun decl (args, args') ->
 	match decl with
 	| LocalAssum _ -> (List.tl args, List.hd args :: args')
-	| LocalDef (_,b,_) -> (args, substl args' b :: args'))
-	(snd cl.cl_context) (args, [])
+        | LocalDef (_,b,_) -> (args, Vars.substl args' b :: args'))
+        cl_context (args, [])
     in
-      cl, u, c', ctx', ctx, len, imps, args
+      sigma, cl, u, c', ctx', ctx, len, imps, args
   in
   let id =
     match instid with
 	Name id ->
 	  let sp = Lib.make_path id in
 	    if Nametab.exists_cci sp then
-	      user_err ~hdr:"new_instance" (Nameops.pr_id id ++ Pp.str " already exists.");
+	      user_err ~hdr:"new_instance" (Id.print id ++ Pp.str " already exists.");
 	    id
       | Anonymous ->
 	  let i = Nameops.add_suffix (id_of_class k) "_instance_0" in
-	    Namegen.next_global_ident_away i (Termops.ids_of_context env)
+	    Namegen.next_global_ident_away i (Termops.vars_of_env env)
   in
   let env' = push_rel_context ctx env in
-  evars := Evarutil.nf_evar_map !evars;
-  evars := resolve_typeclasses ~filter:Typeclasses.all_evars ~fail:true env !evars;
-  let subst = List.map (fun c -> EConstr.Unsafe.to_constr (Evarutil.nf_evar !evars (EConstr.of_constr c))) subst in
+  let sigma = Evarutil.nf_evar_map sigma in
+  let sigma = resolve_typeclasses ~filter:Typeclasses.all_evars ~fail:true env sigma in
     if abstract then
       begin
 	let subst = List.fold_left2
@@ -196,19 +193,17 @@ let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) p
 	  [] subst (snd k.cl_context)
 	in
 	let (_, ty_constr) = instance_constructor (k,u) subst in
-	let nf, subst = Evarutil.e_nf_evars_and_universes evars in
-	let termtype =
-	  let t = it_mkProd_or_LetIn ty_constr (ctx' @ ctx) in
-	    nf t
-	in
-	Pretyping.check_evars env Evd.empty !evars (EConstr.of_constr termtype);
-	let pl, ctx = Evd.universe_context ?names:pl !evars in
-	let cst = Declare.declare_constant ~internal:Declare.InternalTacticRequest id
-	  (ParameterEntry 
-            (None,poly,(termtype,ctx),None), Decl_kinds.IsAssumption Decl_kinds.Logical)
-	in
-	  Universes.register_universe_binders (ConstRef cst) pl;
-	  instance_hook k pri global imps ?hook (ConstRef cst); id
+        let termtype = it_mkProd_or_LetIn ty_constr (ctx' @ ctx) in
+        let sigma,_ = Evarutil.nf_evars_and_universes sigma in
+        Pretyping.check_evars env Evd.empty sigma termtype;
+        let univs = Evd.check_univ_decl ~poly sigma decl in
+        let termtype = to_constr sigma termtype in
+        let cst = Declare.declare_constant ~internal:Declare.InternalTacticRequest id
+          (ParameterEntry
+            (None,(termtype,univs),None), Decl_kinds.IsAssumption Decl_kinds.Logical)
+        in
+          Declare.declare_univ_binders (ConstRef cst) (Evd.universe_binders sigma);
+          instance_hook k pri global imps ?hook (ConstRef cst); id
       end
     else (
       let props =
@@ -219,16 +214,16 @@ let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) p
 	    Some (Inl fs)
 	| Some (_, t) -> Some (Inr t)
 	| None -> 
-	    if Flags.is_program_mode () then Some (Inl [])
+            if program_mode then Some (Inl [])
 	    else None
       in
-      let subst =
+      let subst, sigma =
 	match props with
-	| None -> if List.is_empty k.cl_props then Some (Inl subst) else None
+        | None ->
+          (if List.is_empty k.cl_props then Some (Inl subst) else None), sigma
 	| Some (Inr term) ->
-	    let c = interp_casted_constr_evars env' evars term cty in
-	    let c = EConstr.Unsafe.to_constr c in
-	      Some (Inr (c, subst))
+            let sigma, c = interp_casted_constr_evars env' sigma term cty in
+            Some (Inr (c, subst)), sigma
 	| Some (Inl props) ->
 	    let get_id =
 	      function
@@ -265,9 +260,10 @@ let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) p
               | (n, _) :: _ ->
 		unbound_method env' k.cl_impl (get_id n)
               | _ ->
-		Some (Inl (type_ctx_instance evars (push_rel_context ctx' env') 
-			     k.cl_props props subst))
-      in	  
+                let kcl_props = List.map (Termops.map_rel_decl of_constr) k.cl_props in
+                let sigma, res = type_ctx_instance (push_rel_context ctx' env') sigma kcl_props props subst in
+                Some (Inl res), sigma
+      in
       let term, termtype =
 	match subst with
 	| None -> let termtype = it_mkProd_or_LetIn cty ctx in
@@ -279,34 +275,30 @@ let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) p
 	  in
 	  let (app, ty_constr) = instance_constructor (k,u) subst in
 	  let termtype = it_mkProd_or_LetIn ty_constr (ctx' @ ctx) in
-	  let term = Termops.it_mkLambda_or_LetIn (Option.get app) (ctx' @ ctx) in
+          let term = it_mkLambda_or_LetIn (Option.get app) (ctx' @ ctx) in
 	    Some term, termtype
 	| Some (Inr (def, subst)) ->
 	  let termtype = it_mkProd_or_LetIn cty ctx in
-	  let term = Termops.it_mkLambda_or_LetIn def ctx in
+          let term = it_mkLambda_or_LetIn def ctx in
 	    Some term, termtype
       in
-      let _ = 
-	evars := Evarutil.nf_evar_map !evars;
-	evars := Typeclasses.resolve_typeclasses ~filter:Typeclasses.no_goals_or_obligations ~fail:true
-          env !evars;
-	(* Try resolving fields that are typeclasses automatically. *)
-	evars := Typeclasses.resolve_typeclasses ~filter:Typeclasses.all_evars ~fail:false
-	  env !evars
-      in
-      let _ = evars := Evarutil.nf_evar_map_undefined !evars in
-      let evm, nf = Evarutil.nf_evar_map_universes !evars in
-      let termtype = nf termtype in
-      let _ = (* Check that the type is free of evars now. *)
-	Pretyping.check_evars env Evd.empty evm (EConstr.of_constr termtype)
-      in
-      let term = Option.map nf term in
-	if not (Evd.has_undefined evm) && not (Option.is_empty term) then
-	  declare_instance_constant k pri global imps ?hook id pl
-            poly evm (Option.get term) termtype
-	else if Flags.is_program_mode () || refine || Option.is_empty term then begin
+      let sigma = Evarutil.nf_evar_map sigma in
+      let sigma = Typeclasses.resolve_typeclasses ~filter:Typeclasses.no_goals_or_obligations ~fail:true env sigma in
+      (* Try resolving fields that are typeclasses automatically. *)
+      let sigma = Typeclasses.resolve_typeclasses ~filter:Typeclasses.all_evars ~fail:false env sigma in
+      let sigma = Evarutil.nf_evar_map_undefined sigma in
+      (* Beware of this step, it is required as to minimize universes. *)
+      let sigma, _nf = Evarutil.nf_evar_map_universes sigma in
+      (* Check that the type is free of evars now. *)
+      Pretyping.check_evars env Evd.empty sigma termtype;
+      let termtype = to_constr sigma termtype in
+      let term = Option.map (to_constr sigma) term in
+        if not (Evd.has_undefined sigma) && not (Option.is_empty term) then
+	  declare_instance_constant k pri global imps ?hook id decl
+            poly sigma (Option.get term) termtype
+        else if program_mode || refine || Option.is_empty term then begin
 	  let kind = Decl_kinds.Global, poly, Decl_kinds.DefinitionBody Decl_kinds.Instance in
-	    if Flags.is_program_mode () then
+            if program_mode then
 	      let hook vis gr _ =
 		let cst = match gr with ConstRef kn -> kn | _ -> assert false in
 		  Impargs.declare_manual_implicits false gr ~enriching:false [imps];
@@ -316,14 +308,14 @@ let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) p
 		match term with 
 		| Some t -> 
 		  let obls, _, constr, typ = 
-		    Obligations.eterm_obligations env id evm 0 t termtype
+                    Obligations.eterm_obligations env id sigma 0 t termtype
 		  in obls, Some constr, typ
 		| None -> [||], None, termtype
 	      in
               let hook = Lemmas.mk_hook hook in
-	      let ctx = Evd.evar_universe_context evm in
+              let ctx = Evd.evar_universe_context sigma in
 		ignore (Obligations.add_definition id ?term:constr
- 			?pl typ ctx ~kind:(Global,poly,Instance) ~hook obls);
+ 			~univdecl:decl typ ctx ~kind:(Global,poly,Instance) ~hook obls);
 		id
 	    else
 	      (Flags.silently 
@@ -332,16 +324,16 @@ let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) p
                      the pretyping after the proof has opened. As a
                      consequence, we use the low-level primitives to code
                      the refinement manually.*)
-		let gls = List.rev (Evd.future_goals evm) in
-                let evm = Evd.reset_future_goals evm in
-                Lemmas.start_proof id ?pl kind evm (EConstr.of_constr termtype)
+                let gls = List.rev (Evd.future_goals sigma) in
+                let sigma = Evd.reset_future_goals sigma in
+                Lemmas.start_proof id ~pl:decl kind sigma (EConstr.of_constr termtype)
 		(Lemmas.mk_hook
                   (fun _ -> instance_hook k pri global imps ?hook));
                  (* spiwack: I don't know what to do with the status here. *)
 		if not (Option.is_empty term) then
                   let init_refine =
                     Tacticals.New.tclTHENLIST [
-                      Refine.refine ~typecheck:false (fun evm -> (evm,EConstr.of_constr (Option.get term)));
+                      Refine.refine ~typecheck:false (fun sigma -> (sigma,EConstr.of_constr (Option.get term)));
                       Proofview.Unsafe.tclNEWGOALS gls;
                       Tactics.New.reduce_after_refine;
                     ]
@@ -355,6 +347,7 @@ let new_instance ?(abstract=false) ?(global=false) ?(refine= !refine_instance) p
       else CErrors.user_err Pp.(str "Unsolved obligations remaining."))
 	
 let named_of_rel_context l =
+  let open Vars in
   let acc, ctx =
     List.fold_right
       (fun decl (subst, ctx) ->
@@ -368,36 +361,38 @@ let named_of_rel_context l =
 
 let context poly l =
   let env = Global.env() in
-  let evars = ref (Evd.from_env env) in
-  let _, ((env', fullctx), impls) = interp_context_evars env evars l in
-  let fullctx = List.map (fun d -> Termops.map_rel_decl EConstr.Unsafe.to_constr d) fullctx in
-  let subst = Evarutil.evd_comb0 Evarutil.nf_evars_and_universes evars in
-  let fullctx = Context.Rel.map subst fullctx in
-  let ce t = Pretyping.check_evars env Evd.empty !evars (EConstr.of_constr t) in
+  let sigma = Evd.from_env env in
+  let sigma, (_, ((env', fullctx), impls)) = interp_context_evars env sigma l in
+  (* Note, we must use the normalized evar from now on! *)
+  let sigma,_ = Evarutil.nf_evars_and_universes sigma in
+  let ce t = Pretyping.check_evars env Evd.empty sigma t in
   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 CErrors.noncritical e ->
       user_err Pp.(str "Anonymous variables not allowed in contexts.")
   in
-  let uctx = ref (Evd.universe_context_set !evars) in
+  let uctx = ref (Evd.universe_context_set sigma) in
   let fn status (id, b, t) =
+    let b, t = Option.map (to_constr sigma) b, to_constr sigma t in
     if Lib.is_modtype () && not (Lib.sections_are_opened ()) then
-      let ctx = Univ.ContextSet.to_context !uctx in
       (* Declare the universe context once *)
+      let univs = if poly
+        then Polymorphic_const_entry (Univ.ContextSet.to_context !uctx)
+        else Monomorphic_const_entry !uctx
+      in
       let () = uctx := Univ.ContextSet.empty in
       let decl = match b with
       | None ->
-        (ParameterEntry (None,poly,(t,ctx),None), IsAssumption Logical)
+        (ParameterEntry (None,(t,univs),None), IsAssumption Logical)
       | Some b ->
-        let entry = Declare.definition_entry ~poly ~univs:ctx ~types:t b in
+        let entry = Declare.definition_entry ~univs ~types:t b in
         (DefinitionEntry entry, IsAssumption Logical)
       in
       let cst = Declare.declare_constant ~internal:Declare.InternalTacticRequest id decl in
-	match class_of_constr !evars (EConstr.of_constr t) with
+        match class_of_constr sigma (of_constr t) with
 	| Some (rels, ((tc,_), args) as _cl) ->
-	    add_instance (Typeclasses.new_instance tc Hints.empty_hint_info false (*FIXME*)
-			    poly (ConstRef cst));
+            add_instance (Typeclasses.new_instance tc Hints.empty_hint_info false (ConstRef cst));
             status
 	    (* declare_subclasses (ConstRef cst) cl *)
 	| None -> status
@@ -408,16 +403,19 @@ let context poly l =
       in
       let impl = List.exists test impls in
       let decl = (Discharge, poly, Definitional) in
+      let univs = if poly
+        then Polymorphic_const_entry (Univ.ContextSet.to_context !uctx)
+        else Monomorphic_const_entry !uctx
+      in
       let nstatus = match b with
       | None ->
-        pi3 (Command.declare_assumption false decl (t, !uctx) [] [] impl
-          Vernacexpr.NoInline (Loc.tag id))
+        pi3 (ComAssumption.declare_assumption false decl (t, univs) Universes.empty_binders [] impl
+          Vernacexpr.NoInline (CAst.make id))
       | Some b ->
-        let ctx = Univ.ContextSet.to_context !uctx in
         let decl = (Discharge, poly, Definition) in
-        let entry = Declare.definition_entry ~poly ~univs:ctx ~types:t b in
+        let entry = Declare.definition_entry ~univs ~types:t b in
         let hook = Lemmas.mk_hook (fun _ gr -> gr) in
-        let _ = DeclareDef.declare_definition id decl entry [] [] hook in
+        let _ = DeclareDef.declare_definition id decl entry Universes.empty_binders [] hook in
         Lib.sections_are_opened () || Lib.is_modtype_strict ()
       in
 	status && nstatus
diff --git a/vernac/classes.mli b/vernac/classes.mli
index fc2fdbbf3..d47c6a6f8 100644
--- a/vernac/classes.mli
+++ b/vernac/classes.mli
@@ -30,20 +30,21 @@ val declare_instance_constant :
   Impargs.manual_explicitation list -> (** implicits *)
   ?hook:(Globnames.global_reference -> unit) ->
   Id.t -> (** name *)
-  Id.t Loc.located list option ->
+  Univdecls.universe_decl ->
   bool -> (* polymorphic *)
   Evd.evar_map -> (* Universes *)
   Constr.t -> (** body *)
-  Term.types -> (** type *)
+  Constr.types -> (** type *)
   Names.Id.t
 
 val new_instance :
   ?abstract:bool -> (** Not abstract by default. *)
   ?global:bool -> (** Not global by default. *)
   ?refine:bool -> (** Allow refinement *)
+  program_mode:bool ->
   Decl_kinds.polymorphic ->
   local_binder_expr list ->
-  typeclass_constraint ->
+  Vernacexpr.typeclass_constraint ->
   (bool * constr_expr) option ->
   ?generalize:bool ->
   ?tac:unit Proofview.tactic  ->
diff --git a/vernac/comAssumption.ml b/vernac/comAssumption.ml
new file mode 100644
index 000000000..7e5b941ad
--- /dev/null
+++ b/vernac/comAssumption.ml
@@ -0,0 +1,182 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Pp
+open CErrors
+open Util
+open Vars
+open Environ
+open Declare
+open Names
+open Globnames
+open Constrexpr_ops
+open Constrintern
+open Impargs
+open Decl_kinds
+open Pretyping
+open Vernacexpr
+open Entries
+
+(* 2| Variable/Hypothesis/Parameter/Axiom declarations *)
+
+let axiom_into_instance = ref false
+
+let _ =
+  let open Goptions in
+  declare_bool_option
+    { optdepr = false;
+      optname = "automatically declare axioms whose type is a typeclass as instances";
+      optkey = ["Typeclasses";"Axioms";"Are";"Instances"];
+      optread = (fun _ -> !axiom_into_instance);
+      optwrite = (:=) axiom_into_instance; }
+
+let should_axiom_into_instance = function
+  | Discharge ->
+    (* The typeclass behaviour of Variable and Context doesn't depend
+       on section status *)
+    true
+  | Global | Local -> !axiom_into_instance
+
+let declare_assumption is_coe (local,p,kind) (c,ctx) pl imps impl nl {CAst.v=ident} =
+match local with
+| Discharge when Lib.sections_are_opened () ->
+  let ctx = match ctx with
+    | Monomorphic_const_entry ctx -> ctx
+    | Polymorphic_const_entry ctx -> Univ.ContextSet.of_context ctx
+  in
+  let decl = (Lib.cwd(), SectionLocalAssum ((c,ctx),p,impl), IsAssumption kind) in
+  let _ = declare_variable ident decl in
+  let () = assumption_message ident in
+  let () =
+    if not !Flags.quiet && Proof_global.there_are_pending_proofs () then
+    Feedback.msg_info (str"Variable" ++ spc () ++ Id.print ident ++
+    strbrk " is not visible from current goals")
+  in
+  let r = VarRef ident in
+  let () = Typeclasses.declare_instance None true r in
+  let () = if is_coe then Class.try_add_new_coercion r ~local:true false in
+  (r,Univ.Instance.empty,true)
+
+| Global | Local | Discharge ->
+  let do_instance = should_axiom_into_instance local in
+  let local = DeclareDef.get_locality ident ~kind:"axiom" local in
+  let inl = match nl with
+    | NoInline -> None
+    | DefaultInline -> Some (Flags.get_inline_level())
+    | InlineAt i -> Some i
+  in
+  let decl = (ParameterEntry (None,(c,ctx),inl), IsAssumption kind) in
+  let kn = declare_constant ident ~local decl in
+  let gr = ConstRef kn in
+  let () = maybe_declare_manual_implicits false gr imps in
+  let () = Declare.declare_univ_binders gr pl in
+  let () = assumption_message ident in
+  let () = if do_instance then Typeclasses.declare_instance None false gr in
+  let () = if is_coe then Class.try_add_new_coercion gr ~local p in
+  let inst = match ctx with
+    | Polymorphic_const_entry ctx -> Univ.UContext.instance ctx
+    | Monomorphic_const_entry _ -> Univ.Instance.empty
+  in
+    (gr,inst,Lib.is_modtype_strict ())
+
+let interp_assumption sigma env impls bl c =
+  let c = mkCProdN ?loc:(local_binders_loc bl) bl c in
+  let sigma, (ty, impls) = interp_type_evars_impls env sigma ~impls c in
+  let ty = EConstr.Unsafe.to_constr ty in
+  sigma, (ty, impls)
+
+(* When monomorphic the universe constraints are declared with the first declaration only. *)
+let next_uctx =
+  let empty_uctx = Monomorphic_const_entry Univ.ContextSet.empty in
+  function
+  | Polymorphic_const_entry _ as uctx -> uctx
+  | Monomorphic_const_entry _ -> empty_uctx
+
+let declare_assumptions idl is_coe k (c,uctx) pl imps nl =
+  let refs, status, _ =
+    List.fold_left (fun (refs,status,uctx) id ->
+      let ref',u',status' =
+        declare_assumption is_coe k (c,uctx) pl imps false nl id in
+      (ref',u')::refs, status' && status, next_uctx uctx)
+      ([],true,uctx) idl
+  in
+  List.rev refs, status
+
+
+let maybe_error_many_udecls = function
+  | ({CAst.loc;v=id}, Some _) ->
+    user_err ?loc ~hdr:"many_universe_declarations"
+      Pp.(str "When declaring multiple axioms in one command, " ++
+          str "only the first is allowed a universe binder " ++
+          str "(which will be shared by the whole block).")
+  | (_, None) -> ()
+
+let process_assumptions_udecls kind l =
+  let udecl, first_id = match l with
+    | (coe, ((id, udecl)::rest, c))::rest' ->
+      List.iter maybe_error_many_udecls rest;
+      List.iter (fun (coe, (idl, c)) -> List.iter maybe_error_many_udecls idl) rest';
+      udecl, id
+    | (_, ([], _))::_ | [] -> assert false
+  in
+  let () = match kind, udecl with
+    | (Discharge, _, _), Some _ when Lib.sections_are_opened () ->
+      let loc = first_id.CAst.loc in
+      let msg = Pp.str "Section variables cannot be polymorphic." in
+      user_err ?loc  msg
+    | _ -> ()
+  in
+  udecl, List.map (fun (coe, (idl, c)) -> coe, (List.map fst idl, c)) l
+
+let do_assumptions kind nl l =
+  let open Context.Named.Declaration in
+  let env = Global.env () in
+  let udecl, l = process_assumptions_udecls kind l in
+  let sigma, udecl = Univdecls.interp_univ_decl_opt env udecl in
+  let l =
+    if pi2 kind (* poly *) then
+      (* Separate declarations so that A B : Type puts A and B in different levels. *)
+      List.fold_right (fun (is_coe,(idl,c)) acc ->
+        List.fold_right (fun id acc ->
+          (is_coe, ([id], c)) :: acc) idl acc)
+        l []
+    else l
+  in
+  (* We intepret all declarations in the same evar_map, i.e. as a telescope. *)
+  let (sigma,_,_),l = List.fold_left_map (fun (sigma,env,ienv) (is_coe,(idl,c)) ->
+    let sigma,(t,imps) = interp_assumption sigma env ienv [] c in
+    let env =
+      push_named_context (List.map (fun {CAst.v=id} -> LocalAssum (id,t)) idl) env in
+    let ienv = List.fold_right (fun {CAst.v=id} ienv ->
+      let impls = compute_internalization_data env Variable t imps in
+      Id.Map.add id impls ienv) idl ienv in
+      ((sigma,env,ienv),((is_coe,idl),t,imps)))
+    (sigma,env,empty_internalization_env) l
+  in
+  let sigma = solve_remaining_evars all_and_fail_flags env sigma Evd.empty in
+  (* The universe constraints come from the whole telescope. *)
+  let sigma = Evd.nf_constraints sigma in
+  let nf_evar c = EConstr.to_constr sigma (EConstr.of_constr c) in
+  let uvars, l = List.fold_left_map (fun uvars (coe,t,imps) ->
+      let t = nf_evar t in
+      let uvars = Univ.LSet.union uvars (Univops.universes_of_constr env t) in
+      uvars, (coe,t,imps))
+      Univ.LSet.empty l
+  in
+  let sigma = Evd.restrict_universe_context sigma uvars in
+  let uctx = Evd.check_univ_decl ~poly:(pi2 kind) sigma udecl in
+  let ubinders = Evd.universe_binders sigma in
+  pi2 (List.fold_left (fun (subst,status,uctx) ((is_coe,idl),t,imps) ->
+      let t = replace_vars subst t in
+      let refs, status' = declare_assumptions idl is_coe kind (t,uctx) ubinders imps nl in
+      let subst' = List.map2
+          (fun {CAst.v=id} (c,u) -> (id, Universes.constr_of_global_univ (c,u)))
+          idl refs
+      in
+      subst'@subst, status' && status, next_uctx uctx)
+    ([], true, uctx) l)
diff --git a/vernac/comAssumption.mli b/vernac/comAssumption.mli
new file mode 100644
index 000000000..0491638c9
--- /dev/null
+++ b/vernac/comAssumption.mli
@@ -0,0 +1,34 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Names
+open Constr
+open Entries
+open Globnames
+open Vernacexpr
+open Constrexpr
+open Decl_kinds
+
+(** {6 Parameters/Assumptions} *)
+
+val do_assumptions : locality * polymorphic * assumption_object_kind ->
+  Vernacexpr.inline -> (Vernacexpr.ident_decl list * constr_expr) with_coercion list -> bool
+
+(************************************************************************)
+(** Internal API  *)
+(************************************************************************)
+
+(** Exported for Classes *)
+
+(** returns [false] if the assumption is neither local to a section,
+    nor in a module type and meant to be instantiated. *)
+val declare_assumption : coercion_flag -> assumption_kind ->
+  types in_constant_universes_entry ->
+  Universes.universe_binders -> Impargs.manual_implicits ->
+  bool (** implicit *) -> Vernacexpr.inline -> variable CAst.t ->
+  global_reference * Univ.Instance.t * bool
diff --git a/vernac/comDefinition.ml b/vernac/comDefinition.ml
new file mode 100644
index 000000000..d376696f7
--- /dev/null
+++ b/vernac/comDefinition.ml
@@ -0,0 +1,132 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2018     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Pp
+open Util
+open Constr
+open Environ
+open Entries
+open Redexpr
+open Declare
+open Constrintern
+open Pretyping
+
+open Context.Rel.Declaration
+
+(* Commands of the interface: Constant definitions *)
+
+let rec under_binders env sigma f n c =
+  if Int.equal n 0 then f env sigma (EConstr.of_constr c) else
+    match Constr.kind c with
+      | Lambda (x,t,c) ->
+          mkLambda (x,t,under_binders (push_rel (LocalAssum (x,t)) env) sigma f (n-1) c)
+      | LetIn (x,b,t,c) ->
+          mkLetIn (x,b,t,under_binders (push_rel (LocalDef (x,b,t)) env) sigma f (n-1) c)
+      | _ -> assert false
+
+let red_constant_entry n ce sigma = function
+  | None -> ce
+  | Some red ->
+      let proof_out = ce.const_entry_body in
+      let env = Global.env () in
+      let (redfun, _) = reduction_of_red_expr env red in
+      let redfun env sigma c =
+        let (_, c) = redfun env sigma c in
+        EConstr.Unsafe.to_constr c
+      in
+      { ce with const_entry_body = Future.chain 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 check_imps ~impsty ~impsbody =
+  let b =
+    try
+      List.for_all (fun (key, (va:bool*bool*bool)) ->
+          (* Pervasives.(=) is OK for this type *)
+          Pervasives.(=) (List.assoc_f Impargs.explicitation_eq key impsty) va)
+        impsbody
+    with Not_found -> false
+  in
+  if not b then warn_implicits_in_term ()
+
+let interp_definition pl bl poly red_option c ctypopt =
+  let open EConstr in
+  let env = Global.env() in
+  (* Explicitly bound universes and constraints *)
+  let evd, decl = Univdecls.interp_univ_decl_opt env pl in
+  (* Build the parameters *)
+  let evd, (impls, ((env_bl, ctx), imps1)) = interp_context_evars env evd bl in
+  (* Build the type *)
+  let evd, tyopt = Option.fold_left_map
+      (interp_type_evars_impls ~impls env_bl)
+      evd ctypopt
+  in
+  (* Build the body, and merge implicits from parameters and from type/body *)
+  let evd, c, imps, tyopt =
+    match tyopt with
+    | None ->
+      let evd, (c, impsbody) = interp_constr_evars_impls ~impls env_bl evd c in
+      evd, c, imps1@Impargs.lift_implicits (Context.Rel.nhyps ctx) impsbody, None
+    | Some (ty, impsty) ->
+      let evd, (c, impsbody) = interp_casted_constr_evars_impls ~impls env_bl evd c ty in
+      check_imps ~impsty ~impsbody;
+      evd, c, imps1@Impargs.lift_implicits (Context.Rel.nhyps ctx) impsty, Some ty
+  in
+  (* universe minimization *)
+  let evd = Evd.nf_constraints evd in
+  (* Substitute evars and universes, and add parameters.
+     Note: in program mode some evars may remain. *)
+  let ctx = List.map (EConstr.to_rel_decl evd) ctx in
+  let c = Term.it_mkLambda_or_LetIn (EConstr.to_constr evd c) ctx in
+  let tyopt = Option.map (fun ty -> Term.it_mkProd_or_LetIn (EConstr.to_constr evd ty) ctx) tyopt in
+  (* Keep only useful universes. *)
+  let uvars_fold uvars c =
+    Univ.LSet.union uvars (universes_of_constr env evd (of_constr c))
+  in
+  let uvars = List.fold_left uvars_fold Univ.LSet.empty (Option.List.cons tyopt [c]) in
+  let evd = Evd.restrict_universe_context evd uvars in
+  (* Check we conform to declared universes *)
+  let uctx = Evd.check_univ_decl ~poly evd decl in
+  (* We're done! *)
+  let ce = definition_entry ?types:tyopt ~univs:uctx c in
+  (red_constant_entry (Context.Rel.length ctx) ce evd red_option, evd, decl, imps)
+
+let check_definition (ce, evd, _, imps) =
+  check_evars_are_solved (Global.env ()) evd Evd.empty;
+  ce
+
+let do_definition ~program_mode ident k univdecl bl red_option c ctypopt hook =
+  let (ce, evd, univdecl, imps as def) =
+    interp_definition univdecl bl (pi2 k) red_option c ctypopt
+  in
+    if program_mode then
+      let env = Global.env () in
+      let (c,ctx), sideff = Future.force ce.const_entry_body in
+      assert(Safe_typing.empty_private_constants = sideff);
+      assert(Univ.ContextSet.is_empty ctx);
+      let typ = match ce.const_entry_type with
+        | Some t -> t
+        | None -> EConstr.to_constr evd (Retyping.get_type_of env evd (EConstr.of_constr c))
+      in
+      Obligations.check_evars env evd;
+      let obls, _, c, cty =
+        Obligations.eterm_obligations env ident evd 0 c typ
+      in
+      let ctx = Evd.evar_universe_context evd in
+      let hook = Lemmas.mk_hook (fun l r _ -> Lemmas.call_hook (fun exn -> exn) hook l r) in
+      ignore(Obligations.add_definition
+          ident ~term:c cty ctx ~univdecl ~implicits:imps ~kind:k ~hook obls)
+    else let ce = check_definition def in
+      ignore(DeclareDef.declare_definition ident k ce (Evd.universe_binders evd) imps
+        (Lemmas.mk_hook
+          (fun l r -> Lemmas.call_hook (fun exn -> exn) hook l r;r)))
diff --git a/vernac/comDefinition.mli b/vernac/comDefinition.mli
new file mode 100644
index 000000000..4a65c1e91
--- /dev/null
+++ b/vernac/comDefinition.mli
@@ -0,0 +1,30 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2018     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Names
+open Entries
+open Decl_kinds
+open Redexpr
+open Constrexpr
+
+(** {6 Definitions/Let} *)
+
+val do_definition : program_mode:bool ->
+  Id.t -> definition_kind -> Vernacexpr.universe_decl_expr option ->
+  local_binder_expr list -> red_expr option -> constr_expr ->
+  constr_expr option -> unit Lemmas.declaration_hook -> unit
+
+(************************************************************************)
+(** Internal API  *)
+(************************************************************************)
+
+(** Not used anywhere. *)
+val interp_definition :
+  Vernacexpr.universe_decl_expr option -> local_binder_expr list -> polymorphic -> red_expr option -> constr_expr ->
+  constr_expr option -> Safe_typing.private_constants definition_entry * Evd.evar_map *
+                        Univdecls.universe_decl * Impargs.manual_implicits
diff --git a/vernac/comFixpoint.ml b/vernac/comFixpoint.ml
new file mode 100644
index 000000000..489f299a2
--- /dev/null
+++ b/vernac/comFixpoint.ml
@@ -0,0 +1,356 @@
+open Pp
+open CErrors
+open Util
+open Constr
+open Vars
+open Termops
+open Declare
+open Names
+open Constrexpr
+open Constrexpr_ops
+open Constrintern
+open Decl_kinds
+open Pretyping
+open Evarutil
+open Evarconv
+open Misctypes
+open Vernacexpr
+
+module RelDecl = Context.Rel.Declaration
+
+(* 3c| Fixpoints and co-fixpoints *)
+
+(* An (unoptimized) function that maps preorders to partial orders...
+
+   Input:  a list of associations (x,[y1;...;yn]), all yi distincts
+           and different of x, meaning x<=y1, ..., x<=yn
+
+   Output: a list of associations (x,Inr [y1;...;yn]), collecting all
+           distincts yi greater than x, _or_, (x, Inl y) meaning that
+           x is in the same class as y (in which case, x occurs
+           nowhere else in the association map)
+
+   partial_order : ('a * 'a list) list -> ('a * ('a,'a list) union) list
+*)
+
+let rec partial_order cmp = function
+  | [] -> []
+  | (x,xge)::rest ->
+    let rec browse res xge' = function
+    | [] ->
+        let res = List.map (function
+          | (z, Inr zge) when List.mem_f cmp x zge ->
+            (z, Inr (List.union cmp zge xge'))
+          | r -> r) res in
+        (x,Inr xge')::res
+    | y::xge ->
+      let rec link y =
+        try match List.assoc_f cmp y res with
+        | Inl z -> link z
+        | Inr yge ->
+          if List.mem_f cmp x yge then
+            let res = List.remove_assoc_f cmp y res in
+            let res = List.map (function
+              | (z, Inl t) ->
+                  if cmp t y then (z, Inl x) else (z, Inl t)
+              | (z, Inr zge) ->
+                  if List.mem_f cmp y zge then
+                    (z, Inr (List.add_set cmp x (List.remove cmp y zge)))
+                  else
+                    (z, Inr zge)) res in
+            browse ((y,Inl x)::res) xge' (List.union cmp xge (List.remove cmp x yge))
+          else
+            browse res (List.add_set cmp y (List.union cmp xge' yge)) xge
+        with Not_found -> browse res (List.add_set cmp y xge') xge
+      in link y
+    in browse (partial_order cmp rest) [] xge
+
+let non_full_mutual_message x xge y yge isfix rest =
+  let reason =
+    if Id.List.mem x yge then
+      Id.print y ++ str " depends on " ++ Id.print x ++ strbrk " but not conversely"
+    else if Id.List.mem y xge then
+      Id.print x ++ str " depends on " ++ Id.print y ++ strbrk " but not conversely"
+    else
+      Id.print y ++ str " and " ++ Id.print 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 strbrk "Well-foundedness check may fail unexpectedly." ++ fnl()
+    else mt () in
+  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 evd isfix fixl =
+  let names = List.map fst fixl in
+  let preorder =
+    List.map (fun (id,def) ->
+      (id, List.filter (fun id' -> not (Id.equal id id') && occur_var env evd id' (EConstr.of_constr def)) names))
+      fixl in
+  let po = partial_order Id.equal preorder in
+  match List.filter (function (_,Inr _) -> true | _ -> false) po with
+    | (x,Inr xge)::(y,Inr yge)::rest ->
+       warn_non_full_mutual (x,xge,y,yge,isfix,rest)
+    | _ -> ()
+
+type structured_fixpoint_expr = {
+  fix_name : Id.t;
+  fix_univs : universe_decl_expr option;
+  fix_annot : lident option;
+  fix_binders : local_binder_expr list;
+  fix_body : constr_expr option;
+  fix_type : constr_expr
+}
+
+let interp_fix_context ~cofix env sigma fix =
+  let before, after = if not cofix then split_at_annot fix.fix_binders fix.fix_annot else [], fix.fix_binders in
+  let sigma, (impl_env, ((env', ctx), imps)) = interp_context_evars env sigma before in
+  let sigma, (impl_env', ((env'', ctx'), imps')) = interp_context_evars ~impl_env ~shift:(Context.Rel.nhyps ctx) env' sigma after in
+  let annot = Option.map (fun _ -> List.length (assums_of_rel_context ctx)) fix.fix_annot in
+  sigma, ((env'', ctx' @ ctx), (impl_env',imps @ imps'), annot)
+
+let interp_fix_ccl sigma impls (env,_) fix =
+  interp_type_evars_impls ~impls env sigma fix.fix_type
+
+let interp_fix_body env_rec sigma impls (_,ctx) fix ccl =
+  let open EConstr in
+  Option.cata (fun body ->
+    let env = push_rel_context ctx env_rec in
+    let sigma, body = interp_casted_constr_evars env sigma ~impls body ccl in
+    sigma, Some (it_mkLambda_or_LetIn body ctx)) (sigma, None) fix.fix_body
+
+let build_fix_type (_,ctx) ccl = EConstr.it_mkProd_or_LetIn ccl ctx
+
+let prepare_recursive_declaration fixnames fixtypes fixdefs =
+  let defs = List.map (subst_vars (List.rev fixnames)) fixdefs in
+  let names = List.map (fun id -> Name id) fixnames in
+  (Array.of_list names, Array.of_list fixtypes, Array.of_list defs)
+
+(* Jump over let-bindings. *)
+
+let compute_possible_guardness_evidences (ctx,_,recindex) =
+  (* A recursive index is characterized by the number of lambdas to
+     skip before finding the relevant inductive argument *)
+  match recindex with
+  | Some i -> [i]
+  | None ->
+      (* If recursive argument was not given by user, we try all args.
+         An earlier approach was to look only for inductive arguments,
+         but doing it properly involves delta-reduction, and it finally
+         doesn't seem to worth the effort (except for huge mutual
+         fixpoints ?) *)
+      List.interval 0 (Context.Rel.nhyps ctx - 1)
+
+type recursive_preentry =
+  Id.t list * constr option list * types list
+
+(* Wellfounded definition *)
+
+let contrib_name = "Program"
+let subtac_dir = [contrib_name]
+let tactics_module = subtac_dir @ ["Tactics"]
+
+let init_constant dir s sigma =
+  Evarutil.new_global sigma (Coqlib.coq_reference "Command" dir s)
+
+let fix_proto = init_constant tactics_module "fix_proto"
+
+let interp_recursive ~program_mode ~cofix fixl notations =
+  let open Context.Named.Declaration in
+  let open EConstr in
+  let env = Global.env() in
+  let fixnames = List.map (fun fix -> fix.fix_name) fixl in
+
+  (* Interp arities allowing for unresolved types *)
+  let all_universes =
+    List.fold_right (fun sfe acc ->
+        match sfe.fix_univs , acc with
+        | None , acc -> acc
+        | x , None -> x
+        | Some ls , Some us ->
+           let lsu = ls.univdecl_instance and usu = us.univdecl_instance in
+           if not (CList.for_all2eq (fun x y -> Id.equal x.CAst.v y.CAst.v) lsu usu) then
+             user_err Pp.(str "(co)-recursive definitions should all have the same universe binders");
+           Some us) fixl None in
+  let sigma, decl = Univdecls.interp_univ_decl_opt env all_universes in
+  let sigma, (fixctxs, fiximppairs, fixannots) =
+    on_snd List.split3 @@
+      List.fold_left_map (fun sigma -> interp_fix_context env sigma ~cofix) sigma fixl in
+  let fixctximpenvs, fixctximps = List.split fiximppairs in
+  let sigma, (fixccls,fixcclimps) =
+    on_snd List.split @@
+      List.fold_left3_map interp_fix_ccl sigma fixctximpenvs fixctxs fixl in
+  let fixtypes = List.map2 build_fix_type fixctxs fixccls in
+  let fixtypes = List.map (fun c -> nf_evar sigma c) fixtypes in
+  let fiximps = List.map3
+    (fun ctximps cclimps (_,ctx) -> ctximps@(Impargs.lift_implicits (Context.Rel.nhyps ctx) cclimps))
+    fixctximps fixcclimps fixctxs in
+  let sigma, rec_sign =
+    List.fold_left2
+      (fun (sigma, env') id t ->
+         if program_mode then
+           let sigma, sort = Typing.type_of ~refresh:true env sigma t in
+           let sigma, fixprot =
+             try
+               let sigma, h_term = fix_proto sigma in
+               let app = mkApp (h_term, [|sort; t|]) in
+               let _evd = ref sigma in
+               let res = Typing.e_solve_evars env _evd app in
+               !_evd, res
+             with e when CErrors.noncritical e -> sigma, t
+           in
+           sigma, LocalAssum (id,fixprot) :: env'
+         else sigma, LocalAssum (id,t) :: env')
+      (sigma,[]) fixnames fixtypes
+  in
+  let env_rec = push_named_context rec_sign env in
+
+  (* Get interpretation metadatas *)
+  let fixtypes = List.map EConstr.Unsafe.to_constr fixtypes in
+  let impls = compute_internalization_env env Recursive fixnames fixtypes fiximps in
+
+  (* Interp bodies with rollback because temp use of notations/implicit *)
+  let sigma, fixdefs =
+    Metasyntax.with_syntax_protection (fun () ->
+      List.iter (Metasyntax.set_notation_for_interpretation env_rec impls) notations;
+      List.fold_left4_map
+        (fun sigma fixctximpenv -> interp_fix_body env_rec sigma (Id.Map.fold Id.Map.add fixctximpenv impls))
+        sigma fixctximpenvs fixctxs fixl fixccls)
+      () in
+
+  (* Instantiate evars and check all are resolved *)
+  let sigma = solve_unif_constraints_with_heuristics env_rec sigma in
+  let sigma, nf = nf_evars_and_universes sigma in
+  let fixdefs = List.map (fun c -> Option.map EConstr.Unsafe.to_constr c) fixdefs in
+  let fixdefs = List.map (Option.map nf) fixdefs in
+  let fixtypes = List.map nf fixtypes in
+  let fixctxs = List.map (fun (_,ctx) -> ctx) fixctxs in
+
+  (* Build the fix declaration block *)
+  (env,rec_sign,decl,sigma), (fixnames,fixdefs,fixtypes), List.combine3 fixctxs fiximps fixannots
+
+let check_recursive isfix env evd (fixnames,fixdefs,_) =
+  check_evars_are_solved env evd Evd.empty;
+  if List.for_all Option.has_some fixdefs then begin
+    let fixdefs = List.map Option.get fixdefs in
+    check_mutuality env evd isfix (List.combine fixnames fixdefs)
+  end
+
+let interp_fixpoint ~cofix l ntns =
+  let (env,_,pl,evd),fix,info = interp_recursive ~program_mode:false ~cofix l ntns in
+  check_recursive true env evd fix;
+  (fix,pl,Evd.evar_universe_context evd,info)
+
+let declare_fixpoint local poly ((fixnames,fixdefs,fixtypes),pl,ctx,fiximps) indexes ntns =
+  if List.exists Option.is_empty fixdefs then
+    (* Some bodies to define by proof *)
+    let thms =
+      List.map3 (fun id t (ctx,imps,_) -> (id,(EConstr.of_constr t,(List.map RelDecl.get_name ctx,imps))))
+                fixnames fixtypes fiximps in
+    let init_tac =
+      Some (List.map (Option.cata (EConstr.of_constr %> Tactics.exact_no_check) Tacticals.New.tclIDTAC)
+        fixdefs) in
+    let evd = Evd.from_ctx ctx in
+    Lemmas.start_proof_with_initialization (Global,poly,DefinitionBody Fixpoint)
+      evd pl (Some(false,indexes,init_tac)) thms None (Lemmas.mk_hook (fun _ _ -> ()))
+  else begin
+    (* We shortcut the proof process *)
+    let fixdefs = List.map Option.get fixdefs in
+    let fixdecls = prepare_recursive_declaration fixnames fixtypes fixdefs in
+    let env = Global.env() in
+    let indexes = search_guard env indexes fixdecls in
+    let fiximps = List.map (fun (n,r,p) -> r) fiximps in
+    let vars = Univops.universes_of_constr env (mkFix ((indexes,0),fixdecls)) in
+    let fixdecls =
+      List.map_i (fun i _ -> mkFix ((indexes,i),fixdecls)) 0 fixnames in
+    let evd = Evd.from_ctx ctx in
+    let evd = Evd.restrict_universe_context evd vars in
+    let ctx = Evd.check_univ_decl ~poly evd pl in
+    let pl = Evd.universe_binders evd in
+    let fixdecls = List.map Safe_typing.mk_pure_proof fixdecls in
+    ignore (List.map4 (DeclareDef.declare_fix (local, poly, Fixpoint) pl ctx)
+              fixnames fixdecls fixtypes fiximps);
+    (* Declare the recursive definitions *)
+    fixpoint_message (Some indexes) fixnames;
+  end;
+  (* Declare notations *)
+  List.iter (Metasyntax.add_notation_interpretation (Global.env())) ntns
+
+let declare_cofixpoint local poly ((fixnames,fixdefs,fixtypes),pl,ctx,fiximps) ntns =
+  if List.exists Option.is_empty fixdefs then
+    (* Some bodies to define by proof *)
+    let thms =
+      List.map3 (fun id t (ctx,imps,_) -> (id,(EConstr.of_constr t,(List.map RelDecl.get_name ctx,imps))))
+                fixnames fixtypes fiximps in
+    let init_tac =
+      Some (List.map (Option.cata (EConstr.of_constr %> Tactics.exact_no_check) Tacticals.New.tclIDTAC)
+        fixdefs) in
+    let evd = Evd.from_ctx ctx in
+      Lemmas.start_proof_with_initialization (Global,poly, DefinitionBody CoFixpoint)
+      evd pl (Some(true,[],init_tac)) thms None (Lemmas.mk_hook (fun _ _ -> ()))
+  else begin
+    (* We shortcut the proof process *)
+    let fixdefs = List.map Option.get fixdefs in
+    let fixdecls = prepare_recursive_declaration fixnames fixtypes fixdefs in
+    let fixdecls = List.map_i (fun i _ -> mkCoFix (i,fixdecls)) 0 fixnames in
+    let env = Global.env () in
+    let vars = Univops.universes_of_constr env (List.hd fixdecls) in
+    let fixdecls = List.map Safe_typing.mk_pure_proof fixdecls in
+    let fiximps = List.map (fun (len,imps,idx) -> imps) fiximps in
+    let evd = Evd.from_ctx ctx in
+    let evd = Evd.restrict_universe_context evd vars in
+    let ctx = Evd.check_univ_decl ~poly evd pl in
+    let pl = Evd.universe_binders evd in
+    ignore (List.map4 (DeclareDef.declare_fix (local, poly, CoFixpoint) pl ctx)
+              fixnames fixdecls fixtypes fiximps);
+    (* Declare the recursive definitions *)
+    cofixpoint_message fixnames
+  end;
+  (* Declare notations *)
+  List.iter (Metasyntax.add_notation_interpretation (Global.env())) ntns
+
+let extract_decreasing_argument limit = function
+  | (na,CStructRec) -> na
+  | (na,_) when not limit -> na
+  | _ -> user_err Pp.(str
+      "Only structural decreasing is supported for a non-Program Fixpoint")
+
+let extract_fixpoint_components limit l =
+  let fixl, ntnl = List.split l in
+  let fixl = List.map (fun (({CAst.v=id},pl),ann,bl,typ,def) ->
+    let ann = extract_decreasing_argument limit ann in
+      {fix_name = id; fix_annot = ann; fix_univs = pl;
+       fix_binders = bl; fix_body = def; fix_type = typ}) fixl in
+  fixl, List.flatten ntnl
+
+let extract_cofixpoint_components l =
+  let fixl, ntnl = List.split l in
+  List.map (fun (({CAst.v=id},pl),bl,typ,def) ->
+            {fix_name = id; fix_annot = None; fix_univs = pl;
+             fix_binders = bl; fix_body = def; fix_type = typ}) fixl,
+  List.flatten ntnl
+
+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 =
+  let fixl, ntns = extract_fixpoint_components true l in
+  let (_, _, _, info as fix) = interp_fixpoint ~cofix:false fixl ntns in
+  let possible_indexes =
+    List.map compute_possible_guardness_evidences info in
+  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
+  let cofix = interp_fixpoint ~cofix:true fixl ntns in
+  declare_cofixpoint local poly cofix ntns;
+  if not (check_safe ()) then Feedback.feedback Feedback.AddedAxiom else ()
diff --git a/vernac/comFixpoint.mli b/vernac/comFixpoint.mli
new file mode 100644
index 000000000..2926e30e5
--- /dev/null
+++ b/vernac/comFixpoint.mli
@@ -0,0 +1,93 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2018     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Names
+open Constr
+open Decl_kinds
+open Constrexpr
+open Vernacexpr
+
+(** {6 Fixpoints and cofixpoints} *)
+
+(** 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
+
+(************************************************************************)
+(** Internal API  *)
+(************************************************************************)
+
+type structured_fixpoint_expr = {
+  fix_name : Id.t;
+  fix_univs : Vernacexpr.universe_decl_expr option;
+  fix_annot : Misctypes.lident option;
+  fix_binders : local_binder_expr list;
+  fix_body : constr_expr option;
+  fix_type : constr_expr
+}
+
+(** Typing global fixpoints and cofixpoint_expr *)
+
+(** Exported for Program *)
+val interp_recursive :
+  (* Misc arguments *)
+  program_mode:bool -> cofix:bool ->
+  (* Notations of the fixpoint / should that be folded in the previous argument? *)
+  structured_fixpoint_expr list -> decl_notation list ->
+
+  (* env / signature / univs / evar_map *)
+  (Environ.env * EConstr.named_context * Univdecls.universe_decl * Evd.evar_map) *
+  (* names / defs / types *)
+  (Id.t list * Constr.constr option list * Constr.types list) *
+  (* ctx per mutual def / implicits / struct annotations *)
+  (EConstr.rel_context * Impargs.manual_explicitation list * int option) list
+
+(** Exported for Funind *)
+
+(** Extracting the semantical components out of the raw syntax of
+   (co)fixpoints declarations *)
+
+val extract_fixpoint_components : bool ->
+  (fixpoint_expr * decl_notation list) list ->
+    structured_fixpoint_expr list * decl_notation list
+
+val extract_cofixpoint_components :
+  (cofixpoint_expr * decl_notation list) list ->
+    structured_fixpoint_expr list * decl_notation list
+
+type recursive_preentry =
+  Id.t list * constr option list * types list
+
+val interp_fixpoint :
+  cofix:bool ->
+  structured_fixpoint_expr list -> decl_notation list ->
+  recursive_preentry * Univdecls.universe_decl * UState.t *
+  (EConstr.rel_context * Impargs.manual_implicits * int option) list
+
+(** Registering fixpoints and cofixpoints in the environment *)
+(** [Not used so far] *)
+val declare_fixpoint :
+  locality -> polymorphic ->
+  recursive_preentry * Univdecls.universe_decl * UState.t *
+  (Context.Rel.t * Impargs.manual_implicits * int option) list ->
+  Proof_global.lemma_possible_guards -> decl_notation list -> unit
+
+val declare_cofixpoint : locality -> polymorphic ->
+  recursive_preentry * Univdecls.universe_decl * UState.t *
+  (Context.Rel.t * Impargs.manual_implicits * int option) list ->
+  decl_notation list -> unit
+
+(** Very private function, do not use *)
+val compute_possible_guardness_evidences :
+  ('a, 'b) Context.Rel.pt * 'c * int option -> int list
diff --git a/vernac/comInductive.ml b/vernac/comInductive.ml
new file mode 100644
index 000000000..c650e9e40
--- /dev/null
+++ b/vernac/comInductive.ml
@@ -0,0 +1,455 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Pp
+open CErrors
+open Sorts
+open Util
+open Constr
+open Termops
+open Environ
+open Declare
+open Names
+open Libnames
+open Globnames
+open Nameops
+open Constrexpr
+open Constrexpr_ops
+open Constrintern
+open Nametab
+open Impargs
+open Reductionops
+open Indtypes
+open Pretyping
+open Evarutil
+open Indschemes
+open Misctypes
+open Context.Rel.Declaration
+open Entries
+
+module RelDecl = Context.Rel.Declaration
+
+(* 3b| Mutual inductive definitions *)
+
+let rec complete_conclusion a cs = CAst.map_with_loc (fun ?loc -> function
+  | CProdN (bl,c) -> CProdN (bl,complete_conclusion a cs c)
+  | CLetIn (na,b,t,c) -> CLetIn (na,b,t,complete_conclusion a cs c)
+  | CHole (k, _, _) ->
+      let (has_no_args,name,params) = a in
+      if not has_no_args then
+        user_err ?loc
+         (strbrk"Cannot infer the non constant arguments of the conclusion of "
+          ++ Id.print cs ++ str ".");
+      let args = List.map (fun id -> CAst.make ?loc @@ CRef(Ident(loc,id),None)) params in
+      CAppExpl ((None,Ident(loc,name),None),List.rev args)
+  | c -> c
+  )
+
+let push_types env idl tl =
+  List.fold_left2 (fun env id t -> Environ.push_rel (LocalAssum (Name id,t)) env)
+    env idl tl
+
+type structured_one_inductive_expr = {
+  ind_name : Id.t;
+  ind_univs : Vernacexpr.universe_decl_expr option;
+  ind_arity : constr_expr;
+  ind_lc : (Id.t * constr_expr) list
+}
+
+type structured_inductive_expr =
+  local_binder_expr list * structured_one_inductive_expr list
+
+let minductive_message warn = function
+  | []  -> user_err Pp.(str "No inductive definition.")
+  | [x] -> (Id.print x ++ str " is defined" ++
+            if warn then str " as a non-primitive record" else mt())
+  | l   -> hov 0  (prlist_with_sep pr_comma Id.print l ++
+                     spc () ++ str "are defined")
+
+let check_all_names_different indl =
+  let ind_names = List.map (fun ind -> ind.ind_name) indl in
+  let cstr_names = List.map_append (fun ind -> List.map fst ind.ind_lc) indl in
+  let l = List.duplicates Id.equal ind_names in
+  let () = match l with
+  | [] -> ()
+  | t :: _ -> raise (InductiveError (SameNamesTypes t))
+  in
+  let l = List.duplicates Id.equal cstr_names in
+  let () = match l with
+  | [] -> ()
+  | c :: _ -> raise (InductiveError (SameNamesConstructors (List.hd l)))
+  in
+  let l = List.intersect Id.equal ind_names cstr_names in
+  match l with
+  | [] -> ()
+  | _ -> raise (InductiveError (SameNamesOverlap l))
+
+let mk_mltype_data sigma env assums arity indname =
+  let is_ml_type = is_sort env sigma (EConstr.of_constr arity) in
+  (is_ml_type,indname,assums)
+
+let prepare_param = function
+  | LocalAssum (na,t) -> Name.get_id na, LocalAssumEntry t
+  | LocalDef (na,b,_) -> Name.get_id na, LocalDefEntry b
+
+(** Make the arity conclusion flexible to avoid generating an upper bound universe now,
+    only if the universe does not appear anywhere else.
+    This is really a hack to stay compatible with the semantics of template polymorphic
+    inductives which are recognized when a "Type" appears at the end of the conlusion in
+    the source syntax. *)
+
+let rec check_anonymous_type ind =
+  let open Glob_term in
+    match DAst.get ind with
+    | GSort (GType []) -> true
+    | GProd ( _, _, _, e)
+    | GLetIn (_, _, _, e)
+    | GLambda (_, _, _, e)
+    | GApp (e, _)
+    | GCast (e, _) -> check_anonymous_type e
+    | _ -> false
+
+let make_conclusion_flexible sigma ty poly =
+  if poly && Term.isArity ty then
+    let _, concl = Term.destArity ty in
+      match concl with
+      | Type u ->
+        (match Univ.universe_level u with
+        | Some u ->
+          Evd.make_flexible_variable sigma ~algebraic:true u
+        | None -> sigma)
+      | _ -> sigma
+  else sigma
+
+let is_impredicative env u =
+  u = Prop Null || (is_impredicative_set env && u = Prop Pos)
+
+let interp_ind_arity env sigma ind =
+  let c = intern_gen IsType env ind.ind_arity in
+  let impls = Implicit_quantifiers.implicits_of_glob_constr ~with_products:true c in
+  let sigma,t = understand_tcc env sigma ~expected_type:IsType c in
+  let pseudo_poly = check_anonymous_type c in
+  let () = if not (Reductionops.is_arity env sigma t) then
+    user_err ?loc:(constr_loc ind.ind_arity) (str "Not an arity")
+  in
+  let t = EConstr.Unsafe.to_constr t in
+  sigma, (t, pseudo_poly, impls)
+
+let interp_cstrs env sigma impls mldata arity ind =
+  let cnames,ctyps = List.split ind.ind_lc in
+  (* Complete conclusions of constructor types if given in ML-style syntax *)
+  let ctyps' = List.map2 (complete_conclusion mldata) cnames ctyps in
+  (* Interpret the constructor types *)
+  let sigma, (ctyps'', cimpls) =
+    on_snd List.split @@
+    List.fold_left_map (fun sigma l ->
+        on_snd (on_fst EConstr.Unsafe.to_constr) @@
+        interp_type_evars_impls env sigma ~impls l) sigma ctyps' in
+  sigma, (cnames, ctyps'', cimpls)
+
+let sign_level env evd sign =
+  fst (List.fold_right
+    (fun d (lev,env) ->
+      match d with
+      | LocalDef _ -> lev, push_rel d env
+      | LocalAssum _ ->
+        let s = destSort (Reduction.whd_all env
+                            (EConstr.Unsafe.to_constr (nf_evar evd (Retyping.get_type_of env evd (EConstr.of_constr (RelDecl.get_type d))))))
+        in
+        let u = univ_of_sort s in
+          (Univ.sup u lev, push_rel d env))
+    sign (Univ.type0m_univ,env))
+
+let sup_list min = List.fold_left Univ.sup min
+
+let extract_level env evd min tys =
+  let sorts = List.map (fun ty ->
+    let ctx, concl = Reduction.dest_prod_assum env ty in
+      sign_level env evd (LocalAssum (Anonymous, concl) :: ctx)) tys
+  in sup_list min sorts
+
+let is_flexible_sort evd u =
+  match Univ.Universe.level u with
+  | Some l -> Evd.is_flexible_level evd l
+  | None -> false
+
+let inductive_levels env evd poly arities inds =
+  let destarities = List.map (fun x -> x, Reduction.dest_arity env x) arities in
+  let levels = List.map (fun (x,(ctx,a)) ->
+    if a = Prop Null then None
+    else Some (univ_of_sort a)) destarities
+  in
+  let cstrs_levels, min_levels, sizes =
+    CList.split3
+      (List.map2 (fun (_,tys,_) (arity,(ctx,du)) ->
+        let len = List.length tys in
+        let minlev = Sorts.univ_of_sort du in
+        let minlev =
+          if len > 1 && not (is_impredicative env du) then
+            Univ.sup minlev Univ.type0_univ
+          else minlev
+        in
+        let minlev =
+          (** Indices contribute. *)
+          if Indtypes.is_indices_matter () && List.length ctx > 0 then (
+            let ilev = sign_level env evd ctx in
+              Univ.sup ilev minlev)
+          else minlev
+        in
+        let clev = extract_level env evd minlev tys in
+          (clev, minlev, len)) inds destarities)
+  in
+  (* Take the transitive closure of the system of constructors *)
+  (* level constraints and remove the recursive dependencies *)
+  let levels' = Universes.solve_constraints_system (Array.of_list levels)
+    (Array.of_list cstrs_levels) (Array.of_list min_levels)
+  in
+  let evd, arities =
+    CList.fold_left3 (fun (evd, arities) cu (arity,(ctx,du)) len ->
+      if is_impredicative env du then
+        (** Any product is allowed here. *)
+        evd, arity :: arities
+      else (** If in a predicative sort, or asked to infer the type,
+               we take the max of:
+               - indices (if in indices-matter mode)
+               - constructors
+               - Type(1) if there is more than 1 constructor
+           *)
+        (** Constructors contribute. *)
+        let evd =
+          if Sorts.is_set du then
+            if not (Evd.check_leq evd cu Univ.type0_univ) then
+              raise (Indtypes.InductiveError Indtypes.LargeNonPropInductiveNotInType)
+            else evd
+          else evd
+            (* Evd.set_leq_sort env evd (Type cu) du *)
+        in
+        let evd =
+          if len >= 2 && Univ.is_type0m_univ cu then
+           (** "Polymorphic" type constraint and more than one constructor,
+               should not land in Prop. Add constraint only if it would
+               land in Prop directly (no informative arguments as well). *)
+            Evd.set_leq_sort env evd (Prop Pos) du
+          else evd
+        in
+        let duu = Sorts.univ_of_sort du in
+        let evd =
+          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
+          (evd, arity :: arities))
+    (evd,[]) (Array.to_list levels') destarities sizes
+  in evd, List.rev arities
+
+let check_named {CAst.loc;v=na} = match na with
+| Name _ -> ()
+| Anonymous ->
+  let msg = str "Parameters must be named." in
+  user_err ?loc  msg
+
+
+let check_param = function
+| CLocalDef (na, _, _) -> check_named na
+| CLocalAssum (nas, Default _, _) -> List.iter check_named nas
+| CLocalAssum (nas, Generalized _, _) -> ()
+| CLocalPattern {CAst.loc} ->
+    Loc.raise ?loc (Stream.Error "pattern with quote not allowed here.")
+
+let interp_mutual_inductive (paramsl,indl) notations cum poly prv finite =
+  check_all_names_different indl;
+  List.iter check_param paramsl;
+  let env0 = Global.env() in
+  let pl = (List.hd indl).ind_univs in
+  let sigma, decl = Univdecls.interp_univ_decl_opt env0 pl in
+  let sigma, (impls, ((env_params, ctx_params), userimpls)) =
+    interp_context_evars env0 sigma paramsl
+  in
+  let ctx_params = List.map (fun d -> map_rel_decl EConstr.Unsafe.to_constr d) ctx_params in
+  let indnames = List.map (fun ind -> ind.ind_name) indl in
+
+  (* 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 (RelDecl.get_name %> Name.get_id) assums in
+
+  (* Interpret the arities *)
+  let sigma, arities = List.fold_left_map (fun sigma -> interp_ind_arity env_params sigma) sigma indl in
+
+  let fullarities = List.map (fun (c, _, _) -> Term.it_mkProd_or_LetIn c ctx_params) arities in
+  let env_ar = push_types env0 indnames fullarities in
+  let env_ar_params = push_rel_context ctx_params env_ar in
+
+  (* Compute interpretation metadatas *)
+  let indimpls = List.map (fun (_, _, impls) -> userimpls @
+    lift_implicits (Context.Rel.nhyps ctx_params) impls) arities in
+  let arities = List.map pi1 arities and aritypoly = List.map pi2 arities in
+  let impls = compute_internalization_env env0 ~impls (Inductive (params,true)) indnames fullarities indimpls in
+  let ntn_impls = compute_internalization_env env0 (Inductive (params,true)) indnames fullarities indimpls in
+  let mldatas = List.map2 (mk_mltype_data sigma env_params params) arities indnames in
+
+  let sigma, constructors =
+    Metasyntax.with_syntax_protection (fun () ->
+     (* Temporary declaration of notations and scopes *)
+     List.iter (Metasyntax.set_notation_for_interpretation env_params ntn_impls) notations;
+     (* Interpret the constructor types *)
+     List.fold_left3_map (fun sigma -> interp_cstrs env_ar_params sigma impls) sigma mldatas arities indl)
+     () in
+
+  (* Try further to solve evars, and instantiate them *)
+  let sigma = solve_remaining_evars all_and_fail_flags env_params sigma Evd.empty in
+  (* Compute renewed arities *)
+  let sigma, nf = nf_evars_and_universes sigma in
+  let arities = List.map nf arities in
+  let constructors = List.map (fun (idl,cl,impsl) -> (idl,List.map nf cl,impsl)) constructors in
+  let sigma = List.fold_left2 (fun sigma ty poly -> make_conclusion_flexible sigma ty poly) sigma arities aritypoly in
+  let sigma, arities = inductive_levels env_ar_params sigma poly arities constructors in
+  let sigma, nf' = nf_evars_and_universes sigma in
+  let nf x = nf' (nf x) in
+  let arities = List.map nf' arities in
+  let constructors = List.map (fun (idl,cl,impsl) -> (idl,List.map nf' cl,impsl)) constructors in
+  let ctx_params = Context.Rel.map nf ctx_params in
+  let uctx = Evd.check_univ_decl ~poly sigma decl in
+  List.iter (fun c -> check_evars env_params Evd.empty sigma (EConstr.of_constr c)) arities;
+  Context.Rel.iter (fun c -> check_evars env0 Evd.empty sigma (EConstr.of_constr c)) ctx_params;
+  List.iter (fun (_,ctyps,_) ->
+    List.iter (fun c -> check_evars env_ar_params Evd.empty sigma (EConstr.of_constr c)) ctyps)
+    constructors;
+
+  (* Build the inductive entries *)
+  let entries = List.map4 (fun ind arity template (cnames,ctypes,cimpls) -> {
+    mind_entry_typename = ind.ind_name;
+    mind_entry_arity = arity;
+    mind_entry_template = template;
+    mind_entry_consnames = cnames;
+    mind_entry_lc = ctypes
+  }) indl arities aritypoly constructors in
+  let impls =
+    let len = Context.Rel.nhyps ctx_params in
+      List.map2 (fun indimpls (_,_,cimpls) ->
+        indimpls, List.map (fun impls ->
+          userimpls @ (lift_implicits len impls)) cimpls) indimpls constructors
+  in
+  let univs =
+    match uctx with
+    | Polymorphic_const_entry uctx ->
+      if cum then
+        Cumulative_ind_entry (Univ.CumulativityInfo.from_universe_context uctx)
+      else Polymorphic_ind_entry uctx
+    | Monomorphic_const_entry uctx ->
+      Monomorphic_ind_entry uctx
+  in
+  (* Build the mutual inductive entry *)
+  let mind_ent =
+    { mind_entry_params = List.map prepare_param ctx_params;
+      mind_entry_record = None;
+      mind_entry_finite = finite;
+      mind_entry_inds = entries;
+      mind_entry_private = if prv then Some false else None;
+      mind_entry_universes = univs;
+    }
+  in
+  (if poly && cum then
+      InferCumulativity.infer_inductive env_ar mind_ent
+   else mind_ent), Evd.universe_binders sigma, impls
+
+(* Very syntactical equality *)
+let eq_local_binders bl1 bl2 =
+  List.equal local_binder_eq bl1 bl2
+
+let extract_coercions indl =
+  let mkqid (_,({CAst.v=id},_)) = qualid_of_ident id in
+  let extract lc = List.filter (fun (iscoe,_) -> iscoe) lc in
+  List.map mkqid (List.flatten(List.map (fun (_,_,_,lc) -> extract lc) indl))
+
+let extract_params indl =
+  let paramsl = List.map (fun (_,params,_,_) -> params) indl in
+  match paramsl with
+  | [] -> anomaly (Pp.str "empty list of inductive types.")
+  | params::paramsl ->
+      if not (List.for_all (eq_local_binders params) paramsl) then user_err Pp.(str
+        "Parameters should be syntactically the same for each inductive type.");
+      params
+
+let extract_inductive indl =
+  List.map (fun (({CAst.v=indname},pl),_,ar,lc) -> {
+    ind_name = indname; ind_univs = pl;
+    ind_arity = Option.cata (fun x -> x) (CAst.make @@ CSort (GType [])) ar;
+    ind_lc = List.map (fun (_,({CAst.v=id},t)) -> (id,t)) lc
+  }) indl
+
+let extract_mutual_inductive_declaration_components indl =
+  let indl,ntnl = List.split indl in
+  let params = extract_params indl in
+  let coes = extract_coercions indl in
+  let indl = extract_inductive indl in
+  (params,indl), coes, List.flatten ntnl
+
+let is_recursive mie =
+  let rec is_recursive_constructor lift typ =
+    match Constr.kind typ with
+    | Prod (_,arg,rest) ->
+        not (EConstr.Vars.noccurn Evd.empty (** FIXME *) lift (EConstr.of_constr arg)) ||
+        is_recursive_constructor (lift+1) rest
+    | LetIn (na,b,t,rest) -> is_recursive_constructor (lift+1) rest
+    | _ -> false
+  in
+  match mie.mind_entry_inds with
+  | [ind] ->
+      let nparams = List.length mie.mind_entry_params in
+      List.exists (fun t -> is_recursive_constructor (nparams+1) t) ind.mind_entry_lc
+  | _ -> false
+
+let declare_mutual_inductive_with_eliminations mie pl impls =
+  (* spiwack: raises an error if the structure is supposed to be non-recursive,
+        but isn't *)
+  begin match mie.mind_entry_finite with
+  | Declarations.BiFinite when is_recursive mie ->
+      if Option.has_some mie.mind_entry_record then
+        user_err Pp.(str "Records declared with the keywords Record or Structure cannot be recursive. You can, however, define recursive records using the Inductive or CoInductive command.")
+      else
+        user_err Pp.(str ("Types declared with the keyword Variant cannot be recursive. Recursive types are defined with the Inductive and CoInductive command."))
+  | _ -> ()
+  end;
+  let names = List.map (fun e -> e.mind_entry_typename) mie.mind_entry_inds in
+  let (_, kn), prim = declare_mind mie in
+  let mind = Global.mind_of_delta_kn kn in
+  List.iteri (fun i (indimpls, constrimpls) ->
+              let ind = (mind,i) in
+              let gr = IndRef ind in
+              maybe_declare_manual_implicits false gr indimpls;
+              Declare.declare_univ_binders gr pl;
+              List.iteri
+                (fun j impls ->
+                 maybe_declare_manual_implicits false
+                    (ConstructRef (ind, succ j)) impls)
+                constrimpls)
+      impls;
+  let warn_prim = match mie.mind_entry_record with Some (Some _) -> not prim | _ -> false in
+  Flags.if_verbose Feedback.msg_info (minductive_message warn_prim names);
+  if mie.mind_entry_private == None
+  then declare_default_schemes mind;
+  mind
+
+type one_inductive_impls =
+  Impargs.manual_explicitation list (* for inds *)*
+  Impargs.manual_explicitation list list (* for constrs *)
+
+let do_mutual_inductive indl cum poly prv finite =
+  let indl,coes,ntns = extract_mutual_inductive_declaration_components indl in
+  (* Interpret the types *)
+  let mie,pl,impls = interp_mutual_inductive indl ntns cum poly prv finite in
+  (* Declare the mutual inductive block with its associated schemes *)
+  ignore (declare_mutual_inductive_with_eliminations mie pl impls);
+  (* Declare the possible notations of inductive types *)
+  List.iter (Metasyntax.add_notation_interpretation (Global.env ())) ntns;
+  (* Declare the coercions *)
+  List.iter (fun qid -> Class.try_add_new_coercion (locate qid) ~local:false poly) coes;
+  (* If positivity is assumed declares itself as unsafe. *)
+  if Environ.deactivated_guard (Global.env ()) then Feedback.feedback Feedback.AddedAxiom else ()
diff --git a/vernac/comInductive.mli b/vernac/comInductive.mli
new file mode 100644
index 000000000..82ea131e1
--- /dev/null
+++ b/vernac/comInductive.mli
@@ -0,0 +1,65 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+open Names
+open Entries
+open Libnames
+open Vernacexpr
+open Constrexpr
+open Decl_kinds
+
+(** {6 Inductive and coinductive types} *)
+
+(** Entry points for the vernacular commands Inductive and CoInductive *)
+
+val do_mutual_inductive :
+  (one_inductive_expr * decl_notation list) list -> cumulative_inductive_flag ->
+  polymorphic -> private_flag -> Declarations.recursivity_kind -> unit
+
+(************************************************************************)
+(** Internal API  *)
+(************************************************************************)
+
+(** Exported for Record and Funind *)
+
+(** Registering a mutual inductive definition together with its
+   associated schemes *)
+
+type one_inductive_impls =
+  Impargs.manual_implicits (** for inds *)*
+  Impargs.manual_implicits list (** for constrs *)
+
+val declare_mutual_inductive_with_eliminations :
+  mutual_inductive_entry -> Universes.universe_binders -> one_inductive_impls list ->
+  MutInd.t
+
+(** Exported for Funind *)
+
+(** Extracting the semantical components out of the raw syntax of mutual
+   inductive declarations *)
+
+type structured_one_inductive_expr = {
+  ind_name : Id.t;
+  ind_univs : Vernacexpr.universe_decl_expr option;
+  ind_arity : constr_expr;
+  ind_lc : (Id.t * constr_expr) list
+}
+
+type structured_inductive_expr =
+  local_binder_expr list * structured_one_inductive_expr list
+
+val extract_mutual_inductive_declaration_components :
+  (one_inductive_expr * decl_notation list) list ->
+    structured_inductive_expr * (*coercions:*) qualid list * decl_notation list
+
+(** Typing mutual inductive definitions *)
+
+val interp_mutual_inductive :
+  structured_inductive_expr -> decl_notation list -> cumulative_inductive_flag ->
+  polymorphic -> private_flag -> Declarations.recursivity_kind ->
+  mutual_inductive_entry * Universes.universe_binders * one_inductive_impls list
diff --git a/vernac/comProgramFixpoint.ml b/vernac/comProgramFixpoint.ml
new file mode 100644
index 000000000..af34f8b29
--- /dev/null
+++ b/vernac/comProgramFixpoint.ml
@@ -0,0 +1,342 @@
+open Pp
+open CErrors
+open Util
+open Constr
+open Entries
+open Vars
+open Declare
+open Names
+open Libnames
+open Globnames
+open Nameops
+open Constrexpr
+open Constrexpr_ops
+open Constrintern
+open Decl_kinds
+open Evarutil
+open Context.Rel.Declaration
+open ComFixpoint
+
+module RelDecl = Context.Rel.Declaration
+
+(* Wellfounded definition *)
+
+open Coqlib
+
+let contrib_name = "Program"
+let subtac_dir = [contrib_name]
+let fixsub_module = subtac_dir @ ["Wf"]
+(* let tactics_module = subtac_dir @ ["Tactics"] *)
+
+let init_reference dir s () = Coqlib.coq_reference "Command" dir s
+let init_constant dir s sigma =
+  Evarutil.new_global sigma (Coqlib.coq_reference "Command" dir s)
+
+let make_ref l s = init_reference l s
+(* let fix_proto = init_constant tactics_module "fix_proto" *)
+let fix_sub_ref = make_ref fixsub_module "Fix_sub"
+let measure_on_R_ref = make_ref fixsub_module "MR"
+let well_founded = init_constant ["Init"; "Wf"] "well_founded"
+let mkSubset sigma name typ prop =
+  let open EConstr in
+  let sigma, app_h = Evarutil.new_global sigma (delayed_force build_sigma).typ in
+  sigma, mkApp (app_h, [| typ; mkLambda (name, typ, prop) |])
+
+let sigT = Lazy.from_fun build_sigma_type
+
+let make_qref s = Qualid (Loc.tag @@ qualid_of_string s)
+let lt_ref = make_qref "Init.Peano.lt"
+
+let rec telescope sigma l =
+  let open EConstr in
+  let open Vars in
+  match l with
+  | [] -> assert false
+  | [LocalAssum (n, t)] ->
+    sigma, t, [LocalDef (n, mkRel 1, t)], mkRel 1
+  | LocalAssum (n, t) :: tl ->
+      let sigma, ty, tys, (k, constr) =
+        List.fold_left
+          (fun (sigma, ty, tys, (k, constr)) decl ->
+            let t = RelDecl.get_type decl in
+            let pred = mkLambda (RelDecl.get_name decl, t, ty) in
+            let sigma, ty = Evarutil.new_global sigma (Lazy.force sigT).typ in
+            let sigma, intro = Evarutil.new_global sigma (Lazy.force sigT).intro in
+            let sigty = mkApp (ty, [|t; pred|]) in
+            let intro = mkApp (intro, [|lift k t; lift k pred; mkRel k; constr|]) in
+              (sigma, sigty, pred :: tys, (succ k, intro)))
+          (sigma, t, [], (2, mkRel 1)) tl
+      in
+      let sigma, last, subst = List.fold_right2
+        (fun pred decl (sigma, prev, subst) ->
+          let t = RelDecl.get_type decl in
+          let sigma, p1 = Evarutil.new_global sigma (Lazy.force sigT).proj1 in
+          let sigma, p2 = Evarutil.new_global sigma (Lazy.force sigT).proj2 in
+          let proj1 = applist (p1, [t; pred; prev]) in
+          let proj2 = applist (p2, [t; pred; prev]) in
+            (sigma, lift 1 proj2, LocalDef (get_name decl, proj1, t) :: subst))
+        (List.rev tys) tl (sigma, mkRel 1, [])
+      in sigma, ty, (LocalDef (n, last, t) :: subst), constr
+
+  | LocalDef (n, b, t) :: tl ->
+    let sigma, ty, subst, term = telescope sigma tl in
+    sigma, ty, (LocalDef (n, b, t) :: subst), lift 1 term
+
+let nf_evar_context sigma ctx =
+  List.map (map_constr (fun c -> Evarutil.nf_evar sigma c)) ctx
+
+let build_wellfounded (recname,pl,n,bl,arityc,body) poly r measure notation =
+  let open EConstr in
+  let open Vars in
+  let lift_rel_context n l = Termops.map_rel_context_with_binders (liftn n) l in
+  Coqlib.check_required_library ["Coq";"Program";"Wf"];
+  let env = Global.env() in
+  let sigma, decl = Univdecls.interp_univ_decl_opt env pl in
+  let sigma, (_, ((env', binders_rel), impls)) = interp_context_evars env sigma bl in
+  let len = List.length binders_rel in
+  let top_env = push_rel_context binders_rel env in
+  let sigma, top_arity = interp_type_evars top_env sigma arityc in
+  let full_arity = it_mkProd_or_LetIn top_arity binders_rel in
+  let sigma, argtyp, letbinders, make = telescope sigma binders_rel in
+  let argname = Id.of_string "recarg" in
+  let arg = LocalAssum (Name argname, argtyp) in
+  let binders = letbinders @ [arg] in
+  let binders_env = push_rel_context binders_rel env in
+  let sigma, (rel, _) = interp_constr_evars_impls env sigma r in
+  let relty = Typing.unsafe_type_of env sigma rel in
+  let relargty =
+    let error () =
+      user_err ?loc:(constr_loc r)
+               ~hdr:"Command.build_wellfounded"
+                    (Printer.pr_econstr_env env sigma rel ++ str " is not an homogeneous binary relation.")
+    in
+      try
+        let ctx, ar = Reductionops.splay_prod_n env sigma 2 relty in
+          match ctx, EConstr.kind sigma ar with
+          | [LocalAssum (_,t); LocalAssum (_,u)], Sort s
+              when Sorts.is_prop (ESorts.kind sigma s) && Reductionops.is_conv env sigma t u -> t
+          | _, _ -> error ()
+      with e when CErrors.noncritical e -> error ()
+  in
+  let sigma, measure = interp_casted_constr_evars binders_env sigma measure relargty in
+  let sigma, wf_rel, wf_rel_fun, measure_fn =
+    let measure_body, measure =
+      it_mkLambda_or_LetIn measure letbinders,
+      it_mkLambda_or_LetIn measure binders
+    in
+    let sigma, comb = Evarutil.new_global sigma (delayed_force measure_on_R_ref) in
+    let wf_rel = mkApp (comb, [| argtyp; relargty; rel; measure |]) in
+    let wf_rel_fun x y =
+      mkApp (rel, [| subst1 x measure_body;
+                     subst1 y measure_body |])
+    in sigma, wf_rel, wf_rel_fun, measure
+  in
+  let sigma, wf_term = well_founded sigma in
+  let wf_proof = mkApp (wf_term, [| argtyp ; wf_rel |]) in
+  let argid' = Id.of_string (Id.to_string argname ^ "'") in
+  let wfarg sigma len =
+    let sigma, ss_term = mkSubset sigma (Name argid') argtyp (wf_rel_fun (mkRel 1) (mkRel (len + 1))) in
+    sigma, LocalAssum (Name argid', ss_term)
+  in
+  let sigma, intern_bl =
+    let sigma, wfa = wfarg sigma 1 in
+    sigma, wfa :: [arg]
+  in
+  let _intern_env = push_rel_context intern_bl env in
+  let sigma, proj = Evarutil.new_global sigma (delayed_force build_sigma).Coqlib.proj1 in
+  let wfargpred = mkLambda (Name argid', argtyp, wf_rel_fun (mkRel 1) (mkRel 3)) in
+  let projection = (* in wfarg :: arg :: before *)
+    mkApp (proj, [| argtyp ; wfargpred ; mkRel 1 |])
+  in
+  let top_arity_let = it_mkLambda_or_LetIn top_arity letbinders in
+  let intern_arity = substl [projection] top_arity_let in
+  (* substitute the projection of wfarg for something,
+     now intern_arity is in wfarg :: arg *)
+  let sigma, wfa = wfarg sigma 1 in
+  let intern_fun_arity_prod = it_mkProd_or_LetIn intern_arity [wfa] in
+  let intern_fun_binder = LocalAssum (Name (add_suffix recname "'"), intern_fun_arity_prod) in
+  let sigma, curry_fun =
+    let wfpred = mkLambda (Name argid', argtyp, wf_rel_fun (mkRel 1) (mkRel (2 * len + 4))) in
+    let sigma, intro = Evarutil.new_global sigma (delayed_force build_sigma).Coqlib.intro in
+    let arg = mkApp (intro, [| argtyp; wfpred; lift 1 make; mkRel 1 |]) in
+    let app = mkApp (mkRel (2 * len + 2 (* recproof + orig binders + current binders *)), [| arg |]) in
+    let rcurry = mkApp (rel, [| measure; lift len measure |]) in
+    let lam = LocalAssum (Name (Id.of_string "recproof"), rcurry) in
+    let body = it_mkLambda_or_LetIn app (lam :: binders_rel) in
+    let ty = it_mkProd_or_LetIn (lift 1 top_arity) (lam :: binders_rel) in
+    sigma, LocalDef (Name recname, body, ty)
+  in
+  let fun_bl = intern_fun_binder :: [arg] in
+  let lift_lets = lift_rel_context 1 letbinders in
+  let sigma, intern_body =
+    let ctx = LocalAssum (Name recname, get_type curry_fun) :: binders_rel in
+    let (r, l, impls, scopes) =
+      Constrintern.compute_internalization_data env
+        Constrintern.Recursive (EConstr.Unsafe.to_constr full_arity) impls
+    in
+    let newimpls = Id.Map.singleton recname
+        (r, l, impls @ [(Some (Id.of_string "recproof", Impargs.Manual, (true, false)))],
+         scopes @ [None]) in
+    interp_casted_constr_evars (push_rel_context ctx env) sigma
+      ~impls:newimpls body (lift 1 top_arity)
+  in
+  let intern_body_lam = it_mkLambda_or_LetIn intern_body (curry_fun :: lift_lets @ fun_bl) in
+  let prop = mkLambda (Name argname, argtyp, top_arity_let) in
+  (* XXX: Previous code did parallel evdref update, so possible old
+     weak ordering semantics may bite here. *)
+  let sigma, def =
+    let sigma, h_a_term = Evarutil.new_global sigma (delayed_force fix_sub_ref) in
+    let sigma, h_e_term = Evarutil.new_evar env sigma
+        ~src:(Loc.tag @@ Evar_kinds.QuestionMark (Evar_kinds.Define false,Anonymous)) wf_proof in
+    sigma, mkApp (h_a_term, [| argtyp ; wf_rel ; h_e_term; prop |])
+  in
+  let _evd = ref sigma in
+  let def = Typing.e_solve_evars env _evd def in
+  let sigma = !_evd in
+  let sigma = Evarutil.nf_evar_map sigma in
+  let def = mkApp (def, [|intern_body_lam|]) in
+  let binders_rel = nf_evar_context sigma binders_rel in
+  let binders = nf_evar_context sigma binders in
+  let top_arity = Evarutil.nf_evar sigma top_arity in
+  let hook, recname, typ =
+    if List.length binders_rel > 1 then
+      let name = add_suffix recname "_func" in
+      (* XXX: Mutating the evar_map in the hook! *)
+      (* XXX: Likely the sigma is out of date when the hook is called .... *)
+      let hook sigma l gr _ =
+        let sigma, h_body = Evarutil.new_global sigma gr in
+        let body = it_mkLambda_or_LetIn (mkApp (h_body, [|make|])) binders_rel in
+        let ty = it_mkProd_or_LetIn top_arity binders_rel in
+        let ty = EConstr.Unsafe.to_constr ty in
+        let univs = Evd.check_univ_decl ~poly sigma decl in
+        (*FIXME poly? *)
+        let ce = definition_entry ~types:ty ~univs (EConstr.to_constr sigma body) in
+        (** FIXME: include locality *)
+        let c = Declare.declare_constant recname (DefinitionEntry ce, IsDefinition Definition) in
+        let gr = ConstRef c in
+        let () = Universes.register_universe_binders gr (Evd.universe_binders sigma) in
+        if Impargs.is_implicit_args () || not (List.is_empty impls) then
+          Impargs.declare_manual_implicits false gr [impls]
+      in
+      let typ = it_mkProd_or_LetIn top_arity binders in
+      hook, name, typ
+    else
+      let typ = it_mkProd_or_LetIn top_arity binders_rel in
+      let hook sigma l gr _ =
+        if Impargs.is_implicit_args () || not (List.is_empty impls) then
+          Impargs.declare_manual_implicits false gr [impls]
+      in hook, recname, typ
+  in
+  (* XXX: Capturing sigma here... bad bad *)
+  let hook = Lemmas.mk_hook (hook sigma) in
+  let fullcoqc = EConstr.to_constr sigma def in
+  let fullctyp = EConstr.to_constr sigma typ in
+  Obligations.check_evars env sigma;
+  let evars, _, evars_def, evars_typ =
+    Obligations.eterm_obligations env recname sigma 0 fullcoqc fullctyp
+  in
+  let ctx = Evd.evar_universe_context sigma in
+    ignore(Obligations.add_definition recname ~term:evars_def ~univdecl:decl
+             evars_typ ctx evars ~hook)
+
+let out_def = function
+  | Some def -> def
+  | None -> user_err Pp.(str "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 poly fixkind fixl ntns =
+  let cofix = fixkind = Obligations.IsCoFixpoint in
+  let (env, rec_sign, pl, evd), fix, info =
+    interp_recursive ~cofix ~program_mode:true fixl ntns
+  in
+    (* Program-specific code *)
+    (* Get the interesting evars, those that were not instanciated *)
+  let evd = Typeclasses.resolve_typeclasses ~filter:Typeclasses.no_goals ~fail:true env evd in
+    (* Solve remaining evars *)
+  let evd = nf_evar_map_undefined evd in
+  let collect_evars id def typ imps =
+    (* Generalize by the recursive prototypes  *)
+    let def =
+      EConstr.to_constr evd (Termops.it_mkNamedLambda_or_LetIn (EConstr.of_constr def) rec_sign)
+    and typ =
+      EConstr.to_constr evd (Termops.it_mkNamedProd_or_LetIn (EConstr.of_constr typ) rec_sign)
+    in
+    let evm = collect_evars_of_term evd def typ in
+    let evars, _, def, typ =
+      Obligations.eterm_obligations env id evm
+        (List.length rec_sign) def typ
+    in (id, def, typ, imps, evars)
+  in
+  let (fixnames,fixdefs,fixtypes) = fix in
+  let fiximps = List.map pi2 info in
+  let fixdefs = List.map out_def fixdefs in
+  let defs = List.map4 collect_evars fixnames fixdefs fixtypes fiximps in
+  let () = if not cofix then begin
+      let possible_indexes = List.map ComFixpoint.compute_possible_guardness_evidences info in
+      let fixdecls = Array.of_list (List.map (fun x -> Name x) fixnames),
+        Array.of_list fixtypes,
+        Array.of_list (List.map (subst_vars (List.rev fixnames)) fixdefs)
+      in
+      let indexes =
+        Pretyping.search_guard (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
+  | Obligations.IsFixpoint _ -> (local, poly, Fixpoint)
+  | Obligations.IsCoFixpoint -> (local, poly, CoFixpoint)
+  in
+  Obligations.add_mutual_definitions defs ~kind ~univdecl:pl ctx ntns fixkind
+
+let do_program_fixpoint local poly l =
+  let g = List.map (fun ((_,wf,_,_,_),_) -> wf) l in
+    match g, l with
+    | [(n, CWfRec r)], [((({CAst.v=id},pl),_,bl,typ,def),ntn)] ->
+        let recarg =
+          match n with
+          | Some n -> mkIdentC n.CAst.v
+          | None ->
+              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
+
+    | [(n, CMeasureRec (m, r))], [((({CAst.v=id},pl),_,bl,typ,def),ntn)] ->
+        build_wellfounded (id, pl, n, bl, typ, out_def def) poly
+          (Option.default (CAst.make @@ CRef (lt_ref,None)) r) m ntn
+
+    | _, _ when List.for_all (fun (n, ro) -> ro == CStructRec) g ->
+        let fixl,ntns = extract_fixpoint_components true l in
+        let fixkind = Obligations.IsFixpoint g in
+          do_program_recursive local poly fixkind fixl ntns
+
+    | _, _ ->
+        user_err ~hdr:"do_program_fixpoint"
+          (str "Well-founded fixpoints not allowed in mutually recursive blocks")
+
+let extract_cofixpoint_components l =
+  let fixl, ntnl = List.split l in
+  List.map (fun (({CAst.v=id},pl),bl,typ,def) ->
+            {fix_name = id; fix_annot = None; fix_univs = pl;
+             fix_binders = bl; fix_body = def; fix_type = typ}) fixl,
+  List.flatten ntnl
+
+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 =
+  do_program_fixpoint local poly l;
+  if not (check_safe ()) then Feedback.feedback Feedback.AddedAxiom else ()
+
+let do_cofixpoint local poly l =
+  let fixl,ntns = extract_cofixpoint_components l in
+  do_program_recursive local poly Obligations.IsCoFixpoint fixl ntns;
+  if not (check_safe ()) then Feedback.feedback Feedback.AddedAxiom else ()
diff --git a/vernac/comProgramFixpoint.mli b/vernac/comProgramFixpoint.mli
new file mode 100644
index 000000000..943cb8efe
--- /dev/null
+++ b/vernac/comProgramFixpoint.mli
@@ -0,0 +1,12 @@
+open Decl_kinds
+open Vernacexpr
+
+(** Special Fixpoint handling when command is activated. *)
+
+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
diff --git a/vernac/command.ml b/vernac/command.ml
deleted file mode 100644
index 0d6fd24cd..000000000
--- a/vernac/command.ml
+++ /dev/null
@@ -1,1333 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Pp
-open CErrors
-open Util
-open Flags
-open Term
-open Vars
-open Termops
-open Environ
-open Redexpr
-open Declare
-open Names
-open Libnames
-open Globnames
-open Nameops
-open Constrexpr
-open Constrexpr_ops
-open Topconstr
-open Constrintern
-open Nametab
-open Impargs
-open Reductionops
-open Indtypes
-open Decl_kinds
-open Pretyping
-open Evarutil
-open Evarconv
-open Indschemes
-open Misctypes
-open Vernacexpr
-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
-
-let rec under_binders env sigma f n c =
-  if Int.equal n 0 then f env sigma (EConstr.of_constr c) else
-    match kind_of_term c with
-      | Lambda (x,t,c) ->
-	  mkLambda (x,t,under_binders (push_rel (LocalAssum (x,t)) env) sigma f (n-1) c)
-      | LetIn (x,b,t,c) ->
-	  mkLetIn (x,b,t,under_binders (push_rel (LocalDef (x,b,t)) env) sigma f (n-1) c)
-      | _ -> assert false
-
-let rec complete_conclusion a cs = CAst.map_with_loc (fun ?loc -> function
-  | CProdN (bl,c) -> CProdN (bl,complete_conclusion a cs c)
-  | CLetIn (na,b,t,c) -> CLetIn (na,b,t,complete_conclusion a cs c)
-  | CHole (k, _, _) ->
-      let (has_no_args,name,params) = a in
-      if not has_no_args then
-	user_err ?loc
-	 (strbrk"Cannot infer the non constant arguments of the conclusion of "
-	  ++ pr_id cs ++ str ".");
-      let args = List.map (fun id -> CAst.make ?loc @@ CRef(Ident(loc,id),None)) params in
-      CAppExpl ((None,Ident(loc,name),None),List.rev args)
-  | c -> c
-  )
-
-(* Commands of the interface *)
-
-(* 1| Constant definitions *)
-
-let red_constant_entry n ce sigma = function
-  | None -> ce
-  | Some red ->
-      let proof_out = ce.const_entry_body in
-      let env = Global.env () in
-      let (redfun, _) = reduction_of_red_expr env red in
-      let redfun env sigma c =
-        let (_, c) = redfun env sigma c in
-        EConstr.Unsafe.to_constr c
-      in
-      { ce with const_entry_body = Future.chain ~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
-  let evdref = ref (Evd.from_ctx ctx) in
-  let impls, ((env_bl, ctx), imps1) = interp_context_evars env evdref bl in
-  let ctx = List.map (fun d -> map_rel_decl EConstr.Unsafe.to_constr d) ctx in
-  let nb_args = Context.Rel.nhyps ctx in
-  let imps,pl,ce =
-    match ctypopt with
-      None ->
-        let subst = evd_comb0 Evd.nf_univ_variables evdref in
-	let ctx = Context.Rel.map (Vars.subst_univs_constr subst) ctx in
-	let env_bl = push_rel_context ctx env in
-	let c, imps2 = interp_constr_evars_impls ~impls env_bl evdref c in
-	let c = EConstr.Unsafe.to_constr c in
-        let nf,subst = Evarutil.e_nf_evars_and_universes evdref in
-        let body = nf (it_mkLambda_or_LetIn c ctx) in
-	let vars = Univops.universes_of_constr body in
-	let evd = Evd.restrict_universe_context !evdref vars in
-	let pl, uctx = Evd.universe_context ?names:pl evd in
- 	imps1@(Impargs.lift_implicits nb_args imps2), pl,
-	  definition_entry ~univs:uctx ~poly:p body
-    | Some ctyp ->
-	let ty, impsty = interp_type_evars_impls ~impls env_bl evdref ctyp in
-	let subst = evd_comb0 Evd.nf_univ_variables evdref in
-	let ctx = Context.Rel.map (Vars.subst_univs_constr subst) ctx in
-	let env_bl = push_rel_context ctx env in
-	let c, imps2 = interp_casted_constr_evars_impls ~impls env_bl evdref c ty in
-	let c = EConstr.Unsafe.to_constr c in
-	let nf, subst = Evarutil.e_nf_evars_and_universes evdref in
-	let body = nf (it_mkLambda_or_LetIn c ctx) in
-	let ty = EConstr.Unsafe.to_constr ty in
-	let typ = nf (Term.it_mkProd_or_LetIn ty ctx) in
-        let beq b1 b2 = if b1 then b2 else not b2 in
-        let impl_eq (x,y,z) (x',y',z') = beq x x' && beq y y' && beq z z' in
-	(* Check that all implicit arguments inferable from the term
-           are inferable from the type *)
-        let chk (key,va) =
-          impl_eq (List.assoc_f Pervasives.(=) key impsty) va (* FIXME *)
-        in
-	if not (try List.for_all chk imps2 with Not_found -> false)
-	then warn_implicits_in_term ();
-        let vars = Univ.LSet.union (Univops.universes_of_constr body) 
-          (Univops.universes_of_constr typ) in
-        let ctx = Evd.restrict_universe_context !evdref vars in
-	let pl, uctx = Evd.universe_context ?names:pl ctx in
-	imps1@(Impargs.lift_implicits nb_args impsty), pl,
-	  definition_entry ~types:typ ~poly:p 
-	    ~univs:uctx body
-  in
-  red_constant_entry (Context.Rel.length ctx) ce !evdref red_option, !evdref, pl, imps
-
-let check_definition (ce, evd, _, imps) =
-  check_evars_are_solved (Global.env ()) evd Evd.empty;
-  ce
-
-let do_definition ident k pl bl red_option c ctypopt hook =
-  let (ce, evd, pl', imps as def) =
-    interp_definition pl bl (pi2 k) red_option c ctypopt
-  in
-    if Flags.is_program_mode () then
-      let env = Global.env () in
-      let (c,ctx), sideff = Future.force ce.const_entry_body in
-      assert(Safe_typing.empty_private_constants = sideff);
-      assert(Univ.ContextSet.is_empty ctx);
-      let typ = match ce.const_entry_type with 
-	| Some t -> t
-	| None -> EConstr.to_constr evd (Retyping.get_type_of env evd (EConstr.of_constr c))
-      in 
-      Obligations.check_evars env evd;
-      let obls, _, c, cty = 
-	Obligations.eterm_obligations env ident evd 0 c typ
-      in
-      let ctx = Evd.evar_universe_context evd in
-      let hook = Lemmas.mk_hook (fun l r _ -> Lemmas.call_hook (fun exn -> exn) hook l r) in
-	ignore(Obligations.add_definition
-          ident ~term:c cty ctx ?pl ~implicits:imps ~kind:k ~hook obls)
-    else let ce = check_definition def in
-      ignore(DeclareDef.declare_definition ident k ce pl' imps
-        (Lemmas.mk_hook
-          (fun l r -> Lemmas.call_hook (fun exn -> exn) hook l r;r)))
-
-(* 2| Variable/Hypothesis/Parameter/Axiom declarations *)
-
-let declare_assumption is_coe (local,p,kind) (c,ctx) pl imps impl nl (_,ident) =
-match local with
-| Discharge when Lib.sections_are_opened () ->
-  let decl = (Lib.cwd(), SectionLocalAssum ((c,ctx),p,impl), IsAssumption kind) in
-  let _ = declare_variable ident decl in
-  let () = assumption_message ident in
-  let () =
-    if not !Flags.quiet && Proof_global.there_are_pending_proofs () then
-    Feedback.msg_info (str"Variable" ++ spc () ++ pr_id ident ++
-    strbrk " is not visible from current goals")
-  in
-  let r = VarRef ident in
-  let () = Typeclasses.declare_instance None true r in
-  let () = if is_coe then Class.try_add_new_coercion r ~local:true false in
-  (r,Univ.Instance.empty,true)
-
-| Global | Local | Discharge ->
-  let local = DeclareDef.get_locality ident ~kind:"axiom" local in
-  let inl = match nl with
-    | NoInline -> None
-    | DefaultInline -> Some (Flags.get_inline_level())
-    | InlineAt i -> Some i
-  in
-  let ctx = Univ.ContextSet.to_context ctx in
-  let decl = (ParameterEntry (None,p,(c,ctx),inl), IsAssumption kind) in
-  let kn = declare_constant ident ~local decl in
-  let gr = ConstRef kn in
-  let () = maybe_declare_manual_implicits false gr imps in
-  let () = Universes.register_universe_binders gr pl in
-  let () = assumption_message ident in
-  let () = Typeclasses.declare_instance None false gr in
-  let () = if is_coe then Class.try_add_new_coercion gr ~local p in
-  let inst = 
-    if p (* polymorphic *) then Univ.UContext.instance ctx 
-    else Univ.Instance.empty
-  in
-    (gr,inst,Lib.is_modtype_strict ())
-
-let interp_assumption evdref env impls bl c =
-  let c = mkCProdN ?loc:(local_binders_loc bl) bl c in
-  let ty, impls = interp_type_evars_impls env evdref ~impls c in
-  let ty = EConstr.Unsafe.to_constr ty in
-  (ty, impls)
-
-let declare_assumptions idl is_coe k (c,ctx) pl imps impl_is_on nl =
-  let refs, status, _ =
-    List.fold_left (fun (refs,status,ctx) id ->
-      let ref',u',status' =
-	declare_assumption is_coe k (c,ctx) pl imps impl_is_on nl id in
-      (ref',u')::refs, status' && status, Univ.ContextSet.empty)
-      ([],true,ctx) idl
-  in
-  List.rev refs, status
-
-let do_assumptions_unbound_univs (_, poly, _ as kind) nl l =
-  let open Context.Named.Declaration in
-  let env = Global.env () in
-  let evdref = ref (Evd.from_env env) in
-  let l = 
-    if poly then
-      (* Separate declarations so that A B : Type puts A and B in different levels. *)
-      List.fold_right (fun (is_coe,(idl,c)) acc ->
-        List.fold_right (fun id acc -> 
-	  (is_coe, ([id], c)) :: acc) idl acc)
-        l []
-    else l
-  in
-  (* We intepret all declarations in the same evar_map, i.e. as a telescope. *)
-  let _,l = List.fold_left_map (fun (env,ienv) (is_coe,(idl,c)) ->
-    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,imps))) 
-    (env,empty_internalization_env) l
-  in
-  let evd = solve_remaining_evars all_and_fail_flags env !evdref Evd.empty 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 nf_evar c = EConstr.Unsafe.to_constr (nf_evar evd (EConstr.of_constr c)) in
-  let l = List.map (on_pi2 nf_evar) l in
-  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,
-     (* 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
-  let ctx = Evd.make_evar_universe_context env pl in
-  let evdref = ref (Evd.from_ctx ctx) in
-  let ty, impls = interp_type_evars_impls env evdref c in
-  let nf, subst = Evarutil.e_nf_evars_and_universes evdref in
-  let ty = EConstr.Unsafe.to_constr ty in
-  let ty = nf ty in
-  let vars = Univops.universes_of_constr ty in
-  let evd = Evd.restrict_universe_context !evdref vars in
-  let pl, uctx = Evd.universe_context ?names:pl evd in
-  let uctx = Univ.ContextSet.of_context uctx in
-  let (_, _, st) = declare_assumption coe kind (ty, uctx) pl impls false nl id in
-  st
-
-let do_assumptions kind nl l = match l with
-| [coe, ([id, Some pl], c)] ->
-  let () = match kind 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  msg
-  | _ -> ()
-  in
-  do_assumptions_bound_univs coe kind nl id (Some pl) c
-| _ ->
-  let map (coe, (idl, c)) =
-    let map (id, univs) = match univs with
-    | None -> id
-    | Some _ ->
-      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  msg
-    in
-    (coe, (List.map map idl, c))
-  in
-  let l = List.map map l in
-  do_assumptions_unbound_univs kind nl l
-
-(* 3a| Elimination schemes for mutual inductive definitions *)
-
-(* 3b| Mutual inductive definitions *)
-
-let push_types env idl tl =
-  List.fold_left2 (fun env id t -> Environ.push_rel (LocalAssum (Name id,t)) env)
-    env idl tl
-
-type structured_one_inductive_expr = {
-  ind_name : Id.t;
-  ind_univs : lident list option;
-  ind_arity : constr_expr;
-  ind_lc : (Id.t * constr_expr) list
-}
-
-type structured_inductive_expr =
-  local_binder_expr list * structured_one_inductive_expr list
-
-let minductive_message warn = function
-  | []  -> user_err Pp.(str "No inductive definition.")
-  | [x] -> (pr_id x ++ str " is defined" ++ 
-	    if warn then str " as a non-primitive record" else mt())
-  | l   -> hov 0  (prlist_with_sep pr_comma pr_id l ++
-		     spc () ++ str "are defined")
-
-let check_all_names_different indl =
-  let ind_names = List.map (fun ind -> ind.ind_name) indl in
-  let cstr_names = List.map_append (fun ind -> List.map fst ind.ind_lc) indl in
-  let l = List.duplicates Id.equal ind_names in
-  let () = match l with
-  | [] -> ()
-  | t :: _ -> raise (InductiveError (SameNamesTypes t))
-  in
-  let l = List.duplicates Id.equal cstr_names in
-  let () = match l with
-  | [] -> ()
-  | c :: _ -> raise (InductiveError (SameNamesConstructors (List.hd l)))
-  in
-  let l = List.intersect Id.equal ind_names cstr_names in
-  match l with
-  | [] -> ()
-  | _ -> raise (InductiveError (SameNamesOverlap l))
-
-let mk_mltype_data evdref env assums arity indname =
-  let is_ml_type = is_sort env !evdref (EConstr.of_constr arity) in
-  (is_ml_type,indname,assums)
-
-let prepare_param = function
-  | LocalAssum (na,t) -> Name.get_id na, LocalAssumEntry t
-  | LocalDef (na,b,_) -> Name.get_id na, LocalDefEntry b
-
-(** Make the arity conclusion flexible to avoid generating an upper bound universe now,
-    only if the universe does not appear anywhere else.
-    This is really a hack to stay compatible with the semantics of template polymorphic 
-    inductives which are recognized when a "Type" appears at the end of the conlusion in
-    the source syntax. *)
-    
-let rec check_anonymous_type ind =
-  let open Glob_term in
-    match ind.CAst.v with
-    | GSort (GType []) -> true
-    | GProd ( _, _, _, e) 
-    | GLetIn (_, _, _, e)
-    | GLambda (_, _, _, e)
-    | GApp (e, _)
-    | GCast (e, _) -> check_anonymous_type e
-    | _ -> false
-
-let make_conclusion_flexible evdref ty poly =
-  if poly && isArity ty then
-    let _, concl = destArity ty in
-      match concl with
-      | Type u -> 
-        (match Univ.universe_level u with
-        | Some u -> 
-	  evdref := Evd.make_flexible_variable !evdref ~algebraic:true u
-	| None -> ())
-      | _ -> ()
-  else () 
-	
-let is_impredicative env u = 
-  u = Prop Null || (is_impredicative_set env && u = Prop Pos)
-
-let interp_ind_arity env evdref ind =
-  let c = intern_gen IsType env ind.ind_arity in
-  let impls = Implicit_quantifiers.implicits_of_glob_constr ~with_products:true c in
-  let (evd,t) = understand_tcc env !evdref ~expected_type:IsType c in
-  evdref := evd;
-  let pseudo_poly = check_anonymous_type c in
-  let () = if not (Reductionops.is_arity env !evdref t) then
-    user_err ?loc:(constr_loc ind.ind_arity) (str "Not an arity")
-  in
-  let t = EConstr.Unsafe.to_constr t in
-    t, pseudo_poly, impls
-
-let interp_cstrs evdref env impls mldata arity ind =
-  let cnames,ctyps = List.split ind.ind_lc in
-  (* Complete conclusions of constructor types if given in ML-style syntax *)
-  let ctyps' = List.map2 (complete_conclusion mldata) cnames ctyps in
-  (* Interpret the constructor types *)
-  let ctyps'', cimpls = List.split (List.map (interp_type_evars_impls evdref env ~impls %> on_fst EConstr.Unsafe.to_constr) ctyps') in
-    (cnames, ctyps'', cimpls)
-
-let sign_level env evd sign =
-  fst (List.fold_right
-    (fun d (lev,env) ->
-      match d with
-      | LocalDef _ -> lev, push_rel d env
-      | LocalAssum _ ->
-	let s = destSort (Reduction.whd_all env 
-			    (EConstr.Unsafe.to_constr (nf_evar evd (Retyping.get_type_of env evd (EConstr.of_constr (RelDecl.get_type d))))))
-	in
-	let u = univ_of_sort s in
-	  (Univ.sup u lev, push_rel d env))
-    sign (Univ.type0m_univ,env))
-
-let sup_list min = List.fold_left Univ.sup min
-
-let extract_level env evd min tys = 
-  let sorts = List.map (fun ty -> 
-    let ctx, concl = Reduction.dest_prod_assum env ty in
-      sign_level env evd (LocalAssum (Anonymous, concl) :: ctx)) tys
-  in sup_list min sorts
-
-let is_flexible_sort evd u =
-  match Univ.Universe.level u with
-  | Some l -> Evd.is_flexible_level evd l
-  | None -> false
-
-let inductive_levels env evdref poly arities inds =
-  let destarities = List.map (fun x -> x, Reduction.dest_arity env x) arities in
-  let levels = List.map (fun (x,(ctx,a)) -> 
-    if a = Prop Null then None
-    else Some (univ_of_sort a)) destarities
-  in
-  let cstrs_levels, min_levels, sizes = 
-    CList.split3
-      (List.map2 (fun (_,tys,_) (arity,(ctx,du)) -> 
-	let len = List.length tys in
-	let minlev = Sorts.univ_of_sort du in
-	let minlev =
-	  if len > 1 && not (is_impredicative env du) then
-	    Univ.sup minlev Univ.type0_univ
-	  else minlev
-	in
-	let minlev =
-	  (** Indices contribute. *)
-	  if Indtypes.is_indices_matter () && List.length ctx > 0 then (
-	    let ilev = sign_level env !evdref ctx in
-	      Univ.sup ilev minlev)
-	  else minlev
-	in
-	let clev = extract_level env !evdref minlev tys in
-	  (clev, minlev, len)) inds destarities)
-  in
-  (* Take the transitive closure of the system of constructors *)
-  (* level constraints and remove the recursive dependencies *)
-  let levels' = Universes.solve_constraints_system (Array.of_list levels)
-    (Array.of_list cstrs_levels) (Array.of_list min_levels)
-  in
-  let evd, arities =
-    CList.fold_left3 (fun (evd, arities) cu (arity,(ctx,du)) len ->
-      if is_impredicative env du then
-	(** Any product is allowed here. *)
-	evd, arity :: arities
-      else (** If in a predicative sort, or asked to infer the type,
-	       we take the max of:
-	       - indices (if in indices-matter mode)
-	       - constructors
-	       - Type(1) if there is more than 1 constructor
-	   *)
-        (** Constructors contribute. *)
-	let evd = 
-	  if Sorts.is_set du then
-	    if not (Evd.check_leq evd cu Univ.type0_univ) then 
-	      raise (Indtypes.InductiveError Indtypes.LargeNonPropInductiveNotInType)
-	    else evd
-	  else evd
-	    (* Evd.set_leq_sort env evd (Type cu) du *)
-	in
-	let evd = 
-	  if len >= 2 && Univ.is_type0m_univ cu then 
-	   (** "Polymorphic" type constraint and more than one constructor, 
-	       should not land in Prop. Add constraint only if it would
-	       land in Prop directly (no informative arguments as well). *)
-	    Evd.set_leq_sort env evd (Prop Pos) du
-	  else evd
-	in
-	let duu = Sorts.univ_of_sort du in
-	let evd =
-	  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
-	  (evd, arity :: arities))
-    (!evdref,[]) (Array.to_list levels') destarities sizes
-  in evdref := evd; List.rev arities
-
-let check_named (loc, na) = match na with
-| Name _ -> ()
-| Anonymous ->
-  let msg = str "Parameters must be named." in
-  user_err ?loc  msg
-
-
-let check_param = function
-| CLocalDef (na, _, _) -> check_named na
-| CLocalAssum (nas, Default _, _) -> List.iter check_named nas
-| CLocalAssum (nas, Generalized _, _) -> ()
-| CLocalPattern _ -> assert false
-
-let interp_mutual_inductive (paramsl,indl) notations cum poly prv finite =
-  check_all_names_different indl;
-  List.iter check_param paramsl;
-  let env0 = Global.env() in
-  let pl = (List.hd indl).ind_univs in
-  let ctx = Evd.make_evar_universe_context env0 pl in
-  let evdref = ref Evd.(from_ctx ctx) in
-  let impls, ((env_params, ctx_params), userimpls) =
-    interp_context_evars env0 evdref paramsl
-  in
-  let ctx_params = List.map (fun d -> map_rel_decl EConstr.Unsafe.to_constr d) ctx_params in
-  let indnames = List.map (fun ind -> ind.ind_name) indl in
-      
-  (* 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 (RelDecl.get_name %> Name.get_id) assums in
-
-  (* Interpret the arities *)
-  let arities = List.map (interp_ind_arity env_params evdref) indl in
-
-  let fullarities = List.map (fun (c, _, _) -> Term.it_mkProd_or_LetIn c ctx_params) arities in
-  let env_ar = push_types env0 indnames fullarities in
-  let env_ar_params = push_rel_context ctx_params env_ar in
-
-  (* Compute interpretation metadatas *)
-  let indimpls = List.map (fun (_, _, impls) -> userimpls @ 
-    lift_implicits (Context.Rel.nhyps ctx_params) impls) arities in
-  let arities = List.map pi1 arities and aritypoly = List.map pi2 arities in
-  let impls = compute_internalization_env env0 ~impls (Inductive (params,true)) indnames fullarities indimpls in
-  let implsforntn = compute_internalization_env env0 Variable indnames fullarities indimpls in
-  let mldatas = List.map2 (mk_mltype_data evdref env_params params) arities indnames in
-
-  let constructors =
-    Metasyntax.with_syntax_protection (fun () ->
-     (* Temporary declaration of notations and scopes *)
-     List.iter (Metasyntax.set_notation_for_interpretation implsforntn) notations;
-     (* Interpret the constructor types *)
-     List.map3 (interp_cstrs env_ar_params evdref impls) mldatas arities indl)
-     () in
-
-  (* Try further to solve evars, and instantiate them *)
-  let sigma = solve_remaining_evars all_and_fail_flags env_params !evdref Evd.empty in
-  evdref := sigma;
-  (* Compute renewed arities *)
-  let nf,_ = e_nf_evars_and_universes evdref in
-  let arities = List.map nf arities in
-  let constructors = List.map (fun (idl,cl,impsl) -> (idl,List.map nf cl,impsl)) constructors in
-  let _ = List.iter2 (fun ty poly -> make_conclusion_flexible evdref ty poly) arities aritypoly in
-  let arities = inductive_levels env_ar_params evdref poly arities constructors in
-  let nf',_ = e_nf_evars_and_universes evdref in
-  let nf x = nf' (nf x) in
-  let arities = List.map nf' arities in
-  let constructors = List.map (fun (idl,cl,impsl) -> (idl,List.map nf' cl,impsl)) constructors in
-  let ctx_params = Context.Rel.map nf ctx_params in
-  let evd = !evdref in
-  let pl, uctx = Evd.universe_context ?names:pl evd in
-  List.iter (fun c -> check_evars env_params Evd.empty evd (EConstr.of_constr c)) arities;
-  Context.Rel.iter (fun c -> check_evars env0 Evd.empty evd (EConstr.of_constr c)) ctx_params;
-  List.iter (fun (_,ctyps,_) ->
-    List.iter (fun c -> check_evars env_ar_params Evd.empty evd (EConstr.of_constr c)) ctyps)
-    constructors;
-
-  (* Build the inductive entries *)
-  let entries = List.map4 (fun ind arity template (cnames,ctypes,cimpls) -> {
-    mind_entry_typename = ind.ind_name;
-    mind_entry_arity = arity;
-    mind_entry_template = template;
-    mind_entry_consnames = cnames;
-    mind_entry_lc = ctypes
-  }) indl arities aritypoly constructors in
-  let impls =
-    let len = Context.Rel.nhyps ctx_params in
-      List.map2 (fun indimpls (_,_,cimpls) ->
-	indimpls, List.map (fun impls ->
-	  userimpls @ (lift_implicits len impls)) cimpls) indimpls constructors
-  in
-  let univs =
-    if poly then
-      if cum then
-        Cumulative_ind_entry (Universes.univ_inf_ind_from_universe_context uctx)
-      else Polymorphic_ind_entry uctx
-    else
-      Monomorphic_ind_entry uctx
-  in
-  (* Build the mutual inductive entry *)
-  let mind_ent =
-    { mind_entry_params = List.map prepare_param ctx_params;
-      mind_entry_record = None;
-      mind_entry_finite = finite;
-      mind_entry_inds = entries;
-      mind_entry_private = if prv then Some false else None;
-      mind_entry_universes = univs;
-    }
-  in
-  (if poly && cum then
-      Inductiveops.infer_inductive_subtyping env_ar evd mind_ent
-   else mind_ent), pl, impls
-
-(* Very syntactical equality *)
-let eq_local_binders bl1 bl2 =
-  List.equal local_binder_eq bl1 bl2
-
-let extract_coercions indl =
-  let mkqid (_,((_,id),_)) = qualid_of_ident id in
-  let extract lc = List.filter (fun (iscoe,_) -> iscoe) lc in
-  List.map mkqid (List.flatten(List.map (fun (_,_,_,lc) -> extract lc) indl))
-
-let extract_params indl =
-  let paramsl = List.map (fun (_,params,_,_) -> params) indl in
-  match paramsl with
-  | [] -> anomaly (Pp.str "empty list of inductive types.")
-  | params::paramsl ->
-      if not (List.for_all (eq_local_binders params) paramsl) then user_err Pp.(str
-	"Parameters should be syntactically the same for each inductive type.");
-      params
-
-let extract_inductive indl =
-  List.map (fun (((_,indname),pl),_,ar,lc) -> {
-    ind_name = indname; ind_univs = pl;
-    ind_arity = Option.cata (fun x -> x) (CAst.make @@ CSort (GType [])) ar;
-    ind_lc = List.map (fun (_,((_,id),t)) -> (id,t)) lc
-  }) indl
-
-let extract_mutual_inductive_declaration_components indl =
-  let indl,ntnl = List.split indl in
-  let params = extract_params indl in
-  let coes = extract_coercions indl in
-  let indl = extract_inductive indl in
-  (params,indl), coes, List.flatten ntnl
-
-let is_recursive mie =
-  let rec is_recursive_constructor lift typ =
-    match Term.kind_of_term typ with
-    | Prod (_,arg,rest) ->
-        not (EConstr.Vars.noccurn Evd.empty (** FIXME *) lift (EConstr.of_constr arg)) ||
-        is_recursive_constructor (lift+1) rest
-    | LetIn (na,b,t,rest) -> is_recursive_constructor (lift+1) rest
-    | _ -> false
-  in
-  match mie.mind_entry_inds with
-  | [ind] ->
-      let nparams = List.length mie.mind_entry_params in
-      List.exists (fun t -> is_recursive_constructor (nparams+1) t) ind.mind_entry_lc
-  | _ -> false
-
-let declare_mutual_inductive_with_eliminations mie pl impls =
-  (* spiwack: raises an error if the structure is supposed to be non-recursive,
-        but isn't *)
-  begin match mie.mind_entry_finite with
-  | BiFinite when is_recursive mie ->
-      if Option.has_some mie.mind_entry_record then
-        user_err Pp.(str "Records declared with the keywords Record or Structure cannot be recursive. You can, however, define recursive records using the Inductive or CoInductive command.")
-      else
-        user_err Pp.(str ("Types declared with the keyword Variant cannot be recursive. Recursive types are defined with the Inductive and CoInductive command."))
-  | _ -> ()
-  end;
-  let names = List.map (fun e -> e.mind_entry_typename) mie.mind_entry_inds in
-  let (_, kn), prim = declare_mind mie in
-  let mind = Global.mind_of_delta_kn kn in
-  List.iteri (fun i (indimpls, constrimpls) ->
-	      let ind = (mind,i) in
-	      let gr = IndRef ind in
-	      maybe_declare_manual_implicits false gr indimpls;
-	      Universes.register_universe_binders gr pl;
-	      List.iteri
-		(fun j impls ->
-		 maybe_declare_manual_implicits false
-		    (ConstructRef (ind, succ j)) impls)
-		constrimpls)
-      impls;
-  let warn_prim = match mie.mind_entry_record with Some (Some _) -> not prim | _ -> false in
-  if_verbose Feedback.msg_info (minductive_message warn_prim names);
-  if mie.mind_entry_private == None
-  then declare_default_schemes mind;
-  mind
-
-type one_inductive_impls =
-  Impargs.manual_explicitation list (* for inds *)*
-  Impargs.manual_explicitation list list (* for constrs *)
-
-let do_mutual_inductive indl cum poly prv finite =
-  let indl,coes,ntns = extract_mutual_inductive_declaration_components indl in
-  (* Interpret the types *)
-  let mie,pl,impls = interp_mutual_inductive indl ntns cum poly prv finite in
-  (* Declare the mutual inductive block with its associated schemes *)
-  ignore (declare_mutual_inductive_with_eliminations mie pl impls);
-  (* 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) ~local: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...
-
-   Input:  a list of associations (x,[y1;...;yn]), all yi distincts
-           and different of x, meaning x<=y1, ..., x<=yn
-
-   Output: a list of associations (x,Inr [y1;...;yn]), collecting all
-           distincts yi greater than x, _or_, (x, Inl y) meaning that
-           x is in the same class as y (in which case, x occurs
-           nowhere else in the association map)
-
-   partial_order : ('a * 'a list) list -> ('a * ('a,'a list) union) list
-*)
-
-let rec partial_order cmp = function
-  | [] -> []
-  | (x,xge)::rest ->
-    let rec browse res xge' = function
-    | [] ->
-	let res = List.map (function
-	  | (z, Inr zge) when List.mem_f cmp x zge ->
-            (z, Inr (List.union cmp zge xge'))
-	  | r -> r) res in
-	(x,Inr xge')::res
-    | y::xge ->
-      let rec link y =
-	try match List.assoc_f cmp y res with
-	| Inl z -> link z
-	| Inr yge ->
-	  if List.mem_f cmp x yge then
-	    let res = List.remove_assoc_f cmp y res in
-	    let res = List.map (function
-	      | (z, Inl t) ->
-		  if cmp t y then (z, Inl x) else (z, Inl t)
-	      | (z, Inr zge) ->
-		  if List.mem_f cmp y zge then
-		    (z, Inr (List.add_set cmp x (List.remove cmp y zge)))
-		  else
-		    (z, Inr zge)) res in
-	    browse ((y,Inl x)::res) xge' (List.union cmp xge (List.remove cmp x yge))
-	  else
-	    browse res (List.add_set cmp y (List.union cmp xge' yge)) xge
-	with Not_found -> browse res (List.add_set cmp y xge') xge
-      in link y
-    in browse (partial_order cmp rest) [] xge
-
-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 ++ strbrk " but not conversely"
-    else if Id.List.mem y xge then
-      pr_id x ++ str " depends on " ++ pr_id y ++ strbrk " but not conversely"
-    else
-      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 strbrk "Well-foundedness check may fail unexpectedly." ++ fnl()
-    else mt () in
-  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 evd isfix fixl =
-  let names = List.map fst fixl in
-  let preorder =
-    List.map (fun (id,def) ->
-      (id, List.filter (fun id' -> not (Id.equal id id') && occur_var env evd id' (EConstr.of_constr def)) names))
-      fixl in
-  let po = partial_order Id.equal preorder in
-  match List.filter (function (_,Inr _) -> true | _ -> false) po with
-    | (x,Inr xge)::(y,Inr yge)::rest ->
-       warn_non_full_mutual (x,xge,y,yge,isfix,rest)
-    | _ -> ()
-
-type structured_fixpoint_expr = {
-  fix_name : Id.t;
-  fix_univs : lident list option;
-  fix_annot : Id.t Loc.located option;
-  fix_binders : local_binder_expr list;
-  fix_body : constr_expr option;
-  fix_type : constr_expr
-}
-
-let interp_fix_context env evdref isfix fix =
-  let before, after = if isfix then split_at_annot fix.fix_binders fix.fix_annot else [], fix.fix_binders in
-  let impl_env, ((env', ctx), imps) = interp_context_evars env evdref before in
-  let impl_env', ((env'', ctx'), imps') = interp_context_evars ~impl_env ~shift:(Context.Rel.nhyps ctx) env' evdref after in
-  let annot = Option.map (fun _ -> List.length (assums_of_rel_context ctx)) fix.fix_annot in
-    ((env'', ctx' @ ctx), (impl_env',imps @ imps'), annot)
-
-let interp_fix_ccl evdref impls (env,_) fix =
-  let (c, impl) = interp_type_evars_impls ~impls env evdref fix.fix_type in
-  (c, impl)
-
-let interp_fix_body env_rec evdref impls (_,ctx) fix ccl =
-  let open EConstr in
-  Option.map (fun body ->
-    let env = push_rel_context ctx env_rec in
-    let body = interp_casted_constr_evars env evdref ~impls body ccl in
-    it_mkLambda_or_LetIn body ctx) fix.fix_body
-
-let build_fix_type (_,ctx) ccl = EConstr.it_mkProd_or_LetIn ccl ctx
-
-let prepare_recursive_declaration fixnames fixtypes fixdefs =
-  let defs = List.map (subst_vars (List.rev fixnames)) fixdefs in
-  let names = List.map (fun id -> Name id) fixnames in
-  (Array.of_list names, Array.of_list fixtypes, Array.of_list defs)
-
-(* Jump over let-bindings. *)
-
-let compute_possible_guardness_evidences (ctx,_,recindex) =
-  (* A recursive index is characterized by the number of lambdas to
-     skip before finding the relevant inductive argument *)
-  match recindex with
-  | Some i -> [i]
-  | None ->
-      (* If recursive argument was not given by user, we try all args.
-	 An earlier approach was to look only for inductive arguments,
-	 but doing it properly involves delta-reduction, and it finally
-         doesn't seem to worth the effort (except for huge mutual
-	 fixpoints ?) *)
-      List.interval 0 (Context.Rel.nhyps ctx - 1)
-
-type recursive_preentry =
-  Id.t list * constr option list * types list
-
-(* Wellfounded definition *)
-
-open Coqlib
-
-let contrib_name = "Program"
-let subtac_dir = [contrib_name]
-let fixsub_module = subtac_dir @ ["Wf"]
-let tactics_module = subtac_dir @ ["Tactics"]
-
-let init_reference dir s () = Coqlib.coq_reference "Command" dir s
-let init_constant  dir s evdref =
-  let (sigma, c) = Evarutil.new_global !evdref (Coqlib.coq_reference "Command" dir s)
-  in evdref := sigma; c
-
-let make_ref l s = init_reference l s
-let fix_proto = init_constant tactics_module "fix_proto"
-let fix_sub_ref = make_ref fixsub_module "Fix_sub"
-let measure_on_R_ref = make_ref fixsub_module "MR"
-let well_founded = init_constant ["Init"; "Wf"] "well_founded"
-let mkSubset evdref name typ prop =
-  let open EConstr in
-  mkApp (Evarutil.e_new_global evdref (delayed_force build_sigma).typ,
-	 [| typ; mkLambda (name, typ, prop) |])
-let sigT = Lazy.from_fun build_sigma_type
-
-let make_qref s = Qualid (Loc.tag @@ qualid_of_string s)
-let lt_ref = make_qref "Init.Peano.lt"
-
-let rec telescope evdref l =
-  let open EConstr in
-  let open Vars in
-  match l with
-  | [] -> assert false
-  | [LocalAssum (n, t)] -> t, [LocalDef (n, mkRel 1, t)], mkRel 1
-  | LocalAssum (n, t) :: tl ->
-      let ty, tys, (k, constr) =
-	List.fold_left
-	  (fun (ty, tys, (k, constr)) decl ->
-            let t = RelDecl.get_type decl in
-            let pred = mkLambda (RelDecl.get_name decl, t, ty) in
-	    let ty = Evarutil.e_new_global evdref (Lazy.force sigT).typ in
-	    let intro = Evarutil.e_new_global evdref (Lazy.force sigT).intro in
-	    let sigty = mkApp (ty, [|t; pred|]) in
-	    let intro = mkApp (intro, [|lift k t; lift k pred; mkRel k; constr|]) in
-	      (sigty, pred :: tys, (succ k, intro)))
-	  (t, [], (2, mkRel 1)) tl
-      in
-      let (last, subst) = List.fold_right2
-        (fun pred decl (prev, subst) ->
-          let t = RelDecl.get_type decl in
-	  let p1 = Evarutil.e_new_global evdref (Lazy.force sigT).proj1 in
-	  let p2 = Evarutil.e_new_global evdref (Lazy.force sigT).proj2 in
-	  let proj1 = applist (p1, [t; pred; prev]) in
-	  let proj2 = applist (p2, [t; pred; prev]) in
-	    (lift 1 proj2, LocalDef (get_name decl, proj1, t) :: subst))
-	(List.rev tys) tl (mkRel 1, [])
-      in ty, (LocalDef (n, last, t) :: subst), constr
-
-  | LocalDef (n, b, t) :: tl -> let ty, subst, term = telescope evdref tl in
-      ty, (LocalDef (n, b, t) :: subst), lift 1 term
-
-let nf_evar_context sigma ctx =
-  List.map (map_constr (fun c -> Evarutil.nf_evar sigma c)) ctx
-
-let build_wellfounded (recname,pl,n,bl,arityc,body) poly r measure notation =
-  let open EConstr in
-  let open Vars in
-  let lift_rel_context n l = Termops.map_rel_context_with_binders (liftn n) l in
-  Coqlib.check_required_library ["Coq";"Program";"Wf"];
-  let env = Global.env() in
-  let ctx = Evd.make_evar_universe_context env pl in
-  let evdref = ref (Evd.from_ctx ctx) in
-  let _, ((env', binders_rel), impls) = interp_context_evars env evdref bl in
-  let len = List.length binders_rel in
-  let top_env = push_rel_context binders_rel env in
-  let top_arity = interp_type_evars top_env evdref arityc in
-  let full_arity = it_mkProd_or_LetIn top_arity binders_rel in
-  let argtyp, letbinders, make = telescope evdref binders_rel in
-  let argname = Id.of_string "recarg" in
-  let arg = LocalAssum (Name argname, argtyp) in
-  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 relty = Typing.unsafe_type_of env !evdref rel in
-  let relargty =
-    let error () =
-      user_err ?loc:(constr_loc r)
-               ~hdr:"Command.build_wellfounded"
-		    (Printer.pr_econstr_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
-	  match ctx, EConstr.kind !evdref ar with
-	  | [LocalAssum (_,t); LocalAssum (_,u)], Sort s
-	      when Sorts.is_prop (ESorts.kind !evdref s) && Reductionops.is_conv env !evdref t u -> t
-	  | _, _ -> error ()
-      with e when CErrors.noncritical e -> error ()
-  in
-  let relargty = EConstr.Unsafe.to_constr relargty in
-  let measure = interp_casted_constr_evars binders_env evdref measure relargty in
-  let wf_rel, wf_rel_fun, measure_fn =
-    let measure_body, measure =
-      it_mkLambda_or_LetIn measure letbinders,
-      it_mkLambda_or_LetIn measure binders
-    in
-    let comb = Evarutil.e_new_global evdref (delayed_force measure_on_R_ref) in
-    let relargty = EConstr.of_constr relargty in
-    let wf_rel = mkApp (comb, [| argtyp; relargty; rel; measure |]) in
-    let wf_rel_fun x y =
-      mkApp (rel, [| subst1 x measure_body;
- 		     subst1 y measure_body |])
-    in wf_rel, wf_rel_fun, measure
-  in
-  let wf_proof = mkApp (well_founded evdref, [| argtyp ; wf_rel |]) in
-  let argid' = Id.of_string (Id.to_string argname ^ "'") in
-  let wfarg len = LocalAssum (Name argid',
-                              mkSubset evdref (Name argid') argtyp
-				       (wf_rel_fun (mkRel 1) (mkRel (len + 1))))
-  in
-  let intern_bl = wfarg 1 :: [arg] in
-  let _intern_env = push_rel_context intern_bl env in
-  let proj = Evarutil.e_new_global evdref (delayed_force build_sigma).Coqlib.proj1 in
-  let wfargpred = mkLambda (Name argid', argtyp, wf_rel_fun (mkRel 1) (mkRel 3)) in
-  let projection = (* in wfarg :: arg :: before *)
-    mkApp (proj, [| argtyp ; wfargpred ; mkRel 1 |])
-  in
-  let top_arity_let = it_mkLambda_or_LetIn top_arity letbinders in
-  let intern_arity = substl [projection] top_arity_let in
-  (* substitute the projection of wfarg for something,
-     now intern_arity is in wfarg :: arg *)
-  let intern_fun_arity_prod = it_mkProd_or_LetIn intern_arity [wfarg 1] in
-  let intern_fun_binder = LocalAssum (Name (add_suffix recname "'"), intern_fun_arity_prod) in
-  let curry_fun =
-    let wfpred = mkLambda (Name argid', argtyp, wf_rel_fun (mkRel 1) (mkRel (2 * len + 4))) in
-    let intro = Evarutil.e_new_global evdref (delayed_force build_sigma).Coqlib.intro in
-    let arg = mkApp (intro, [| argtyp; wfpred; lift 1 make; mkRel 1 |]) in
-    let app = mkApp (mkRel (2 * len + 2 (* recproof + orig binders + current binders *)), [| arg |]) in
-    let rcurry = mkApp (rel, [| measure; lift len measure |]) in
-    let lam = LocalAssum (Name (Id.of_string "recproof"), rcurry) in
-    let body = it_mkLambda_or_LetIn app (lam :: binders_rel) in
-    let ty = it_mkProd_or_LetIn (lift 1 top_arity) (lam :: binders_rel) in
-      LocalDef (Name recname, body, ty)
-  in
-  let fun_bl = intern_fun_binder :: [arg] in
-  let lift_lets = lift_rel_context 1 letbinders in
-  let intern_body =
-    let ctx = LocalAssum (Name recname, get_type curry_fun) :: binders_rel in
-    let (r, l, impls, scopes) =
-      Constrintern.compute_internalization_data env
-	Constrintern.Recursive (EConstr.Unsafe.to_constr full_arity) impls 
-    in
-    let newimpls = Id.Map.singleton recname
-      (r, l, impls @ [(Some (Id.of_string "recproof", Impargs.Manual, (true, false)))],
-       scopes @ [None]) in
-      interp_casted_constr_evars (push_rel_context ctx env) evdref
-        ~impls:newimpls body (EConstr.Unsafe.to_constr (lift 1 top_arity))
-  in
-  let intern_body_lam = it_mkLambda_or_LetIn intern_body (curry_fun :: lift_lets @ fun_bl) in
-  let prop = mkLambda (Name argname, argtyp, top_arity_let) in
-  let def =
-    mkApp (Evarutil.e_new_global evdref (delayed_force fix_sub_ref),
-	  [| argtyp ; wf_rel ;
-	     Evarutil.e_new_evar env evdref
-	       ~src:(Loc.tag @@ Evar_kinds.QuestionMark (Evar_kinds.Define false,Anonymous)) wf_proof;
-	     prop |])
-  in
-  let def = Typing.e_solve_evars env evdref def in
-  let _ = evdref := Evarutil.nf_evar_map !evdref in
-  let def = mkApp (def, [|intern_body_lam|]) in
-  let binders_rel = nf_evar_context !evdref binders_rel in
-  let binders = nf_evar_context !evdref binders in
-  let top_arity = Evarutil.nf_evar !evdref top_arity in
-  let hook, recname, typ = 
-    if List.length binders_rel > 1 then
-      let name = add_suffix recname "_func" in
-      let hook l gr _ = 
-	let body = it_mkLambda_or_LetIn (mkApp (Evarutil.e_new_global evdref gr, [|make|])) binders_rel in
-	let ty = it_mkProd_or_LetIn top_arity binders_rel in
-	let ty = EConstr.Unsafe.to_constr ty in
-	let pl, univs = Evd.universe_context ?names:pl !evdref in
-	  (*FIXME poly? *)
-	let ce = definition_entry ~poly ~types:ty ~univs (EConstr.to_constr !evdref body) in
-	(** FIXME: include locality *)
-	let c = Declare.declare_constant recname (DefinitionEntry ce, IsDefinition Definition) in
-	let gr = ConstRef c in
-	  if Impargs.is_implicit_args () || not (List.is_empty impls) then
-	    Impargs.declare_manual_implicits false gr [impls]
-      in
-      let typ = it_mkProd_or_LetIn top_arity binders in
-	hook, name, typ
-    else 
-      let typ = it_mkProd_or_LetIn top_arity binders_rel in
-      let hook l gr _ = 
-	if Impargs.is_implicit_args () || not (List.is_empty impls) then
-	  Impargs.declare_manual_implicits false gr [impls]
-      in hook, recname, typ
-  in
-  let hook = Lemmas.mk_hook hook in
-  let fullcoqc = EConstr.to_constr !evdref def in
-  let fullctyp = EConstr.to_constr !evdref typ in
-  Obligations.check_evars env !evdref;
-  let evars, _, evars_def, evars_typ = 
-    Obligations.eterm_obligations env recname !evdref 0 fullcoqc fullctyp 
-  in
-  let ctx = Evd.evar_universe_context !evdref in
-    ignore(Obligations.add_definition recname ~term:evars_def ?pl
-	     evars_typ ctx evars ~hook)
-
-let interp_recursive isfix fixl notations =
-  let open Context.Named.Declaration in
-  let open EConstr in
-  let env = Global.env() in
-  let fixnames = List.map (fun fix -> fix.fix_name) fixl in
-
-  (* Interp arities allowing for unresolved types *)
-  let all_universes =
-    List.fold_right (fun sfe acc ->
-        match sfe.fix_univs , acc with
-        | None , acc -> acc
-        | x , None -> x
-        | Some ls , Some us ->
-	   if not (CList.for_all2eq (fun x y -> Id.equal (snd x) (snd y)) ls us) then
-	     user_err Pp.(str "(co)-recursive definitions should all have the same universe binders");
-	   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 =
-    List.split3 (List.map (interp_fix_context env evdref isfix) fixl) in
-  let fixctximpenvs, fixctximps = List.split fiximppairs in
-  let fixccls,fixcclimps = List.split (List.map3 (interp_fix_ccl evdref) fixctximpenvs fixctxs fixl) in
-  let fixtypes = List.map2 build_fix_type fixctxs fixccls in
-  let fixtypes = List.map (fun c -> nf_evar !evdref c) fixtypes in
-  let fiximps = List.map3
-    (fun ctximps cclimps (_,ctx) -> ctximps@(Impargs.lift_implicits (Context.Rel.nhyps ctx) cclimps))
-    fixctximps fixcclimps fixctxs in
-  let rec_sign =
-    List.fold_left2
-      (fun env' id t ->
- 	 if Flags.is_program_mode () then
-	   let sort = Evarutil.evd_comb1 (Typing.type_of ~refresh:true env) evdref t in
-	   let fixprot =
-	     try 
-	       let app = mkApp (fix_proto evdref, [|sort; t|]) in
-		 Typing.e_solve_evars env evdref app
-	     with e  when CErrors.noncritical e -> t
-	   in
-	     LocalAssum (id,fixprot) :: env'
-	 else LocalAssum (id,t) :: env')
-      [] fixnames fixtypes
-  in
-  let env_rec = push_named_context rec_sign env in
-
-  (* Get interpretation metadatas *)
-  let fixtypes = List.map EConstr.Unsafe.to_constr fixtypes in
-  let fixccls = List.map EConstr.Unsafe.to_constr fixccls in
-  let impls = compute_internalization_env env Recursive fixnames fixtypes fiximps in
-
-  (* Interp bodies with rollback because temp use of notations/implicit *)
-  let fixdefs =
-    Metasyntax.with_syntax_protection (fun () ->
-      List.iter (Metasyntax.set_notation_for_interpretation impls) notations;
-      List.map4
-	(fun fixctximpenv -> interp_fix_body env_rec evdref (Id.Map.fold Id.Map.add fixctximpenv impls))
-	fixctximpenvs fixctxs fixl fixccls)
-      () in
-
-  (* Instantiate evars and check all are resolved *)
-  let evd = solve_unif_constraints_with_heuristics env_rec !evdref in
-  let evd, nf = nf_evars_and_universes evd in
-  let fixdefs = List.map (fun c -> Option.map EConstr.Unsafe.to_constr c) fixdefs in
-  let fixdefs = List.map (Option.map nf) fixdefs in
-  let fixtypes = List.map nf fixtypes in
-  let fixctxs = List.map (fun (_,ctx) -> ctx) fixctxs in
-
-  (* Build the fix declaration block *)
-  (env,rec_sign,all_universes,evd), (fixnames,fixdefs,fixtypes), List.combine3 fixctxs fiximps fixannots
-
-let check_recursive isfix env evd (fixnames,fixdefs,_) =
-  check_evars_are_solved env evd Evd.empty;
-  if List.for_all Option.has_some fixdefs then begin
-    let fixdefs = List.map Option.get fixdefs in
-    check_mutuality env evd isfix (List.combine fixnames fixdefs)
-  end
-
-let interp_fixpoint l ntns =
-  let (env,_,pl,evd),fix,info = interp_recursive true l ntns in
-  check_recursive true env evd fix;
-  (fix,pl,Evd.evar_universe_context evd,info)
-
-let interp_cofixpoint l ntns =
-  let (env,_,pl,evd),fix,info = interp_recursive false l ntns in
-  check_recursive false env evd fix;
-  (fix,pl,Evd.evar_universe_context evd,info)
-    
-let declare_fixpoint local poly ((fixnames,fixdefs,fixtypes),pl,ctx,fiximps) indexes ntns =
-  if List.exists Option.is_empty fixdefs then
-    (* Some bodies to define by proof *)
-    let thms =
-      List.map3 (fun id t (ctx,imps,_) -> ((id,pl),(t,(List.map RelDecl.get_name ctx,imps))))
-		fixnames fixtypes fiximps in
-    let init_tac =
-      Some (List.map (Option.cata (EConstr.of_constr %> Tactics.exact_no_check) Tacticals.New.tclIDTAC)
-        fixdefs) in
-    let evd = Evd.from_ctx ctx in
-    Lemmas.start_proof_with_initialization (Global,poly,DefinitionBody Fixpoint)
-      evd (Some(false,indexes,init_tac)) thms None (Lemmas.mk_hook (fun _ _ -> ()))
-  else begin
-    (* We shortcut the proof process *)
-    let fixdefs = List.map Option.get fixdefs in
-    let fixdecls = prepare_recursive_declaration fixnames fixtypes fixdefs in
-    let env = Global.env() in
-    let indexes = search_guard env indexes fixdecls in
-    let fiximps = List.map (fun (n,r,p) -> r) fiximps in
-    let vars = Univops.universes_of_constr (mkFix ((indexes,0),fixdecls)) in
-    let fixdecls =
-      List.map_i (fun i _ -> mkFix ((indexes,i),fixdecls)) 0 fixnames in
-    let evd = Evd.from_ctx ctx in
-    let evd = Evd.restrict_universe_context evd vars in
-    let fixdecls = List.map Safe_typing.mk_pure_proof fixdecls in
-    let pl, ctx = Evd.universe_context ?names:pl evd in
-    ignore (List.map4 (DeclareDef.declare_fix (local, poly, Fixpoint) pl ctx)
-	      fixnames fixdecls fixtypes fiximps);
-    (* Declare the recursive definitions *)
-    fixpoint_message (Some indexes) fixnames;
-  end;
-  (* Declare notations *)
-  List.iter Metasyntax.add_notation_interpretation ntns
-
-let declare_cofixpoint local poly ((fixnames,fixdefs,fixtypes),pl,ctx,fiximps) ntns =
-  if List.exists Option.is_empty fixdefs then
-    (* Some bodies to define by proof *)
-    let thms =
-      List.map3 (fun id t (ctx,imps,_) -> ((id,pl),(t,(List.map RelDecl.get_name ctx,imps))))
-		fixnames fixtypes fiximps in
-    let init_tac =
-      Some (List.map (Option.cata (EConstr.of_constr %> Tactics.exact_no_check) Tacticals.New.tclIDTAC)
-        fixdefs) in
-    let evd = Evd.from_ctx ctx in
-      Lemmas.start_proof_with_initialization (Global,poly, DefinitionBody CoFixpoint)
-      evd (Some(true,[],init_tac)) thms None (Lemmas.mk_hook (fun _ _ -> ()))
-  else begin
-    (* We shortcut the proof process *)
-    let fixdefs = List.map Option.get fixdefs in
-    let fixdecls = prepare_recursive_declaration fixnames fixtypes fixdefs in
-    let fixdecls = List.map_i (fun i _ -> mkCoFix (i,fixdecls)) 0 fixnames in
-    let vars = Univops.universes_of_constr (List.hd fixdecls) in
-    let fixdecls = List.map Safe_typing.mk_pure_proof fixdecls in
-    let fiximps = List.map (fun (len,imps,idx) -> imps) fiximps in
-    let evd = Evd.from_ctx ctx in
-    let evd = Evd.restrict_universe_context evd vars in
-    let pl, ctx = Evd.universe_context ?names:pl evd in
-    ignore (List.map4 (DeclareDef.declare_fix (local, poly, CoFixpoint) pl ctx) 
-	      fixnames fixdecls fixtypes fiximps);
-    (* Declare the recursive definitions *)
-    cofixpoint_message fixnames
-  end;
-  (* Declare notations *)
-  List.iter Metasyntax.add_notation_interpretation ntns
-
-let extract_decreasing_argument limit = function
-  | (na,CStructRec) -> na
-  | (na,_) when not limit -> na
-  | _ -> user_err Pp.(str 
-      "Only structural decreasing is supported for a non-Program Fixpoint")
-
-let extract_fixpoint_components limit l =
-  let fixl, ntnl = List.split l in
-  let fixl = List.map (fun (((_,id),pl),ann,bl,typ,def) ->
-    let ann = extract_decreasing_argument limit ann in
-      {fix_name = id; fix_annot = ann; fix_univs = pl;
-       fix_binders = bl; fix_body = def; fix_type = typ}) fixl in
-  fixl, List.flatten ntnl
-
-let extract_cofixpoint_components l =
-  let fixl, ntnl = List.split l in
-  List.map (fun (((_,id),pl),bl,typ,def) ->
-	    {fix_name = id; fix_annot = None; fix_univs = pl;
-	     fix_binders = bl; fix_body = def; fix_type = typ}) fixl,
-  List.flatten ntnl
-
-let out_def = function
-  | Some def -> def
-  | None -> user_err Pp.(str "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 = 
-    interp_recursive isfix fixl ntns 
-  in
-    (* Program-specific code *)
-    (* Get the interesting evars, those that were not instanciated *)
-  let evd = Typeclasses.resolve_typeclasses ~filter:Typeclasses.no_goals ~fail:true env evd in
-    (* Solve remaining evars *)
-  let evd = nf_evar_map_undefined evd in
-  let collect_evars id def typ imps =
-    (* Generalize by the recursive prototypes  *)
-    let def =
-      EConstr.to_constr evd (Termops.it_mkNamedLambda_or_LetIn (EConstr.of_constr def) rec_sign)
-    and typ =
-      EConstr.to_constr evd (Termops.it_mkNamedProd_or_LetIn (EConstr.of_constr typ) rec_sign)
-    in
-    let evm = collect_evars_of_term evd def typ in
-    let evars, _, def, typ = 
-      Obligations.eterm_obligations env id evm
-	(List.length rec_sign) def typ
-    in (id, def, typ, imps, evars)
-  in
-  let (fixnames,fixdefs,fixtypes) = fix in
-  let fiximps = List.map pi2 info in
-  let fixdefs = List.map out_def fixdefs in
-  let defs = List.map4 collect_evars fixnames fixdefs fixtypes fiximps in
-  let () = if isfix then begin
-      let possible_indexes = List.map compute_possible_guardness_evidences info in
-      let fixdecls = Array.of_list (List.map (fun x -> Name x) fixnames),
-	Array.of_list fixtypes,
-	Array.of_list (List.map (subst_vars (List.rev fixnames)) fixdefs)
-      in
-      let indexes = 
-        Pretyping.search_guard (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
-  | Obligations.IsFixpoint _ -> (local, p, Fixpoint)
-  | Obligations.IsCoFixpoint -> (local, p, CoFixpoint)
-  in
-  Obligations.add_mutual_definitions defs ~kind ?pl ctx ntns fixkind
-
-let do_program_fixpoint local poly l =
-  let g = List.map (fun ((_,wf,_,_,_),_) -> wf) l in
-    match g, l with
-    | [(n, CWfRec r)], [((((_,id),pl),_,bl,typ,def),ntn)] ->
-	let recarg = 
-	  match n with
-	  | Some n -> mkIdentC (snd n)
-	  | None ->
-	      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
-	     
-    | [(n, CMeasureRec (m, r))], [((((_,id),pl),_,bl,typ,def),ntn)] ->
-	build_wellfounded (id, pl, n, bl, typ, out_def def) poly
-	  (Option.default (CAst.make @@ CRef (lt_ref,None)) r) m ntn
-	  
-    | _, _ when List.for_all (fun (n, ro) -> ro == CStructRec) g ->
-	let fixl,ntns = extract_fixpoint_components true l in
-	let fixkind = Obligations.IsFixpoint g in
-	  do_program_recursive local poly fixkind fixl ntns
-
-    | _, _ ->
-	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
-    let fixl, ntns = extract_fixpoint_components true l in
-    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;
-    if not (check_safe ()) then Feedback.feedback Feedback.AddedAxiom else ()
-
-let do_cofixpoint local poly l =
-  let fixl,ntns = extract_cofixpoint_components l in
-    if Flags.is_program_mode () then
-      do_program_recursive local poly Obligations.IsCoFixpoint fixl ntns
-    else
-      let cofix = interp_cofixpoint fixl ntns in
-      declare_cofixpoint local poly cofix ntns;
-      if not (check_safe ()) then Feedback.feedback Feedback.AddedAxiom else ()
diff --git a/vernac/command.mli b/vernac/command.mli
deleted file mode 100644
index 8d17f27c3..000000000
--- a/vernac/command.mli
+++ /dev/null
@@ -1,163 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-open Names
-open Term
-open Entries
-open Libnames
-open Globnames
-open Vernacexpr
-open Constrexpr
-open Decl_kinds
-open Redexpr
-
-(** This file is about the interpretation of raw commands into typed
-    ones and top-level declaration of the main Gallina objects *)
-
-val do_universe : polymorphic -> Id.t Loc.located list -> unit
-val do_constraint : polymorphic ->
-  (Misctypes.glob_level * Univ.constraint_type * Misctypes.glob_level) list -> unit
-
-(** {6 Definitions/Let} *)
-
-val interp_definition :
-  lident list option -> local_binder_expr list -> polymorphic -> red_expr option -> constr_expr ->
-  constr_expr option -> Safe_typing.private_constants definition_entry * Evd.evar_map * 
-      Universes.universe_binders * Impargs.manual_implicits
-
-val do_definition : Id.t -> definition_kind -> lident list option ->
-  local_binder_expr list -> red_expr option -> constr_expr ->
-  constr_expr option -> unit Lemmas.declaration_hook -> unit
-
-(** {6 Parameters/Assumptions} *)
-
-(* val interp_assumption : env -> evar_map ref -> *)
-(*   local_binder_expr list -> constr_expr ->  *)
-(*   types Univ.in_universe_context_set * Impargs.manual_implicits *)
-
-(** returns [false] if the assumption is neither local to a section,
-    nor in a module type and meant to be instantiated. *)
-val declare_assumption : coercion_flag -> assumption_kind -> 
-  types Univ.in_universe_context_set ->
-  Universes.universe_binders -> Impargs.manual_implicits ->
-  bool (** implicit *) -> Vernacexpr.inline -> variable Loc.located ->
-  global_reference * Univ.Instance.t * bool
-
-val do_assumptions : locality * polymorphic * assumption_object_kind ->
-  Vernacexpr.inline -> (plident list * constr_expr) with_coercion list -> bool
-
-(* val declare_assumptions : variable Loc.located list -> *)
-(*   coercion_flag -> assumption_kind -> types Univ.in_universe_context_set ->  *)
-(*   Impargs.manual_implicits -> bool -> Vernacexpr.inline -> bool *)
-
-(** {6 Inductive and coinductive types} *)
-
-(** Extracting the semantical components out of the raw syntax of mutual
-   inductive declarations *)
-
-type structured_one_inductive_expr = {
-  ind_name : Id.t;
-  ind_univs : lident list option;
-  ind_arity : constr_expr;
-  ind_lc : (Id.t * constr_expr) list
-}
-
-type structured_inductive_expr =
-  local_binder_expr list * structured_one_inductive_expr list
-
-val extract_mutual_inductive_declaration_components :
-  (one_inductive_expr * decl_notation list) list ->
-    structured_inductive_expr * (*coercions:*) qualid list * decl_notation list
-
-(** Typing mutual inductive definitions *)
-
-type one_inductive_impls =
-  Impargs.manual_implicits (** for inds *)*
-  Impargs.manual_implicits list (** for constrs *)
-
-val interp_mutual_inductive :
-  structured_inductive_expr -> decl_notation list -> cumulative_inductive_flag ->
-  polymorphic -> private_flag -> Decl_kinds.recursivity_kind ->
-  mutual_inductive_entry * Universes.universe_binders * one_inductive_impls list
-
-(** Registering a mutual inductive definition together with its
-   associated schemes *)
-
-val declare_mutual_inductive_with_eliminations :
-  mutual_inductive_entry -> Universes.universe_binders -> one_inductive_impls list ->
-  mutual_inductive
-
-(** Entry points for the vernacular commands Inductive and CoInductive *)
-
-val do_mutual_inductive :
-  (one_inductive_expr * decl_notation list) list -> cumulative_inductive_flag ->
-  polymorphic -> private_flag -> Decl_kinds.recursivity_kind -> unit
-
-(** {6 Fixpoints and cofixpoints} *)
-
-type structured_fixpoint_expr = {
-  fix_name : Id.t;
-  fix_univs : lident list option;
-  fix_annot : Id.t Loc.located option;
-  fix_binders : local_binder_expr list;
-  fix_body : constr_expr option;
-  fix_type : constr_expr
-}
-
-(** Extracting the semantical components out of the raw syntax of
-   (co)fixpoints declarations *)
-
-val extract_fixpoint_components : bool ->
-  (fixpoint_expr * decl_notation list) list ->
-    structured_fixpoint_expr list * decl_notation list
-
-val extract_cofixpoint_components :
-  (cofixpoint_expr * decl_notation list) list ->
-    structured_fixpoint_expr list * decl_notation list
-
-(** Typing global fixpoints and cofixpoint_expr *)
-
-type recursive_preentry =
-  Id.t list * constr option list * types list
-
-val interp_fixpoint :
-  structured_fixpoint_expr list -> decl_notation list ->
-    recursive_preentry * lident list option * Evd.evar_universe_context * 
-    (EConstr.rel_context * Impargs.manual_implicits * int option) list
-
-val interp_cofixpoint :
-  structured_fixpoint_expr list -> decl_notation list ->
-    recursive_preentry * lident list option * Evd.evar_universe_context * 
-    (EConstr.rel_context * Impargs.manual_implicits * int option) list
-
-(** Registering fixpoints and cofixpoints in the environment *)
-
-val declare_fixpoint :
-  locality -> polymorphic ->
-  recursive_preentry * lident list option * Evd.evar_universe_context * 
-  (Context.Rel.t * Impargs.manual_implicits * int option) list ->
-  Proof_global.lemma_possible_guards -> decl_notation list -> unit
-
-val declare_cofixpoint : locality -> polymorphic -> 
-  recursive_preentry * lident list option * Evd.evar_universe_context * 
-  (Context.Rel.t * Impargs.manual_implicits * int option) list ->
-  decl_notation list -> unit
-
-(** 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 *)
-
-val check_mutuality : Environ.env -> Evd.evar_map -> bool -> (Id.t * types) list -> unit
diff --git a/vernac/declareDef.ml b/vernac/declareDef.ml
index d7a4fcca3..dfac78c04 100644
--- a/vernac/declareDef.ml
+++ b/vernac/declareDef.ml
@@ -11,18 +11,17 @@ open Declare
 open Entries
 open Globnames
 open Impargs
-open Nameops
 
 let warn_definition_not_visible =
   CWarnings.create ~name:"definition-not-visible" ~category:"implicits"
     Pp.(fun ident ->
         strbrk "Section definition " ++
-        pr_id ident ++ strbrk " is not visible from current goals")
+        Names.Id.print ident ++ strbrk " is not visible from current goals")
 
 let warn_local_declaration =
   CWarnings.create ~name:"local-declaration" ~category:"scope"
     Pp.(fun (id,kind) ->
-        pr_id id ++ strbrk " is declared as a local " ++ str kind)
+        Names.Id.print id ++ strbrk " is declared as a local " ++ str kind)
 
 let get_locality id ~kind = function
 | Discharge ->
@@ -37,7 +36,7 @@ let declare_global_definition ident ce local k pl imps =
   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
-  let () = Universes.register_universe_binders gr pl in
+  let () = Declare.declare_univ_binders gr pl in
   let () = definition_message ident in
   gr
 
@@ -50,6 +49,7 @@ let declare_definition ident (local, p, k) ce pl imps hook =
     let () = definition_message ident in
     let gr = VarRef ident in
     let () = maybe_declare_manual_implicits false gr imps in
+    let () = Declare.declare_univ_binders gr pl in
     let () = if Proof_global.there_are_pending_proofs () then
 	       warn_definition_not_visible ident
     in
@@ -58,7 +58,7 @@ let declare_definition ident (local, p, k) ce pl imps hook =
     declare_global_definition ident ce local k pl imps in
   Lemmas.call_hook fix_exn hook local r
 
-let declare_fix ?(opaque = false) (_,poly,_ as kind) pl ctx f ((def,_),eff) t imps =
-  let ce = definition_entry ~opaque ~types:t ~poly ~univs:ctx ~eff def in
+let declare_fix ?(opaque = false) (_,poly,_ as kind) pl univs f ((def,_),eff) t imps =
+  let ce = definition_entry ~opaque ~types:t ~univs ~eff def in
   declare_definition f kind ce pl imps (Lemmas.mk_hook (fun _ r -> r))
 
diff --git a/vernac/declareDef.mli b/vernac/declareDef.mli
index 5dea0ba27..55f7c7861 100644
--- a/vernac/declareDef.mli
+++ b/vernac/declareDef.mli
@@ -15,5 +15,8 @@ val declare_definition : Id.t -> definition_kind ->
   Safe_typing.private_constants Entries.definition_entry -> Universes.universe_binders -> Impargs.manual_implicits ->
     Globnames.global_reference Lemmas.declaration_hook -> Globnames.global_reference
 
-val declare_fix : ?opaque:bool -> definition_kind -> Universes.universe_binders -> Univ.universe_context -> Id.t ->
-  Safe_typing.private_constants Entries.proof_output -> Constr.types -> Impargs.manual_implicits -> Globnames.global_reference
+val declare_fix : ?opaque:bool -> definition_kind ->
+  Universes.universe_binders -> Entries.constant_universes_entry ->
+  Id.t -> Safe_typing.private_constants Entries.proof_output ->
+  Constr.types -> Impargs.manual_implicits ->
+  Globnames.global_reference
diff --git a/vernac/explainErr.ml b/vernac/explainErr.ml
index 2178a7caa..fc3495796 100644
--- a/vernac/explainErr.ml
+++ b/vernac/explainErr.ml
@@ -32,6 +32,7 @@ let explain_exn_default = function
   | Sys_error msg -> hov 0 (str "System error: " ++ guill msg)
   | Out_of_memory -> hov 0 (str "Out of memory.")
   | Stack_overflow -> hov 0 (str "Stack overflow.")
+  | Dynlink.Error e -> hov 0 (str "Dynlink error: " ++ str Dynlink.(error_message e))
   | Timeout -> hov 0 (str "Timeout!")
   | Sys.Break -> hov 0 (fnl () ++ str "User interrupt.")
   (* Exceptions with pre-evaluated error messages *)
@@ -75,8 +76,8 @@ let process_vernac_interp_error exn = match fst exn with
       wrap_vernac_error exn (Himsg.explain_pattern_matching_error env sigma e)
   | Tacred.ReductionTacticError e ->
       wrap_vernac_error exn (Himsg.explain_reduction_tactic_error e)
-  | Logic.RefinerError e ->
-      wrap_vernac_error exn (Himsg.explain_refiner_error e)
+  | Logic.RefinerError (env, sigma, e) ->
+    wrap_vernac_error exn (Himsg.explain_refiner_error env sigma e)
   | Nametab.GlobalizationError q ->
       wrap_vernac_error exn
         (str "The reference" ++ spc () ++ Libnames.pr_qualid q ++
diff --git a/vernac/himsg.ml b/vernac/himsg.ml
index 2be10a039..f00c1e604 100644
--- a/vernac/himsg.ml
+++ b/vernac/himsg.ml
@@ -11,7 +11,7 @@ open Util
 open Names
 open Nameops
 open Namegen
-open Term
+open Constr
 open Termops
 open Indtypes
 open Environ
@@ -83,18 +83,16 @@ let rec contract3' env sigma a b c = function
 
 (** Ad-hoc reductions *)
 
-let j_nf_betaiotaevar sigma j =
-  { uj_val = Evarutil.nf_evar sigma j.uj_val;
-    uj_type = Reductionops.nf_betaiota sigma j.uj_type }
+let j_nf_betaiotaevar env sigma j =
+  { uj_val = j.uj_val;
+    uj_type = Reductionops.nf_betaiota env sigma j.uj_type }
 
-let jv_nf_betaiotaevar sigma jl =
-  Array.map (fun j -> j_nf_betaiotaevar sigma j) jl
+let jv_nf_betaiotaevar env sigma jl =
+  Array.map (fun j -> j_nf_betaiotaevar env sigma j) jl
 
 (** Printers *)
 
-let pr_lconstr c = quote (pr_lconstr c)
 let pr_lconstr_env e s c = quote (pr_lconstr_env e s c)
-let pr_leconstr c = quote (pr_leconstr c)
 let pr_leconstr_env e s c = quote (pr_leconstr_env e s c)
 let pr_ljudge_env e s c = let v,t = pr_ljudge_env e s c in (quote v,quote t)
 
@@ -159,7 +157,7 @@ let pr_explicit env sigma t1 t2 =
 let pr_db env i =
   try
     match env |> lookup_rel i |> get_name with
-      | Name id -> pr_id id
+      | Name id -> Id.print id
       | Anonymous -> str "<>"
   with Not_found -> str "UNBOUND_REL_" ++ int i
 
@@ -169,11 +167,10 @@ let explain_unbound_rel env sigma n =
   str "The reference " ++ int n ++ str " is free."
 
 let explain_unbound_var env v =
-  let var = pr_id v in
+  let var = Id.print v in
   str "No such section variable or assumption: " ++ var ++ str "."
 
 let explain_not_type env sigma j =
-  let j = Evarutil.j_nf_evar sigma j in
   let pe = pr_ne_context_of (str "In environment") env sigma in
   let pc,pt = pr_ljudge_env env sigma j in
   pe ++ str "The term" ++ brk(1,1) ++ pc ++ spc () ++
@@ -190,7 +187,7 @@ let explain_bad_assumption env sigma j =
 let explain_reference_variables sigma id c =
   (* c is intended to be a global reference *)
   let pc = pr_global (fst (Termops.global_of_constr sigma c)) in
-  pc ++ strbrk " depends on the variable " ++ pr_id id ++
+  pc ++ strbrk " depends on the variable " ++ Id.print id ++
   strbrk " which is not declared in the context."
 
 let rec pr_disjunction pr = function
@@ -241,7 +238,6 @@ let explain_elim_arity env sigma ind sorts c pj okinds =
   fnl () ++ msg
 
 let explain_case_not_inductive env sigma cj =
-  let cj = Evarutil.j_nf_evar sigma cj in
   let env = make_all_name_different env sigma in
   let pc = pr_leconstr_env env sigma cj.uj_val in
   let pct = pr_leconstr_env env sigma cj.uj_type in
@@ -254,7 +250,6 @@ let explain_case_not_inductive env sigma cj =
 	  str "which is not a (co-)inductive type."
 
 let explain_number_branches env sigma cj expn =
-  let cj = Evarutil.j_nf_evar sigma cj in
   let env = make_all_name_different env sigma in
   let pc = pr_leconstr_env env sigma cj.uj_val in
   let pct = pr_leconstr_env env sigma cj.uj_type in
@@ -263,7 +258,7 @@ let explain_number_branches env sigma cj expn =
   str "expects " ++  int expn ++ str " branches."
 
 let explain_ill_formed_branch env sigma c ci actty expty =
-  let simp t = Reductionops.nf_betaiota sigma (Evarutil.nf_evar sigma t) in
+  let simp t = Reductionops.nf_betaiota env sigma t in
   let env = make_all_name_different env sigma in
   let pc = pr_leconstr_env env sigma c in
   let pa, pe = pr_explicit env sigma (simp actty) (simp expty) in
@@ -300,10 +295,10 @@ let explain_unification_error env sigma p1 p2 = function
      | NotSameArgSize | NotSameHead | NoCanonicalStructure ->
         (* Error speaks from itself *) []
      | ConversionFailed (env,t1,t2) ->
+        let t1 = Reductionops.nf_betaiota env sigma t1 in
+        let t2 = Reductionops.nf_betaiota env sigma t2 in
         if EConstr.eq_constr sigma t1 p1 && EConstr.eq_constr sigma t2 p2 then [] else
         let env = make_all_name_different env sigma in
-        let t1 = Evarutil.nf_evar sigma t1 in
-        let t2 = Evarutil.nf_evar sigma t2 in
         if not (EConstr.eq_constr sigma t1 p1) || not (EConstr.eq_constr sigma t2 p2) then
           let t1, t2 = pr_explicit env sigma t1 t2 in
           [str "cannot unify " ++ t1 ++ strbrk " and " ++ t2]
@@ -327,8 +322,6 @@ let explain_unification_error env sigma p1 p2 = function
      | CannotSolveConstraint ((pb,env,t,u),e) ->
         let t = EConstr.of_constr t in
         let u = EConstr.of_constr u in
-        let t = Evarutil.nf_evar sigma t in
-        let u = Evarutil.nf_evar sigma u in
         let env = make_all_name_different env sigma in
         (strbrk "cannot satisfy constraint " ++ pr_leconstr_env env sigma t ++
         str " == " ++ pr_leconstr_env env sigma u)
@@ -343,8 +336,8 @@ let explain_unification_error env sigma p1 p2 = function
 
 let explain_actual_type env sigma j t reason =
   let env = make_all_name_different env sigma in
-  let j = j_nf_betaiotaevar sigma j in
-  let t = Reductionops.nf_betaiota sigma t in
+  let j = j_nf_betaiotaevar env sigma j in
+  let t = Reductionops.nf_betaiota env sigma t in
   (** Actually print *)
   let pe = pr_ne_context_of (str "In environment") env sigma in
   let pc = pr_leconstr_env env sigma (Environ.j_val j) in
@@ -358,10 +351,8 @@ let explain_actual_type env sigma j t reason =
   ppreason ++ str ".")
 
 let explain_cant_apply_bad_type env sigma (n,exptyp,actualtyp) rator randl =
-  let randl = jv_nf_betaiotaevar sigma randl in
-  let exptyp = Evarutil.nf_evar sigma exptyp in
-  let actualtyp = Reductionops.nf_betaiota sigma actualtyp in
-  let rator = Evarutil.j_nf_evar sigma rator in
+  let randl = jv_nf_betaiotaevar env sigma randl in
+  let actualtyp = Reductionops.nf_betaiota env sigma actualtyp in
   let env = make_all_name_different env sigma in
   let actualtyp, exptyp = pr_explicit env sigma actualtyp exptyp in
   let nargs = Array.length randl in
@@ -386,8 +377,6 @@ let explain_cant_apply_bad_type env sigma (n,exptyp,actualtyp) rator randl =
   exptyp ++ str "."
 
 let explain_cant_apply_not_functional env sigma rator randl =
-  let randl = Evarutil.jv_nf_evar sigma randl in
-  let rator = Evarutil.j_nf_evar sigma rator in
   let env = make_all_name_different env sigma in
   let nargs = Array.length randl in
 (*  let pe = pr_ne_context_of (str "in environment") env sigma in*)
@@ -407,8 +396,6 @@ let explain_cant_apply_not_functional env sigma rator randl =
   fnl () ++ str " " ++ v 0 appl
 
 let explain_unexpected_type env sigma actual_type expected_type =
-  let actual_type = Evarutil.nf_evar sigma actual_type in
-  let expected_type = Evarutil.nf_evar sigma expected_type in
   let pract, prexp = pr_explicit env sigma actual_type expected_type in
   str "Found type" ++ spc () ++ pract ++ spc () ++
   str "where" ++ spc () ++ prexp ++ str " was expected."
@@ -418,7 +405,7 @@ let explain_not_product env sigma c =
   let pr = pr_lconstr_env env sigma c in
   str "The type of this term is a product" ++ spc () ++
   str "while it is expected to be" ++
-  (if is_Type c then str " a sort" else (brk(1,1) ++ pr)) ++ str "."
+  (if Constr.is_Type c then str " a sort" else (brk(1,1) ++ pr)) ++ str "."
 
 (* TODO: use the names *)
 (* (co)fixpoints *)
@@ -426,7 +413,7 @@ let explain_ill_formed_rec_body env sigma err names i fixenv vdefj =
   let pr_lconstr_env env sigma c = pr_leconstr_env env sigma c in
   let prt_name i =
     match names.(i) with
-        Name id -> str "Recursive definition of " ++ pr_id id
+        Name id -> str "Recursive definition of " ++ Id.print id
       | Anonymous -> str "The " ++ pr_nth i ++ str " definition" in
 
   let st = match err with
@@ -441,7 +428,7 @@ let explain_ill_formed_rec_body env sigma err names i fixenv vdefj =
       let arg_env = make_all_name_different arg_env sigma in
       let called =
         match names.(j) with
-            Name id -> pr_id id
+            Name id -> Id.print id
           | Anonymous -> str "the " ++ pr_nth i ++ str " definition" in
       let pr_db x = quote (pr_db env x) in
       let vars =
@@ -461,7 +448,7 @@ let explain_ill_formed_rec_body env sigma err names i fixenv vdefj =
   | NotEnoughArgumentsForFixCall j ->
       let called =
         match names.(j) with
-            Name id -> pr_id id
+            Name id -> Id.print id
           | Anonymous -> str "the " ++ pr_nth i ++ str " definition" in
      str "Recursive call to " ++ called ++ str " has not enough arguments"
 
@@ -510,8 +497,6 @@ let explain_ill_formed_rec_body env sigma err names i fixenv vdefj =
     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
-  let vargs = Array.map (Evarutil.nf_evar sigma) vargs in
   let env = make_all_name_different env sigma in
   let pvd = pr_leconstr_env env sigma vdefj.(i).uj_val in
   let pvdt, pv = pr_explicit env sigma vdefj.(i).uj_type vargs.(i) in
@@ -541,7 +526,7 @@ let pr_trailing_ne_context_of env sigma =
 
 let rec explain_evar_kind env sigma evk ty = function
   | Evar_kinds.NamedHole id ->
-      strbrk "the existential variable named " ++ pr_id id
+      strbrk "the existential variable named " ++ Id.print id
   | Evar_kinds.QuestionMark _ ->
       strbrk "this placeholder of type " ++ ty
   | Evar_kinds.CasesType false ->
@@ -550,12 +535,12 @@ let rec explain_evar_kind env sigma evk ty = function
       strbrk "a subterm of type " ++ ty ++
       strbrk " in the type of this pattern-matching problem"
   | Evar_kinds.BinderType (Name id) ->
-      strbrk "the type of " ++ Nameops.pr_id id
+      strbrk "the type of " ++ Id.print id
   | Evar_kinds.BinderType Anonymous ->
       strbrk "the type of this anonymous binder"
   | Evar_kinds.ImplicitArg (c,(n,ido),b) ->
       let id = Option.get ido in
-      strbrk "the implicit parameter " ++ pr_id id ++ spc () ++ str "of" ++
+      strbrk "the implicit parameter " ++ Id.print id ++ spc () ++ str "of" ++
       spc () ++ Nametab.pr_global_env Id.Set.empty c ++
       strbrk " whose type is " ++ ty
   | Evar_kinds.InternalHole -> strbrk "an internal placeholder of type " ++ ty
@@ -571,13 +556,13 @@ let rec explain_evar_kind env sigma evk ty = function
       assert false
   | Evar_kinds.VarInstance id ->
       strbrk "an instance of type " ++ ty ++
-      str " for the variable " ++ pr_id id
+      str " for the variable " ++ Id.print id
   | Evar_kinds.SubEvar evk' ->
       let evi = Evd.find sigma evk' in
       let pc = match evi.evar_body with
-      | Evar_defined c -> pr_leconstr_env env sigma (Evarutil.nf_evar sigma (EConstr.of_constr c))
+      | Evar_defined c -> pr_leconstr_env env sigma (EConstr.of_constr c)
       | Evar_empty -> assert false in
-      let ty' = Evarutil.nf_evar sigma (EConstr.of_constr evi.evar_concl) in
+      let ty' = EConstr.of_constr evi.evar_concl in
       pr_existential_key sigma evk ++ str " of type " ++ ty ++
       str " in the partial instance " ++ pc ++
       str " found for " ++ explain_evar_kind env sigma evk'
@@ -611,7 +596,7 @@ let explain_unsolvable_implicit env sigma evk explain =
   explain_placeholder_kind env sigma evi.evar_concl explain ++ pe
 
 let explain_var_not_found env id =
-  str "The variable" ++ spc () ++ pr_id id ++
+  str "The variable" ++ spc () ++ Id.print id ++
   spc () ++ str "was not found" ++
   spc () ++ str "in the current" ++ spc () ++ str "environment" ++ str "."
 
@@ -628,8 +613,6 @@ let explain_wrong_case_info env (ind,u) ci =
 
 let explain_cannot_unify env sigma m n e =
   let env = make_all_name_different env sigma in
-  let m = Evarutil.nf_evar sigma m in
-  let n = Evarutil.nf_evar sigma n in
   let pm, pn = pr_explicit env sigma m n in
   let ppreason = explain_unification_error env sigma m n e in
   let pe = pr_ne_context_of (str "In environment") env sigma in
@@ -653,7 +636,7 @@ let explain_no_occurrence_found env sigma c id =
   str "Found no subterm matching " ++ pr_lconstr_env env sigma c ++
   str " in " ++
     (match id with
-      | Some id -> pr_id id
+      | Some id -> Id.print id
       | None -> str"the current goal") ++ str "."
 
 let explain_cannot_unify_binding_type env sigma m n =
@@ -675,7 +658,7 @@ let explain_wrong_abstraction_type env sigma na abs expected result =
   let abs = EConstr.to_constr sigma abs in
   let expected = EConstr.to_constr sigma expected in
   let result = EConstr.to_constr sigma result in
-  let ppname = match na with Name id -> pr_id id ++ spc () | _ -> mt () in
+  let ppname = match na with Name id -> Id.print id ++ spc () | _ -> mt () in
   str "Cannot instantiate metavariable " ++ ppname ++ strbrk "of type " ++
   pr_lconstr_env env sigma expected ++ strbrk " with abstraction " ++
   pr_lconstr_env env sigma abs ++ strbrk " of incompatible type " ++
@@ -738,9 +721,9 @@ let explain_type_error env sigma err =
 let pr_position (cl,pos) =
   let clpos = match cl with
     | None -> str " of the goal"
-    | Some (id,Locus.InHyp) -> str " of hypothesis " ++ pr_id id
-    | Some (id,Locus.InHypTypeOnly) -> str " of the type of hypothesis " ++ pr_id id
-    | Some (id,Locus.InHypValueOnly) -> str " of the body of hypothesis " ++ pr_id id in
+    | Some (id,Locus.InHyp) -> str " of hypothesis " ++ Id.print id
+    | Some (id,Locus.InHypTypeOnly) -> str " of the type of hypothesis " ++ Id.print id
+    | Some (id,Locus.InHypValueOnly) -> str " of the body of hypothesis " ++ Id.print id in
   int pos ++ clpos
 
 let explain_cannot_unify_occurrences env sigma nested ((cl2,pos2),t2) ((cl1,pos1),t1) e =
@@ -859,7 +842,7 @@ let explain_not_match_error = function
   | ModuleTypeFieldExpected ->
     strbrk "a module type is expected"
   | NotConvertibleInductiveField id | NotConvertibleConstructorField id ->
-    str "types given to " ++ pr_id id ++ str " differ"
+    str "types given to " ++ Id.print id ++ str " differ"
   | NotConvertibleBodyField ->
     str "the body of definitions differs"
   | NotConvertibleTypeField (env, typ1, typ2) ->
@@ -884,7 +867,7 @@ let explain_not_match_error = function
   | RecordProjectionsExpected nal ->
     (if List.length nal >= 2 then str "expected projection names are "
      else str "expected projection name is ") ++
-    pr_enum (function Name id -> pr_id id | _ -> str "_") nal
+    pr_enum (function Name id -> Id.print id | _ -> str "_") nal
   | NotEqualInductiveAliases ->
     str "Aliases to inductive types do not match"
   | NoTypeConstraintExpected ->
@@ -914,11 +897,11 @@ let explain_not_match_error = function
       quote (Univ.pr_constraints (Termops.pr_evd_level Evd.empty) cst)
 
 let explain_signature_mismatch l spec why =
-  str "Signature components for label " ++ pr_label l ++
+  str "Signature components for label " ++ Label.print l ++
   str " do not match:" ++ spc () ++ explain_not_match_error why ++ str "."
 
 let explain_label_already_declared l =
-  str "The label " ++ pr_label l ++ str " is already declared."
+  str "The label " ++ Label.print l ++ str " is already declared."
 
 let explain_application_to_not_path _ =
   strbrk "A module cannot be applied to another module application or " ++
@@ -948,11 +931,11 @@ let explain_not_equal_module_paths mp1 mp2 =
   str "Non equal modules."
 
 let explain_no_such_label l =
-  str "No such label " ++ pr_label l ++ str "."
+  str "No such label " ++ Label.print l ++ str "."
 
 let explain_incompatible_labels l l' =
   str "Opening and closing labels are not the same: " ++
-  pr_label l ++ str " <> " ++ pr_label l' ++ str "!"
+  Label.print l ++ str " <> " ++ Label.print l' ++ str "!"
 
 let explain_not_a_module s =
   quote (str s) ++ str " is not a module."
@@ -961,19 +944,19 @@ let explain_not_a_module_type s =
   quote (str s) ++ str " is not a module type."
 
 let explain_not_a_constant l =
-  quote (pr_label l) ++ str " is not a constant."
+  quote (Label.print l) ++ str " is not a constant."
 
 let explain_incorrect_label_constraint l =
   str "Incorrect constraint for label " ++
-  quote (pr_label l) ++ str "."
+  quote (Label.print l) ++ str "."
 
 let explain_generative_module_expected l =
-  str "The module " ++ pr_label l ++ str " is not generative." ++
+  str "The module " ++ Label.print l ++ str " is not generative." ++
   strbrk " Only components of generative modules can be changed" ++
   strbrk " using the \"with\" construct."
 
 let explain_label_missing l s =
-  str "The field " ++ pr_label l ++ str " is missing in "
+  str "The field " ++ Label.print l ++ str " is missing in "
   ++ str s ++ str "."
 
 let explain_include_restricted_functor mp =
@@ -1031,7 +1014,7 @@ let explain_not_a_class env c =
   pr_constr_env env Evd.empty c ++ str" is not a declared type class."
 
 let explain_unbound_method env cid id =
-  str "Unbound method name " ++ Nameops.pr_id (snd id) ++ spc () ++
+  str "Unbound method name " ++ Id.print (snd id) ++ spc () ++
   str"of class" ++ spc () ++ pr_global cid ++ str "."
 
 let pr_constr_exprs exprs =
@@ -1052,52 +1035,52 @@ let explain_typeclass_error env = function
 
 (* Refiner errors *)
 
-let explain_refiner_bad_type arg ty conclty =
+let explain_refiner_bad_type env sigma arg ty conclty =
   str "Refiner was given an argument" ++ brk(1,1) ++
-  pr_lconstr arg ++ spc () ++
-  str "of type" ++ brk(1,1) ++ pr_lconstr ty ++ spc () ++
-  str "instead of" ++ brk(1,1) ++ pr_lconstr conclty ++ str "."
+  pr_lconstr_env env sigma arg ++ spc () ++
+  str "of type" ++ brk(1,1) ++ pr_lconstr_env env sigma ty ++ spc () ++
+  str "instead of" ++ brk(1,1) ++ pr_lconstr_env env sigma conclty ++ str "."
 
 let explain_refiner_unresolved_bindings l =
   str "Unable to find an instance for the " ++
   str (String.plural (List.length l) "variable") ++ spc () ++
   prlist_with_sep pr_comma Name.print l ++ str"."
 
-let explain_refiner_cannot_apply t harg =
+let explain_refiner_cannot_apply env sigma t harg =
   str "In refiner, a term of type" ++ brk(1,1) ++
-  pr_lconstr t ++ spc () ++ str "could not be applied to" ++ brk(1,1) ++
-  pr_lconstr harg ++ str "."
+  pr_lconstr_env env sigma t ++ spc () ++ str "could not be applied to" ++ brk(1,1) ++
+  pr_lconstr_env env sigma harg ++ str "."
 
-let explain_refiner_not_well_typed c =
-  str "The term " ++ pr_lconstr c ++ str " is not well-typed."
+let explain_refiner_not_well_typed env sigma c =
+  str "The term " ++ pr_lconstr_env env sigma c ++ str " is not well-typed."
 
 let explain_intro_needs_product () =
   str "Introduction tactics needs products."
 
-let explain_does_not_occur_in c hyp =
-  str "The term" ++ spc () ++ pr_lconstr c ++ spc () ++
-  str "does not occur in" ++ spc () ++ pr_id hyp ++ str "."
+let explain_does_not_occur_in env sigma c hyp =
+  str "The term" ++ spc () ++ pr_lconstr_env env sigma c ++ spc () ++
+  str "does not occur in" ++ spc () ++ Id.print hyp ++ str "."
 
-let explain_non_linear_proof c =
-  str "Cannot refine with term" ++ brk(1,1) ++ pr_lconstr c ++
+let explain_non_linear_proof env sigma c =
+  str "Cannot refine with term" ++ brk(1,1) ++ pr_lconstr_env env sigma c ++
   spc () ++ str "because a metavariable has several occurrences."
 
-let explain_meta_in_type c =
-  str "In refiner, a meta appears in the type " ++ brk(1,1) ++ pr_leconstr c ++
+let explain_meta_in_type env sigma c =
+  str "In refiner, a meta appears in the type " ++ brk(1,1) ++ pr_leconstr_env env sigma c ++
   str " of another meta"
 
 let explain_no_such_hyp id =
-  str "No such hypothesis: " ++ pr_id id
+  str "No such hypothesis: " ++ Id.print id
 
-let explain_refiner_error = function
-  | BadType (arg,ty,conclty) -> explain_refiner_bad_type arg ty conclty
+let explain_refiner_error env sigma = function
+  | BadType (arg,ty,conclty) -> explain_refiner_bad_type env sigma arg ty conclty
   | UnresolvedBindings t -> explain_refiner_unresolved_bindings t
-  | CannotApply (t,harg) -> explain_refiner_cannot_apply t harg
-  | NotWellTyped c -> explain_refiner_not_well_typed c
+  | CannotApply (t,harg) -> explain_refiner_cannot_apply env sigma t harg
+  | NotWellTyped c -> explain_refiner_not_well_typed env sigma c
   | IntroNeedsProduct -> explain_intro_needs_product ()
-  | DoesNotOccurIn (c,hyp) -> explain_does_not_occur_in c hyp
-  | NonLinearProof c -> explain_non_linear_proof c
-  | MetaInType c -> explain_meta_in_type c
+  | DoesNotOccurIn (c,hyp) -> explain_does_not_occur_in env sigma c hyp
+  | NonLinearProof c -> explain_non_linear_proof env sigma c
+  | MetaInType c -> explain_meta_in_type env sigma c
   | NoSuchHyp id -> explain_no_such_hyp id
 
 (* Inductive errors *)
@@ -1117,7 +1100,7 @@ let error_ill_formed_inductive env c v =
 let error_ill_formed_constructor env id c v nparams nargs =
   let pv = pr_lconstr_env env Evd.empty v in
   let atomic = Int.equal (nb_prod Evd.empty (EConstr.of_constr c)) (** FIXME *) 0 in
-  str "The type of constructor" ++ brk(1,1) ++ pr_id id ++ brk(1,1) ++
+  str "The type of constructor" ++ brk(1,1) ++ Id.print id ++ brk(1,1) ++
   str "is not valid;" ++ brk(1,1) ++
   strbrk (if atomic then "it must be " else "its conclusion must be ") ++
   pv ++
@@ -1145,17 +1128,17 @@ let error_bad_ind_parameters env c n v1 v2  =
   str " as " ++ pr_nth n ++ str " argument in" ++ brk(1,1) ++ pc ++ str "."
 
 let error_same_names_types id =
-  str "The name" ++ spc () ++ pr_id id ++ spc () ++
+  str "The name" ++ spc () ++ Id.print id ++ spc () ++
   str "is used more than once."
 
 let error_same_names_constructors id =
-  str "The constructor name" ++ spc () ++ pr_id id ++ spc () ++
+  str "The constructor name" ++ spc () ++ Id.print id ++ spc () ++
   str "is used more than once."
 
 let error_same_names_overlap idl =
   strbrk "The following names are used both as type names and constructor " ++
   str "names:" ++ spc () ++
-  prlist_with_sep pr_comma pr_id idl ++ str "."
+  prlist_with_sep pr_comma Id.print idl ++ str "."
 
 let error_not_an_arity env c =
   str "The type" ++ spc () ++ pr_lconstr_env env Evd.empty c ++ spc () ++
@@ -1176,7 +1159,7 @@ let error_not_allowed_case_analysis isrec kind i =
   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") ++
+  str "Dependent " ++ str (if isrec then "induction" else "case analysis") ++
   strbrk " is not allowed for inductive definition " ++
   pr_inductive (Global.env()) i ++ str "."
 
diff --git a/vernac/himsg.mli b/vernac/himsg.mli
index 5b91f9e68..8945ebadb 100644
--- a/vernac/himsg.mli
+++ b/vernac/himsg.mli
@@ -27,7 +27,7 @@ val explain_typeclass_error : env -> typeclass_error -> Pp.t
 
 val explain_recursion_scheme_error : recursion_scheme_error -> Pp.t
 
-val explain_refiner_error : refiner_error -> Pp.t
+val explain_refiner_error : env -> Evd.evar_map -> refiner_error -> Pp.t
 
 val explain_pattern_matching_error :
   env -> Evd.evar_map -> pattern_matching_error -> Pp.t
diff --git a/vernac/indschemes.ml b/vernac/indschemes.ml
index 6ea8bc7f2..447c5085b 100644
--- a/vernac/indschemes.ml
+++ b/vernac/indschemes.ml
@@ -21,6 +21,7 @@ open Names
 open Declarations
 open Entries
 open Term
+open Constr
 open Inductive
 open Decl_kinds
 open Indrec
@@ -30,7 +31,6 @@ open Globnames
 open Goptions
 open Nameops
 open Termops
-open Pretyping
 open Nametab
 open Smartlocate
 open Vernacexpr
@@ -109,10 +109,10 @@ let _ =
 
 let define id internal ctx c t =
   let f = declare_constant ~internal in
-  let _, univs = Evd.universe_context ctx in
   let univs =
-    if Flags.is_universe_polymorphism () then Polymorphic_const_entry univs
-    else Monomorphic_const_entry univs
+    if Flags.is_universe_polymorphism ()
+    then Polymorphic_const_entry (Evd.to_universe_context ctx)
+    else Monomorphic_const_entry (Evd.universe_context_set ctx)
   in
   let kn = f id
     (DefinitionEntry
@@ -258,7 +258,7 @@ let declare_one_induction_scheme ind =
 
 let declare_induction_schemes kn =
   let mib = Global.lookup_mind kn in
-  if mib.mind_finite <> Decl_kinds.CoFinite then begin
+  if mib.mind_finite <> Declarations.CoFinite then begin
     for i = 0 to Array.length mib.mind_packets - 1 do
       declare_one_induction_scheme (kn,i);
     done;
@@ -268,7 +268,7 @@ let declare_induction_schemes kn =
 
 let declare_eq_decidability_gen internal names kn =
   let mib = Global.lookup_mind kn in
-  if mib.mind_finite <> Decl_kinds.CoFinite then
+  if mib.mind_finite <> Declarations.CoFinite then
     ignore (define_mutual_scheme eq_dec_scheme_kind internal names kn)
 
 let eq_dec_scheme_msg ind = (* TODO: mutual inductive case *)
@@ -345,40 +345,38 @@ requested
       let names inds recs isdep y z =
         let ind = smart_global_inductive y in
         let sort_of_ind = inductive_sort_family (snd (lookup_mind_specif env ind)) in
-        let z' = interp_elimination_sort z in
         let suffix = (
           match sort_of_ind with
           | InProp ->
-              if isdep then (match z' with
+              if isdep then (match z with
               | InProp -> inds ^ "_dep"
               | InSet  -> recs ^ "_dep"
               | InType -> recs ^ "t_dep")
-              else ( match z' with
+              else ( match z with
               | InProp -> inds
               | InSet -> recs
               | InType -> recs ^ "t" )
           | _ ->
-              if isdep then (match z' with
+              if isdep then (match z with
               | InProp -> inds
               | InSet -> recs
               | InType -> recs ^ "t" )
-              else (match z' with
+              else (match z with
               | InProp -> inds ^ "_nodep"
               | InSet -> recs ^ "_nodep"
               | InType -> recs ^ "t_nodep")
         ) in
         let newid = add_suffix (basename_of_global (IndRef ind)) suffix in
-        let newref = Loc.tag newid in
+        let newref = CAst.make newid in
           ((newref,isdep,ind,z)::l1),l2
       in
 	match t with
 	| CaseScheme (x,y,z) -> names "_case" "_case" x y z
 	| InductionScheme (x,y,z) -> names "_ind" "_rec" x y z
 	| EqualityScheme  x -> l1,((None,smart_global_inductive x)::l2)
-	    
 
 let do_mutual_induction_scheme lnamedepindsort =
-  let lrecnames = List.map (fun ((_,f),_,_,_) -> f) lnamedepindsort
+  let lrecnames = List.map (fun ({CAst.v},_,_,_) -> v) lnamedepindsort
   and env0 = Global.env() in
   let sigma, lrecspec, _ =
     List.fold_right
@@ -392,7 +390,7 @@ let do_mutual_induction_scheme lnamedepindsort =
 	      evd, (ind,u), Some u
 	 | Some ui -> evd, (ind, ui), inst
        in
-          (evd, (indu,dep,interp_elimination_sort sort) :: l, inst))
+          (evd, (indu,dep,sort) :: l, inst))
     lnamedepindsort (Evd.from_env env0,[],None)
   in
   let sigma, listdecl = Indrec.build_mutual_induction_scheme env0 sigma lrecspec in
@@ -409,7 +407,7 @@ let do_mutual_induction_scheme lnamedepindsort =
 let get_common_underlying_mutual_inductive = function
   | [] -> assert false
   | (id,(mind,i as ind))::l as all ->
-      match List.filter (fun (_,(mind',_)) -> not (eq_mind mind mind')) l with
+      match List.filter (fun (_,(mind',_)) -> not (MutInd.equal mind mind')) l with
       | (_,ind')::_ ->
 	  raise (RecursionSchemeError (NotMutualInScheme (ind,ind')))
       | [] ->
@@ -417,7 +415,7 @@ let get_common_underlying_mutual_inductive = function
           then user_err Pp.(str "A type occurs twice");
 	  mind,
 	  List.map_filter
-	    (function (Some id,(_,i)) -> Some (i,snd id) | (None,_) -> None) all
+            (function (Some id,(_,i)) -> Some (i,id.CAst.v) | (None,_) -> None) all
 
 let do_scheme l =
   let ischeme,escheme = split_scheme l in
@@ -451,7 +449,7 @@ let fold_left' f = function
 
 let mk_coq_and sigma = Evarutil.new_global sigma (Coqlib.build_coq_and ())
 let mk_coq_conj sigma = Evarutil.new_global sigma (Coqlib.build_coq_conj ())
-             
+
 let build_combined_scheme env schemes =
   let evdref = ref (Evd.from_env env) in
   let defs = List.map (fun cst ->
@@ -460,7 +458,7 @@ let build_combined_scheme env schemes =
   let find_inductive ty =
     let (ctx, arity) = decompose_prod ty in
     let (_, last) = List.hd ctx in
-      match kind_of_term last with
+      match Constr.kind last with
 	| App (ind, args) ->
 	    let ind = destInd ind in
 	    let (_,spec) = Inductive.lookup_mind_specif env (fst ind) in
@@ -493,18 +491,19 @@ let build_combined_scheme env schemes =
   (!evdref, body, typ)
 
 let do_combined_scheme name schemes =
+  let open CAst in
   let csts =
-    List.map (fun x ->
-		let refe = Ident x in
-		let qualid = qualid_of_reference refe in
-		try Nametab.locate_constant (snd qualid)
-                with Not_found -> user_err Pp.(pr_qualid (snd qualid) ++ str " is not declared."))
+    List.map (fun {CAst.loc;v} ->
+        let refe = Ident (Loc.tag ?loc v) in
+        let qualid = qualid_of_reference refe in
+        try Nametab.locate_constant (snd qualid)
+        with Not_found -> user_err Pp.(pr_qualid (snd qualid) ++ str " is not declared."))
       schemes
   in
   let sigma,body,typ = build_combined_scheme (Global.env ()) csts in
   let proof_output = Future.from_val ((body,Univ.ContextSet.empty),Safe_typing.empty_private_constants) in
-  ignore (define (snd name) UserIndividualRequest sigma proof_output (Some typ));
-  fixpoint_message None [snd name]
+  ignore (define name.v UserIndividualRequest sigma proof_output (Some typ));
+  fixpoint_message None [name.v]
 
 (**********************************************************************)
 
@@ -513,7 +512,7 @@ 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)
+  if !elim_flag && (mib.mind_finite <> Declarations.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;
diff --git a/vernac/indschemes.mli b/vernac/indschemes.mli
index 076e4938f..8658d85f6 100644
--- a/vernac/indschemes.mli
+++ b/vernac/indschemes.mli
@@ -6,20 +6,18 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Loc
 open Names
-open Term
+open Constr
 open Environ
 open Vernacexpr
-open Misctypes
 
 (** See also Auto_ind_decl, Indrec, Eqscheme, Ind_tables, ... *)
 
 (** Build and register the boolean equalities associated to an inductive type *)
 
-val declare_beq_scheme : mutual_inductive -> unit
+val declare_beq_scheme : MutInd.t -> unit
 
-val declare_eq_decidability : mutual_inductive -> unit
+val declare_eq_decidability : MutInd.t -> unit
 
 (** Build and register a congruence scheme for an equality-like inductive type *)
 
@@ -32,18 +30,18 @@ val declare_rewriting_schemes : inductive -> unit
 (** Mutual Minimality/Induction scheme *)
 
 val do_mutual_induction_scheme :
-  (Id.t located * bool * inductive * glob_sort) list -> unit
+  (Misctypes.lident * bool * inductive * Sorts.family) list -> unit
 
 (** Main calls to interpret the Scheme command *)
 
-val do_scheme : (Id.t located option * scheme) list -> unit
+val do_scheme : (Misctypes.lident option * scheme) list -> unit
 
 (** Combine a list of schemes into a conjunction of them *)
 
-val build_combined_scheme : env -> constant list -> Evd.evar_map * constr * types
+val build_combined_scheme : env -> Constant.t list -> Evd.evar_map * constr * types
 
-val do_combined_scheme : Id.t located -> Id.t located list -> unit
+val do_combined_scheme : Misctypes.lident -> Misctypes.lident list -> unit
 
 (** Hook called at each inductive type definition *)
 
-val declare_default_schemes : mutual_inductive -> unit
+val declare_default_schemes : MutInd.t -> unit
diff --git a/vernac/lemmas.ml b/vernac/lemmas.ml
index 645320c60..7661fff6d 100644
--- a/vernac/lemmas.ml
+++ b/vernac/lemmas.ml
@@ -11,14 +11,12 @@
 
 open CErrors
 open Util
-open Flags
 open Pp
 open Names
-open Term
+open Constr
 open Declarations
 open Declareops
 open Entries
-open Environ
 open Nameops
 open Globnames
 open Decls
@@ -49,7 +47,8 @@ let retrieve_first_recthm uctx = function
       (NamedDecl.get_value (Global.lookup_named id),variable_opacity id)
   | ConstRef cst ->
       let cb = Global.lookup_constant cst in
-      let (_, uctx) = UState.universe_context uctx in
+      (* we get the right order somehow but surely it could be enforced in a better way *)
+      let uctx = UState.context uctx in
       let inst = Univ.UContext.instance uctx in
       let map (c, ctx) = Vars.subst_instance_constr inst c in
       (Option.map map (Global.body_of_constant_body cb), is_opaque cb)
@@ -61,9 +60,9 @@ let adjust_guardness_conditions const = function
   (* Try all combinations... not optimal *)
      let env = Global.env() in
      { const with const_entry_body =
-        Future.chain ~pure:true const.const_entry_body
+        Future.chain const.const_entry_body
         (fun ((body, ctx), eff) ->
-          match kind_of_term body with
+          match Constr.kind body with
           | Fix ((nv,0),(_,_,fixdefs as fixdecls)) ->
 (*      let possible_indexes =
 	List.map2 (fun i c -> match i with Some i -> i | None ->
@@ -87,37 +86,37 @@ let adjust_guardness_conditions const = function
 		(mkFix ((indexes,0),fixdecls), ctx), eff
           | _ -> (body, ctx), eff) }
 
-let find_mutually_recursive_statements thms =
+let find_mutually_recursive_statements sigma thms =
     let n = List.length thms in
     let inds = List.map (fun (id,(t,impls)) ->
-      let (hyps,ccl) = decompose_prod_assum t in
+      let (hyps,ccl) = EConstr.decompose_prod_assum sigma t in
       let x = (id,(t,impls)) in
-      let whnf_hyp_hds = map_rel_context_in_env
-        (fun env c -> EConstr.Unsafe.to_constr (fst (whd_all_stack env Evd.empty (EConstr.of_constr c))))
+      let whnf_hyp_hds = EConstr.map_rel_context_in_env
+        (fun env c -> fst (Reductionops.whd_all_stack env sigma c))
         (Global.env()) hyps in
       let ind_hyps =
         List.flatten (List.map_i (fun i decl ->
           let t = RelDecl.get_type decl in
-          match kind_of_term t with
+          match EConstr.kind sigma t with
           | Ind ((kn,_ as ind),u) when
                 let mind = Global.lookup_mind kn in
-                mind.mind_finite <> Decl_kinds.CoFinite ->
+                mind.mind_finite <> Declarations.CoFinite ->
               [ind,x,i]
           | _ ->
-              []) 0 (List.rev (List.filter RelDecl.is_local_assum whnf_hyp_hds))) in
+              []) 0 (List.rev (List.filter Context.Rel.Declaration.is_local_assum whnf_hyp_hds))) in
       let ind_ccl =
-        let cclenv = push_rel_context hyps (Global.env()) in
-        let whnf_ccl,_ = whd_all_stack cclenv Evd.empty (EConstr.of_constr ccl) in
-        match kind_of_term (EConstr.Unsafe.to_constr whnf_ccl) with
+        let cclenv = EConstr.push_rel_context hyps (Global.env()) in
+        let whnf_ccl,_ = whd_all_stack cclenv Evd.empty ccl in
+        match EConstr.kind sigma whnf_ccl with
         | Ind ((kn,_ as ind),u) when
               let mind = Global.lookup_mind kn in
-              Int.equal mind.mind_ntypes n && mind.mind_finite == Decl_kinds.CoFinite ->
+              Int.equal mind.mind_ntypes n && mind.mind_finite == Declarations.CoFinite ->
             [ind,x,0]
         | _ ->
             [] in
       ind_hyps,ind_ccl) thms in
     let inds_hyps,ind_ccls = List.split inds in
-    let of_same_mutind ((kn,_),_,_) = function ((kn',_),_,_) -> eq_mind kn kn' in
+    let of_same_mutind ((kn,_),_,_) = function ((kn',_),_,_) -> MutInd.equal kn kn' in
     (* Check if all conclusions are coinductive in the same type *)
     (* (degenerated cartesian product since there is at most one coind ccl) *)
     let same_indccl =
@@ -137,7 +136,7 @@ let find_mutually_recursive_statements thms =
 	  assert (List.is_empty rest);
           (* One occ. of common coind ccls and no common inductive hyps *)
 	  if not (List.is_empty common_same_indhyp) then
-	    if_verbose Feedback.msg_info (str "Assuming mutual coinductive statements.");
+	    Flags.if_verbose Feedback.msg_info (str "Assuming mutual coinductive statements.");
 	  flush_all ();
           indccl, true, []
       | [], _::_ ->
@@ -145,7 +144,7 @@ let find_mutually_recursive_statements thms =
           | ind :: _ ->
             if List.distinct_f ind_ord (List.map pi1 ind)
             then
-              if_verbose Feedback.msg_info
+              Flags.if_verbose Feedback.msg_info
                 (strbrk
                    ("Coinductive statements do not follow the order of "^
                     "definition, assuming the proof to be by induction."));
@@ -162,29 +161,33 @@ let find_mutually_recursive_statements thms =
     in
     (finite,guard,None), ordered_inds
 
-let look_for_possibly_mutual_statements = function
+let look_for_possibly_mutual_statements sigma = function
   | [id,(t,impls)] ->
       (* One non recursively proved theorem *)
       None,[id,(t,impls)],None
   | _::_ as thms ->
     (* More than one statement and/or an explicit decreasing mark: *)
     (* we look for a common inductive hyp or a common coinductive conclusion *)
-    let recguard,ordered_inds = find_mutually_recursive_statements thms in
+    let recguard,ordered_inds = find_mutually_recursive_statements sigma thms in
     let thms = List.map pi2 ordered_inds in
     Some recguard,thms, Some (List.map (fun (_,_,i) -> succ i) ordered_inds)
   | [] -> anomaly (Pp.str "Empty list of theorems.")
 
 (* Saving a goal *)
 
-let save ?export_seff id const cstrs pl do_guard (locality,poly,kind) hook =
+let save ?export_seff id const uctx do_guard (locality,poly,kind) hook =
   let fix_exn = Future.fix_exn_of const.Entries.const_entry_body in
   try
     let const = adjust_guardness_conditions const do_guard in
     let k = Kindops.logical_kind_of_goal_kind kind in
+    let should_suggest = const.const_entry_opaque && Option.is_empty const.const_entry_secctx in
     let l,r = match locality with
       | Discharge when Lib.sections_are_opened () ->
           let c = SectionLocalDef const in
           let _ = declare_variable id (Lib.cwd(), c, k) in
+          let () = if should_suggest
+            then Proof_using.suggest_variable (Global.env ()) id
+          in
           (Local, VarRef id)
       | Local | Global | Discharge ->
           let local = match locality with
@@ -193,9 +196,13 @@ let save ?export_seff id const cstrs pl do_guard (locality,poly,kind) hook =
           in
           let kn =
            declare_constant ?export_seff id ~local (DefinitionEntry const, k) in
-          (locality, ConstRef kn) in
+          let () = if should_suggest
+            then Proof_using.suggest_constant (Global.env ()) kn
+          in
+          (locality, ConstRef kn)
+    in
     definition_message id;
-    Option.iter (Universes.register_universe_binders r) pl;
+    Declare.declare_univ_binders r (UState.universe_binders uctx);
     call_hook (fun exn -> exn) hook l r
   with e when CErrors.noncritical e ->
     let e = CErrors.push e in
@@ -203,18 +210,18 @@ let save ?export_seff id const cstrs pl do_guard (locality,poly,kind) hook =
 
 let default_thm_id = Id.of_string "Unnamed_thm"
 
-let compute_proof_name locality = function
-  | Some ((loc,id),pl) ->
-      (* We check existence here: it's a bit late at Qed time *)
-      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  (pr_id id ++ str " already exists.");
-      id, pl
-  | None ->
-      next_global_ident_away default_thm_id (Proof_global.get_all_proof_names ()), None
+let fresh_name_for_anonymous_theorem () =
+  let avoid = Id.Set.of_list (Proof_global.get_all_proof_names ()) in
+  next_global_ident_away default_thm_id avoid
+
+let check_name_freshness locality {CAst.loc;v=id} : unit =
+  (* We check existence here: it's a bit late at Qed time *)
+  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  (Id.print id ++ str " already exists.")
 
-let save_remaining_recthms (locality,p,kind) norm ctx body opaq i ((id,pl),(t_i,(_,imps))) =
+let save_remaining_recthms (locality,p,kind) norm univs body opaq i (id,(t_i,(_,imps))) =
   let t_i = norm t_i in
   match body with
   | None ->
@@ -222,7 +229,13 @@ let save_remaining_recthms (locality,p,kind) norm ctx body opaq i ((id,pl),(t_i,
       | Discharge ->
           let impl = false in (* copy values from Vernacentries *)
           let k = IsAssumption Conjectural in
-          let c = SectionLocalAssum ((t_i,ctx),p,impl) in
+          let univs = match univs with
+            | Polymorphic_const_entry univs ->
+              (* What is going on here? *)
+              Univ.ContextSet.of_context univs
+            | Monomorphic_const_entry univs -> univs
+          in
+          let c = SectionLocalAssum ((t_i, univs),p,impl) in
 	  let _ = declare_variable id (Lib.cwd(),c,k) in
           (Discharge, VarRef id,imps)
       | Local | Global ->
@@ -232,37 +245,36 @@ let save_remaining_recthms (locality,p,kind) norm ctx body opaq i ((id,pl),(t_i,
           | Global -> false
           | Discharge -> assert false
           in
-          let ctx = Univ.ContextSet.to_context ctx in
-          let decl = (ParameterEntry (None,p,(t_i,ctx),None), k) in
+          let decl = (ParameterEntry (None,(t_i,univs),None), k) in
           let kn = declare_constant id ~local decl in
           (locality,ConstRef kn,imps))
   | Some body ->
       let body = norm body in
       let k = Kindops.logical_kind_of_goal_kind kind in
-      let rec body_i t = match kind_of_term t with
+      let rec body_i t = match Constr.kind 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 ++ str ".") in
+        | _ ->
+          let sigma, env = Pfedit.get_current_context () in
+          anomaly Pp.(str "Not a proof by induction: " ++ Printer.pr_constr_env env sigma body ++ str ".") in
       let body_i = body_i body in
       match locality with
       | Discharge ->
-          let const = definition_entry ~types:t_i ~opaque:opaq ~poly:p 
-	    ~univs:(Univ.ContextSet.to_context ctx) body_i in
+          let const = definition_entry ~types:t_i ~opaque:opaq ~univs body_i in
 	  let c = SectionLocalDef const in
 	  let _ = declare_variable id (Lib.cwd(), c, k) in
           (Discharge,VarRef id,imps)
       | Local | Global ->
-        let ctx = Univ.ContextSet.to_context ctx in
         let local = match locality with
         | Local -> true
         | Global -> false
         | Discharge -> assert false
         in
         let const =
-	  Declare.definition_entry ~types:t_i ~poly:p ~univs:ctx ~opaque:opaq body_i
+          Declare.definition_entry ~types:t_i ~univs ~opaque:opaq body_i
 	in
         let kn = declare_constant id ~local (DefinitionEntry const, k) in
         (locality,ConstRef kn,imps)
@@ -271,23 +283,23 @@ let save_hook = ref ignore
 let set_save_hook f = save_hook := f
 
 let save_named ?export_seff proof =
-  let id,const,(cstrs,pl),do_guard,persistence,hook = proof in
-  save ?export_seff id const cstrs pl do_guard persistence hook
+  let id,const,uctx,do_guard,persistence,hook = proof in
+  save ?export_seff id const uctx do_guard persistence hook
 
 let check_anonymity id save_ident =
   if not (String.equal (atompart_of_id id) (Id.to_string (default_thm_id))) then
     user_err Pp.(str "This command can only be used for unnamed theorem.")
 
 let save_anonymous ?export_seff proof save_ident =
-  let id,const,(cstrs,pl),do_guard,persistence,hook = proof in
+  let id,const,uctx,do_guard,persistence,hook = proof in
   check_anonymity id save_ident;
-  save ?export_seff save_ident const cstrs pl do_guard persistence hook
+  save ?export_seff save_ident const uctx do_guard persistence hook
 
 (* Admitted *)
 
 let warn_let_as_axiom =
   CWarnings.create ~name:"let-as-axiom" ~category:"vernacular"
-                   (fun id -> strbrk "Let definition" ++ spc () ++ pr_id id ++
+                   (fun id -> strbrk "Let definition" ++ spc () ++ Id.print id ++
                                 spc () ++ strbrk "declared as an axiom.")
 
 let admit (id,k,e) pl hook () =
@@ -297,7 +309,7 @@ let admit (id,k,e) pl hook () =
   | Local, _, _ | Discharge, _, _ -> warn_let_as_axiom id
   in
   let () = assumption_message id in
-  Option.iter (Universes.register_universe_binders (ConstRef kn)) pl;
+  Declare.declare_univ_binders (ConstRef kn) pl;
   call_hook (fun exn -> exn) hook Global (ConstRef kn)
 
 (* Starting a goal *)
@@ -312,30 +324,23 @@ let get_proof proof do_guard hook opacity =
   in
   id,{const with const_entry_opaque = opacity},univs,do_guard,persistence,hook
 
-let check_exist =
-  List.iter (fun (loc,id) ->
-    if not (Nametab.exists_cci (Lib.make_path id)) then
-        user_err ?loc  (pr_id id ++ str " does not exist.")
-  )
-
 let universe_proof_terminator compute_guard hook =
   let open Proof_global in
   make_terminator begin function
-  | Admitted (id,k,pe,(ctx,pl)) ->
-      admit (id,k,pe) pl (hook (Some ctx)) ();
+  | Admitted (id,k,pe,ctx) ->
+      admit (id,k,pe) (UState.universe_binders ctx) (hook (Some ctx)) ();
       Feedback.feedback Feedback.AddedAxiom
   | Proved (opaque,idopt,proof) ->
-      let is_opaque, export_seff, exports = match opaque with
-        | Vernacexpr.Transparent -> false, true, []
-        | Vernacexpr.Opaque None -> true, false, []
-        | Vernacexpr.Opaque (Some l) -> true, true, l in
+      let is_opaque, export_seff = match opaque with
+        | Vernacexpr.Transparent -> false, true
+        | Vernacexpr.Opaque      -> true, false
+      in
       let proof = get_proof proof compute_guard
-	(hook (Some (fst proof.Proof_global.universes))) is_opaque in
+        (hook (Some (proof.Proof_global.universes))) is_opaque in
       begin match idopt with
       | None -> save_named ~export_seff proof
-      | Some (_,id) -> save_anonymous ~export_seff proof id
-      end;
-      check_exist exports
+      | Some { CAst.v = id } -> save_anonymous ~export_seff proof id
+      end
   end
 
 let standard_proof_terminator compute_guard hook =
@@ -369,7 +374,7 @@ let start_proof_univs id ?pl kind sigma ?terminator ?sign c ?init_tac ?(compute_
 
 let rec_tac_initializer finite guard thms snl =
   if finite then
-    match List.map (fun ((id,_),(t,_)) -> (id,EConstr.of_constr t)) thms with
+    match List.map (fun (id,(t,_)) -> (id,t)) thms with
     | (id,_)::l -> Tactics.mutual_cofix id l 0
     | _ -> assert false
   else
@@ -377,11 +382,11 @@ let rec_tac_initializer finite guard thms snl =
     let nl = match snl with 
      | None -> List.map succ (List.map List.last guard)
      | Some nl -> nl
-    in match List.map2 (fun ((id,_),(t,_)) n -> (id,n, EConstr.of_constr t)) thms nl with
+    in match List.map2 (fun (id,(t,_)) n -> (id,n, t)) thms nl with
        | (id,n,_)::l -> Tactics.mutual_fix id n l 0
        | _ -> assert false
 
-let start_proof_with_initialization kind ctx recguard thms snl hook =
+let start_proof_with_initialization kind sigma decl recguard thms snl hook =
   let intro_tac (_, (_, (ids, _))) =
     Tacticals.New.tclMAP (function
     | Name id -> Tactics.intro_mustbe_force id
@@ -406,60 +411,59 @@ let start_proof_with_initialization kind ctx recguard thms snl hook =
       (if Flags.is_auto_intros () then Some (intro_tac (List.hd thms)) else None), [] in
   match thms with
   | [] -> anomaly (Pp.str "No proof to start.")
-  | ((id,pl),(t,(_,imps)))::other_thms ->
+  | (id,(t,(_,imps)))::other_thms ->
       let hook ctx strength ref =
         let ctx = match ctx with
-        | None -> Evd.empty_evar_universe_context
+        | None -> UState.empty
         | Some ctx -> ctx
         in
         let other_thms_data =
           if List.is_empty other_thms then [] else
             (* there are several theorems defined mutually *)
             let body,opaq = retrieve_first_recthm ctx ref in
-            let subst = Evd.evar_universe_context_subst ctx in
-            let norm c = Universes.subst_opt_univs_constr subst c in
-	    let ctx = UState.context_set (*FIXME*) ctx in
-	    let body = Option.map norm body in
-            List.map_i (save_remaining_recthms kind norm ctx body opaq) 1 other_thms in
+            let norm c = EConstr.to_constr (Evd.from_ctx ctx) c in
+            let body = Option.map EConstr.of_constr body in
+            let uctx = UState.check_univ_decl ~poly:(pi2 kind) ctx decl in
+            List.map_i (save_remaining_recthms kind norm uctx body opaq) 1 other_thms in
         let thms_data = (strength,ref,imps)::other_thms_data in
         List.iter (fun (strength,ref,imps) ->
 	  maybe_declare_manual_implicits false ref imps;
 	  call_hook (fun exn -> exn) hook strength ref) thms_data in
-      start_proof_univs id ?pl kind ctx (EConstr.of_constr t) ?init_tac (fun ctx -> mk_hook (hook ctx)) ~compute_guard:guard
+      start_proof_univs id ~pl:decl kind sigma t ?init_tac (fun ctx -> mk_hook (hook ctx)) ~compute_guard:guard
 
 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
-		    | None -> Evd.from_env env0
-		    | Some l -> Evd.from_ctx (Evd.make_evar_universe_context env0 l))
-  in
-  let thms = List.map (fun (sopt,(bl,t)) ->
-    let impls, ((env, ctx), imps) = interp_context_evars env0 evdref bl in
-    let t', imps' = interp_type_evars_impls ~impls env evdref t in
+  let decl = fst (List.hd thms) in
+  let evd, decl = Univdecls.interp_univ_decl_opt env0 (snd decl) in
+  let evd, thms = List.fold_left_map (fun evd ((id, _), (bl, t)) ->
+    let evd, (impls, ((env, ctx), imps)) = interp_context_evars env0 evd bl in
+    let evd, (t', imps') = interp_type_evars_impls ~impls env evd t 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;
+    let evd = solve_remaining_evars flags env evd Evd.empty in
     let ids = List.map RelDecl.get_name ctx in
-      (compute_proof_name (pi1 kind) sopt,
-      (EConstr.Unsafe.to_constr (nf_evar !evdref (EConstr.it_mkProd_or_LetIn t' ctx)),
-       (ids, imps @ lift_implicits (Context.Rel.nhyps ctx) imps'))))
-    thms in
-  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
+    check_name_freshness (pi1 kind) id;
+    (* XXX: The nf_evar is critical !! *)
+    evd, (id.CAst.v,
+          (Evarutil.nf_evar evd (EConstr.it_mkProd_or_LetIn t' ctx),
+           (ids, imps @ lift_implicits (Context.Rel.nhyps ctx) imps'))))
+      evd thms in
+  let recguard,thms,snl = look_for_possibly_mutual_statements evd thms in
+  let evd, _nf = Evarutil.nf_evars_and_universes evd in
+  (* XXX: This nf_evar is critical too!! We are normalizing twice if
+     you look at the previous lines... *)
+  let thms = List.map (fun (n, (t, info)) -> (n, (nf_evar evd t, info))) thms in
   let () =
-    match levels with
-    | None -> ()
-    | Some l -> ignore (Evd.universe_context evd ?names:l)
+    let open Misctypes in
+    if not (decl.univdecl_extensible_instance && decl.univdecl_extensible_constraints) then
+       ignore (Evd.check_univ_decl ~poly:(pi2 kind) evd decl)
   in
   let evd =
     if pi2 kind then evd
     else (* We fix the variables to ensure they won't be lowered to Set *)
       Evd.fix_undefined_variables evd
   in
-    start_proof_with_initialization kind evd recguard thms snl hook
-
+    start_proof_with_initialization kind evd decl recguard thms snl hook
 
 (* Saving a proof *)
 
@@ -486,9 +490,9 @@ let save_proof ?proof = function
             if const_entry_type = None then
               user_err Pp.(str "Admitted requires an explicit statement");
             let typ = Option.get const_entry_type in
-            let ctx = Evd.evar_context_universe_context (fst universes) in
+            let ctx = UState.const_univ_entry ~poly:(pi2 k) universes in
             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)
+            Admitted(id, k, (sec_vars, (typ, ctx), None), universes)
         | None ->
             let pftree = Proof_global.give_me_the_proof () in
             let id, k, typ = Pfedit.current_proof_statement () in
@@ -505,13 +509,12 @@ let save_proof ?proof = function
                   let env = Global.env () in
                   let ids_typ = Environ.global_vars_set env typ in
                   let ids_def = Environ.global_vars_set env pproof in
-                  Some (Environ.keep_hyps env (Idset.union ids_typ ids_def))
+                  Some (Environ.keep_hyps env (Id.Set.union ids_typ ids_def))
               | _ -> None in
-	    let names = Proof_global.get_universe_binders () 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))
+	    let decl = Proof_global.get_universe_decl () in
+            let poly = pi2 k in
+            let ctx = UState.check_univ_decl ~poly universes decl in
+            Admitted(id,k,(sec_vars, (typ, ctx), None), universes)
       in
       Proof_global.apply_terminator (Proof_global.get_terminator ()) pe
   | Vernacexpr.Proved (is_opaque,idopt) ->
@@ -526,7 +529,5 @@ let save_proof ?proof = function
       Proof_global.(apply_terminator terminator (Proved (is_opaque,idopt,proof_obj)))
 
 (* Miscellaneous *)
+let get_current_context () = Pfedit.get_current_context ()
 
-let get_current_context () =
-  Pfedit.get_current_context ()
-           
diff --git a/vernac/lemmas.mli b/vernac/lemmas.mli
index a8c09c0fe..126dcd8b0 100644
--- a/vernac/lemmas.mli
+++ b/vernac/lemmas.mli
@@ -7,7 +7,6 @@
 (************************************************************************)
 
 open Names
-open Term
 open Decl_kinds
 
 type 'a declaration_hook
@@ -20,43 +19,45 @@ val call_hook :
 (** A hook start_proof calls on the type of the definition being started *)
 val set_start_hook : (EConstr.types -> unit) -> unit
 
-val start_proof : Id.t -> ?pl:Proof_global.universe_binders -> goal_kind -> Evd.evar_map ->
+val start_proof : Id.t -> ?pl:Univdecls.universe_decl -> goal_kind -> Evd.evar_map ->
   ?terminator:(Proof_global.lemma_possible_guards -> unit declaration_hook -> Proof_global.proof_terminator) ->
   ?sign:Environ.named_context_val -> EConstr.types ->
   ?init_tac:unit Proofview.tactic -> ?compute_guard:Proof_global.lemma_possible_guards -> 
    unit declaration_hook -> unit
 
-val start_proof_univs : Id.t -> ?pl:Proof_global.universe_binders -> goal_kind -> Evd.evar_map ->
-  ?terminator:(Proof_global.lemma_possible_guards -> (Evd.evar_universe_context option -> unit declaration_hook) -> Proof_global.proof_terminator) ->
+val start_proof_univs : Id.t -> ?pl:Univdecls.universe_decl -> goal_kind -> Evd.evar_map ->
+  ?terminator:(Proof_global.lemma_possible_guards -> (UState.t option -> unit declaration_hook) -> Proof_global.proof_terminator) ->
   ?sign:Environ.named_context_val -> EConstr.types ->
   ?init_tac:unit Proofview.tactic -> ?compute_guard:Proof_global.lemma_possible_guards -> 
-  (Evd.evar_universe_context option -> unit declaration_hook) -> unit
+  (UState.t option -> unit declaration_hook) -> unit
 
 val start_proof_com :
   ?inference_hook:Pretyping.inference_hook ->
   goal_kind -> Vernacexpr.proof_expr list ->
   unit declaration_hook -> unit
 
-val start_proof_with_initialization : 
-  goal_kind -> Evd.evar_map ->
+val start_proof_with_initialization :
+  goal_kind -> Evd.evar_map -> Univdecls.universe_decl ->
   (bool * Proof_global.lemma_possible_guards * unit Proofview.tactic list option) option ->
-  ((Id.t (* name of thm *) * Proof_global.universe_binders option) *
-     (types (* type of thm *) * (Name.t list (* names to pre-introduce *) * Impargs.manual_explicitation list))) list
+  (Id.t (* name of thm *) *
+     (EConstr.types (* type of thm *) * (Name.t list (* names to pre-introduce *) * Impargs.manual_explicitation list))) list
   -> int list option -> unit declaration_hook -> unit
 
 val universe_proof_terminator :
   Proof_global.lemma_possible_guards ->
-    (Evd.evar_universe_context option -> unit declaration_hook) ->
+    (UState.t option -> unit declaration_hook) ->
     Proof_global.proof_terminator
 
 val standard_proof_terminator :
   Proof_global.lemma_possible_guards -> unit declaration_hook ->
     Proof_global.proof_terminator
 
+val fresh_name_for_anonymous_theorem : unit -> Id.t
+
 (** {6 ... } *)
 
 (** A hook the next three functions pass to cook_proof *)
-val set_save_hook : (Proof.proof -> unit) -> unit
+val set_save_hook : (Proof.t -> unit) -> unit
 
 val save_proof : ?proof:Proof_global.closed_proof -> Vernacexpr.proof_end -> unit
 
@@ -66,3 +67,4 @@ val save_proof : ?proof:Proof_global.closed_proof -> Vernacexpr.proof_end -> uni
    and the current global env *)
 
 val get_current_context : unit -> Evd.evar_map * Environ.env
+[@@ocaml.deprecated "please use [Pfedit.get_current_context]"]
diff --git a/vernac/locality.ml b/vernac/locality.ml
index 054a451a4..87b411625 100644
--- a/vernac/locality.ml
+++ b/vernac/locality.ml
@@ -6,46 +6,14 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Pp
+open Decl_kinds
 
 (** * Managing locality *)
 
 let local_of_bool = function
-  | true -> Decl_kinds.Local
-  | false -> Decl_kinds.Global
-
-let check_locality locality_flag =
-  match locality_flag with
-  | Some b ->
-    let s = if b then "Local" else "Global" in
-    CErrors.user_err ~hdr:"Locality.check_locality"
-      (str "This command does not support the \"" ++ str s ++ str "\" prefix.")
-  | None -> ()
-
-(** Extracting the 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 ->
-	CErrors.user_err Pp.(str "Cannot be simultaneously Local and Global.")
-    | Some true when local ->
-	CErrors.user_err Pp.(str "Use only prefix \"Local\".")
-    | None ->
-	if local then begin
-	    warn_deprecated_local_syntax ();
-	    Some true
-	end else
-	None
-    | Some b -> Some b in
-  local
+  | true -> Local
+  | false -> Global
+
 
 (** Positioning locality for commands supporting discharging and export
      outside of modules *)
@@ -58,15 +26,16 @@ let make_non_locality = function Some false -> false | _ -> true
 
 let make_locality = function Some true -> true | _ -> false
 
-let enforce_locality locality_flag local =
-   make_locality (enforce_locality_full locality_flag local)
+let enforce_locality_exp locality_flag discharge =
+  match locality_flag, discharge with
+  | Some b, NoDischarge -> local_of_bool b
+  | None, NoDischarge -> Global
+  | None, DoDischarge -> Discharge
+  | Some true, DoDischarge -> CErrors.user_err Pp.(str "Local not allowed in this case")
+  | Some false, DoDischarge -> CErrors.user_err Pp.(str "Global not allowed in this case")
 
-let enforce_locality_exp locality_flag local =
-  match locality_flag, local with
-  | None, Some local -> local
-  | Some b, None -> local_of_bool b
-  | None, None -> Decl_kinds.Global
-  | Some _, Some _ -> CErrors.user_err Pp.(str "Local non allowed in this case")
+let enforce_locality locality_flag =
+   make_locality locality_flag
 
 (* For commands whose default is to not discharge but to export:
    Global in sections forces discharge, Global not in section is the default;
@@ -75,8 +44,8 @@ let enforce_locality_exp locality_flag local =
 let make_section_locality =
   function Some b -> b | None -> Lib.sections_are_opened ()
 
-let enforce_section_locality locality_flag local =
-  make_section_locality (enforce_locality_full locality_flag local)
+let enforce_section_locality locality_flag =
+  make_section_locality locality_flag
 
 (** Positioning locality for commands supporting export but not discharge *)
 
@@ -93,15 +62,5 @@ let make_module_locality = function
   | Some true -> true
   | None -> false
 
-let enforce_module_locality locality_flag local =
-  make_module_locality (enforce_locality_full locality_flag local)
-
-module LocalityFixme = struct
-  let locality = ref None
-  let set l = locality := l
-  let consume () =
-    let l = !locality in
-    locality := None;
-    l
-  let assert_consumed () = check_locality !locality
-end
+let enforce_module_locality locality_flag =
+  make_module_locality locality_flag
diff --git a/vernac/locality.mli b/vernac/locality.mli
index c1c45d6b0..922538b23 100644
--- a/vernac/locality.mli
+++ b/vernac/locality.mli
@@ -8,10 +8,6 @@
 
 (** * Managing locality *)
 
-(** Commands which supported an inlined Local flag *)
-
-val enforce_locality_full : bool option -> bool -> bool option
-
 (** * Positioning locality for commands supporting discharging and export
     outside of modules *)
 
@@ -22,16 +18,15 @@ val enforce_locality_full : bool option -> bool -> bool option
 
 val make_locality : bool option -> bool
 val make_non_locality : bool option -> bool
-val enforce_locality : bool option -> bool -> bool
-val enforce_locality_exp :
-  bool option -> Decl_kinds.locality option -> Decl_kinds.locality
+val enforce_locality_exp : bool option -> Decl_kinds.discharge -> Decl_kinds.locality
+val enforce_locality : bool option -> bool
 
 (** For commands whose default is to not discharge but to export:
     Global in sections forces discharge, Global not in section is the default;
     Local in sections is the default, Local not in section forces non-export *)
 
 val make_section_locality : bool option -> bool
-val enforce_section_locality : bool option -> bool -> bool
+val enforce_section_locality : bool option -> bool
 
 (** * Positioning locality for commands supporting export but not discharge *)
 
@@ -40,12 +35,4 @@ val enforce_section_locality : bool option -> bool -> bool
     Local in sections is the default, Local not in section forces non-export *)
 
 val make_module_locality : bool option -> bool
-val enforce_module_locality : bool option -> bool -> bool
-
-(* This is the old imperative interface that is still used for
- * VernacExtend vernaculars.  Time permitting this could be trashed too *)
-module LocalityFixme : sig
-  val set : bool option -> unit
-  val consume : unit -> bool option
-  val assert_consumed : unit -> unit
-end
+val enforce_module_locality : bool option -> bool
diff --git a/vernac/metasyntax.ml b/vernac/metasyntax.ml
index 8b042a3ca..f63206216 100644
--- a/vernac/metasyntax.ml
+++ b/vernac/metasyntax.ml
@@ -7,7 +7,6 @@
 (************************************************************************)
 
 open Pp
-open Flags
 open CErrors
 open Util
 open Names
@@ -44,13 +43,6 @@ 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
@@ -58,11 +50,11 @@ let pr_entry e =
   str (Buffer.contents entry_buf)
 
 let pr_registered_grammar name =
-  let gram = try Some (String.Map.find name !grammars) with Not_found -> None in
+  let gram = try Some (Pcoq.find_grammars_by_name name) with Not_found -> None in
   match gram with
   | None -> user_err Pp.(str "Unknown or unprintable grammar entry.")
   | Some entries ->
-    let pr_one (AnyEntry e) =
+    let pr_one (Pcoq.AnyEntry e) =
       str "Entry " ++ str (Pcoq.Gram.Entry.name e) ++ str " is" ++ fnl () ++
       pr_entry e
     in
@@ -81,8 +73,8 @@ let pr_grammar = function
   | "pattern" ->
       pr_entry Pcoq.Constr.pattern
   | "vernac" ->
-      str "Entry vernac is" ++ fnl () ++
-      pr_entry Pcoq.Vernac_.vernac ++
+      str "Entry vernac_control is" ++ fnl () ++
+      pr_entry Pcoq.Vernac_.vernac_control ++
       str "Entry command is" ++ fnl () ++
       pr_entry Pcoq.Vernac_.command ++
       str "Entry syntax is" ++ fnl () ++
@@ -97,137 +89,109 @@ let pr_grammar = function
 (* Parse a format (every terminal starting with a letter or a single
    quote (except a single quote alone) must be quoted) *)
 
-let parse_format ((loc, str) : lstring) =
-  let str = " "^str in
-  let l = String.length str in
-  let push_token a = function
-    | cur::l -> (a::cur)::l
-    | [] -> [[a]] in
-  let push_white n l =
-    if Int.equal n 0 then l else push_token (UnpTerminal (String.make n ' ')) l in
-  let close_box i b = function
-    | a::(_::_ as l) -> push_token (UnpBox (b,a)) l
-    | _ -> user_err Pp.(str "Non terminated box in format.") in
-  let close_quotation i =
-    if i < String.length str && str.[i] == '\'' && (Int.equal (i+1) l || str.[i+1] == ' ')
-    then i+1
-    else user_err Pp.(str "Incorrectly terminated quoted expression.") in
+let parse_format ({CAst.loc;v=str} : Misctypes.lstring) =
+  let len = String.length str in
+  (* TODO: update the line of the location when the string contains newlines *)
+  let make_loc i j = Option.map (Loc.shift_loc (i+1) (j-len)) loc in
+  let push_token loc a = function
+    | (i,cur)::l -> (i,(loc,a)::cur)::l
+    | [] -> assert false in
+  let push_white i n l =
+    if Int.equal n 0 then l else push_token (make_loc i (i+n)) (UnpTerminal (String.make n ' ')) l in
+  let close_box start stop b = function
+    | (_,a)::(_::_ as l) -> push_token (make_loc start stop) (UnpBox (b,a)) l
+    | [a] -> user_err ?loc:(make_loc start stop) Pp.(str "Non terminated box in format.")
+    | [] -> assert false in
+  let close_quotation start i =
+    if i < len && str.[i] == '\'' then
+      if (Int.equal (i+1) len || str.[i+1] == ' ')
+      then i+1
+      else user_err ?loc:(make_loc (i+1) (i+1)) Pp.(str "Space expected after quoted expression.")
+    else
+      user_err ?loc:(make_loc start (i-1)) Pp.(str "Beginning of quoted expression expected to be ended by a quote.") in
   let rec spaces n i =
-    if i < String.length str && str.[i] == ' ' then spaces (n+1) (i+1)
+    if i < len && str.[i] == ' ' then spaces (n+1) (i+1)
     else n in
   let rec nonspaces quoted n i =
-    if i < String.length str && str.[i] != ' ' then
+    if i < len && str.[i] != ' ' then
       if str.[i] == '\'' && quoted &&
-        (i+1 >= String.length str || str.[i+1] == ' ')
-      then if Int.equal n 0 then user_err Pp.(str "Empty quoted token.") else n
+        (i+1 >= len || str.[i+1] == ' ')
+      then if Int.equal n 0 then user_err ?loc:(make_loc (i-1) i) Pp.(str "Empty quoted token.") else n
       else nonspaces quoted (n+1) (i+1)
     else
-      if quoted then user_err Pp.(str "Spaces are not allowed in (quoted) symbols.")
+      if quoted then user_err ?loc:(make_loc i i) Pp.(str "Spaces are not allowed in (quoted) symbols.")
       else n in
   let rec parse_non_format i =
     let n = nonspaces false 0 i in
-    push_token (UnpTerminal (String.sub str i n)) (parse_token (i+n))
+    push_token (make_loc i (i+n-1)) (UnpTerminal (String.sub str i n)) (parse_token 1 (i+n))
   and parse_quoted n i =
-    if i < String.length str then match str.[i] with
+    if i < len then match str.[i] with
       (* Parse " // " *)
-      | '/' when i <= String.length str && str.[i+1] == '/' ->
-          (* We forget the useless n spaces... *)
-	  push_token (UnpCut PpFnl)
-            (parse_token (close_quotation (i+2)))
+      | '/' when i+1 < len && str.[i+1] == '/' ->
+          (* We discard the useless n spaces... *)
+	  push_token (make_loc (i-n) (i+1)) (UnpCut PpFnl)
+            (parse_token 1 (close_quotation i (i+2)))
       (* Parse " .. / .. " *)
-      | '/' when i <= String.length str ->
+      | '/' when i+1 < len ->
 	  let p = spaces 0 (i+1) in
-	  push_token (UnpCut (PpBrk (n,p)))
-            (parse_token (close_quotation (i+p+1)))
+	  push_token (make_loc (i-n) (i+p)) (UnpCut (PpBrk (n,p)))
+            (parse_token 1 (close_quotation i (i+p+1)))
       | c ->
       (* The spaces are real spaces *)
-      push_white n (match c with
+      push_white i n (match c with
       | '[' ->
-	  if i <= String.length str then match str.[i+1] with
+	  if i+1 < len then match str.[i+1] with
 	    (* Parse " [h .. ",  *)
-	    | 'h' when i+1 <= String.length str && str.[i+2] == 'v' ->
-		  (parse_box (fun n -> PpHVB n) (i+3))
+	    | 'h' when i+1 <= len && str.[i+2] == 'v' ->
+		  (parse_box i (fun n -> PpHVB n) (i+3))
 		(* Parse " [v .. ",  *)
 	    | 'v' ->
-		    parse_box (fun n -> PpVB n) (i+2)
+		    parse_box i (fun n -> PpVB n) (i+2)
 		(* Parse " [ .. ",  *)
 	    | ' ' | '\'' ->
-		parse_box (fun n -> PpHOVB n) (i+1)
-	    | _ -> user_err Pp.(str "\"v\", \"hv\", \" \" expected after \"[\" in format.")
-	  else user_err Pp.(str "\"v\", \"hv\" or \" \" expected after \"[\" in format.")
+		parse_box i (fun n -> PpHOVB n) (i+1)
+	    | _ -> user_err ?loc:(make_loc i i) Pp.(str "\"v\", \"hv\", \" \" expected after \"[\" in format.")
+	  else user_err ?loc:(make_loc i i) Pp.(str "\"v\", \"hv\" or \" \" expected after \"[\" in format.")
       (* Parse "]"  *)
       | ']' ->
-	  ([] :: parse_token (close_quotation (i+1)))
+	  ((i,[]) :: parse_token 1 (close_quotation i (i+1)))
       (* Parse a non formatting token *)
       | c ->
 	  let n = nonspaces true 0 i in
-	  push_token (UnpTerminal (String.sub str (i-1) (n+2)))
-	    (parse_token (close_quotation (i+n))))
+	  push_token (make_loc i (i+n-1)) (UnpTerminal (String.sub str (i-1) (n+2)))
+	    (parse_token 1 (close_quotation i (i+n))))
     else
       if Int.equal n 0 then []
-      else user_err Pp.(str "Ending spaces non part of a format annotation.")
-  and parse_box box i =
+      else user_err ?loc:(make_loc (len-n) len) Pp.(str "Ending spaces non part of a format annotation.")
+  and parse_box start box i =
     let n = spaces 0 i in
-    close_box i (box n) (parse_token (close_quotation (i+n)))
-  and parse_token i =
+    close_box start (i+n-1) (box n) (parse_token 1 (close_quotation i (i+n)))
+  and parse_token k i =
     let n = spaces 0 i in
     let i = i+n in
-    if i < l then match str.[i] with
+    if i < len then match str.[i] with
       (* Parse a ' *)
-      |	'\'' when i+1 >= String.length str || str.[i+1] == ' ' ->
-	  push_white (n-1) (push_token (UnpTerminal "'") (parse_token (i+1)))
+      |	'\'' when i+1 >= len || str.[i+1] == ' ' ->
+	  push_white (i-n) (n-k) (push_token (make_loc i (i+1)) (UnpTerminal "'") (parse_token 1 (i+1)))
       (* Parse the beginning of a quoted expression *)
       |	'\'' ->
-          parse_quoted (n-1) (i+1)
+          parse_quoted (n-k) (i+1)
       (* Otherwise *)
       | _ ->
-          push_white (n-1) (parse_non_format i)
-    else push_white n [[]]
+          push_white (i-n) (n-k) (parse_non_format i)
+    else push_white (i-n) n [(len,[])]
   in
-  try
-    if not (String.is_empty str) then match parse_token 0 with
-      | [l] -> l
-      | _ -> user_err Pp.(str "Box closed without being opened in format.")
-    else
-      user_err Pp.(str "Empty format.")
-  with reraise ->
-    let (e, info) = CErrors.push reraise in
-    let info = Option.cata (Loc.add_loc info) info loc in
-    iraise (e, info)
+  if not (String.is_empty str) then
+    match parse_token 0 0 with
+    | [_,l] -> l
+    | (i,_)::_ -> user_err ?loc:(make_loc i i) Pp.(str "Box closed without being opened.")
+    | [] -> assert false
+  else
+    []
 
 (***********************)
 (* Analyzing notations *)
 
-type symbol_token = WhiteSpace of int | String of string
-
-let split_notation_string str =
-  let push_token beg i l =
-    if Int.equal beg i then l else
-      let s = String.sub str beg (i - beg) in
-      String s :: l
-  in
-  let push_whitespace beg i l =
-    if Int.equal beg i then l else WhiteSpace (i-beg) :: l
-  in
-  let rec loop beg i =
-    if i < String.length str then
-      if str.[i] == ' ' then
-	push_token beg i (loop_on_whitespace (i+1) (i+1))
-      else
-	loop beg (i+1)
-    else
-      push_token beg i []
-  and loop_on_whitespace beg i =
-    if i < String.length str then
-      if str.[i] != ' ' then
-	push_whitespace beg i (loop i (i+1))
-      else
-	loop_on_whitespace beg (i+1)
-    else
-      push_whitespace beg i []
-  in
-  loop 0 0
-
 (* Interpret notations with a recursive component *)
 
 let out_nt = function NonTerminal x -> x | _ -> assert false
@@ -283,17 +247,6 @@ let quote_notation_token x =
   if (n > 0 && norm) || (n > 2 && x.[0] == '\'') then "'"^x^"'"
   else x
 
-let rec raw_analyze_notation_tokens = function
-  | []    -> []
-  | String ".." :: sl -> NonTerminal ldots_var :: raw_analyze_notation_tokens sl
-  | String "_" :: _ -> user_err Pp.(str "_ must be quoted.")
-  | String x :: sl when CLexer.is_ident x ->
-      NonTerminal (Names.Id.of_string x) :: raw_analyze_notation_tokens sl
-  | String s :: sl ->
-      Terminal (String.drop_simple_quotes s) :: raw_analyze_notation_tokens sl
-  | WhiteSpace n :: sl ->
-      Break n :: raw_analyze_notation_tokens sl
-
 let is_numeral symbs =
   match List.filter (function Break _ -> false | _ -> true) symbs with
   | ([Terminal "-"; Terminal x] | [Terminal x]) ->
@@ -309,20 +262,20 @@ let rec get_notation_vars onlyprint = function
 	(* don't check for nonlinearity if printing only, see Bug 5526 *)
 	if not onlyprint && Id.List.mem id vars then 
 	  user_err ~hdr:"Metasyntax.get_notation_vars"
-            (str "Variable " ++ pr_id id ++ str " occurs more than once.")
+            (str "Variable " ++ Id.print id ++ str " occurs more than once.")
 	else id::vars
   | (Terminal _ | Break _) :: sl -> get_notation_vars onlyprint sl
   | SProdList _ :: _ -> assert false
 
-let analyze_notation_tokens ~onlyprint l =
-  let l = raw_analyze_notation_tokens l in
+let analyze_notation_tokens ~onlyprint ntn =
+  let l = decompose_raw_notation ntn in
   let vars = get_notation_vars onlyprint l in
   let recvars,l = interp_list_parser [] l in
   recvars, List.subtract Id.equal vars (List.map snd recvars), l
 
 let error_not_same_scope x y =
   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.")
+    (str "Variables " ++ Id.print x ++ str " and " ++ Id.print y ++ str " must be in the same scope.")
 
 (**********************************************************************)
 (* Build pretty-printing rules                                        *)
@@ -332,13 +285,17 @@ let prec_assoc = function
   | LeftA -> (E,L)
   | NonA -> (L,L)
 
-let precedence_of_entry_type from = function
-  | ETConstr (NumLevel n,BorderProd (_,None)) -> n, Prec n
-  | ETConstr (NumLevel n,BorderProd (b,Some a)) ->
+let precedence_of_position_and_level from = function
+  | NumLevel n, BorderProd (_,None) -> n, Prec n
+  | NumLevel n, BorderProd (b,Some a) ->
       n, let (lp,rp) = prec_assoc a in if b == Left then lp else rp
-  | ETConstr (NumLevel n,InternalProd) -> n, Prec n
-  | ETConstr (NextLevel,_) -> from, L
-  | _ -> 0, E (* ?? *)
+  | NumLevel n, InternalProd -> n, Prec n
+  | NextLevel, _ -> from, L
+
+let precedence_of_entry_type from = function
+  | ETConstr x | ETConstrAsBinder (_,x) -> precedence_of_position_and_level from x
+  | ETPattern (_,n) -> let n = match n with None -> 0 | Some n -> n in n, Prec n
+  | _ -> 0, E (* should not matter *)
 
 (* Some breaking examples *)
 (* "x = y" : "x /1 = y" (breaks before any symbol) *)
@@ -376,19 +333,20 @@ let is_non_terminal = function
   | NonTerminal _ | SProdList _ -> true
   | _ -> false
 
-let is_next_non_terminal = function
-| [] -> false
+let is_next_non_terminal b = function
+| [] -> b
 | pr :: _ -> is_non_terminal pr
 
 let is_next_terminal = function Terminal _ :: _ -> true | _ -> false
 
 let is_next_break = function Break _ :: _ -> true | _ -> false
 
-let add_break n l = UnpCut (PpBrk(n,0)) :: l
+let add_break n l = (None,UnpCut (PpBrk(n,0))) :: l
 
-let add_break_if_none n = function
-  | ((UnpCut (PpBrk _) :: _) | []) as l -> l
-  | l -> UnpCut (PpBrk(n,0)) :: l
+let add_break_if_none n b = function
+  | (_,UnpCut (PpBrk _)) :: _ as l -> l
+  | [] when not b -> []
+  | l -> (None,UnpCut (PpBrk(n,0))) :: l
 
 let check_open_binder isopen sl m =
   let pr_token = function
@@ -397,50 +355,64 @@ let check_open_binder isopen sl m =
   | _ -> assert false
   in
   if isopen && not (List.is_empty sl) then
-    user_err  (str "as " ++ pr_id m ++
+    user_err  (str "as " ++ Id.print m ++
       str " is a non-closed binder, no such \"" ++
       prlist_with_sep spc pr_token sl
       ++ strbrk "\" is allowed to occur.")
 
+let unparsing_metavar i from typs =
+  let x = List.nth typs (i-1) in
+  let prec = snd (precedence_of_entry_type from x) in
+  match x with
+  | ETConstr _ | ETConstrAsBinder _ | ETReference | ETBigint ->
+     UnpMetaVar (i,prec)
+  | ETPattern _ ->
+     UnpBinderMetaVar (i,prec)
+  | ETName ->
+     UnpBinderMetaVar (i,Prec 0)
+  | ETBinder isopen ->
+     assert false
+  | ETOther _ -> failwith "TODO"
+
 (* Heuristics for building default printing rules *)
 
 let index_id id l = List.index Id.equal id l
 
 let make_hunks etyps symbols from =
   let vars,typs = List.split etyps in
-  let rec make = function
+  let rec make b = function
     | NonTerminal m :: prods ->
 	let i = index_id m vars in
-	let _,prec = precedence_of_entry_type from (List.nth typs (i-1)) in
-	let u = UnpMetaVar (i,prec) in
-	if is_next_non_terminal prods then
-	  u :: add_break_if_none 1 (make prods)
+        let u = unparsing_metavar i from typs in
+        if is_next_non_terminal b prods then
+          (None, u) :: add_break_if_none 1 b (make b prods)
 	else
-	  u :: make_with_space prods
-    | Terminal s :: prods when List.exists is_non_terminal prods ->
+          (None, u) :: make_with_space b prods
+    | Terminal s :: prods
+         when (* true to simulate presence of non-terminal *) b || List.exists is_non_terminal prods ->
         if (is_comma s || is_operator s) then
           (* Always a breakable space after comma or separator *)
-	  UnpTerminal s :: add_break_if_none 1 (make prods)
+          (None, UnpTerminal s) :: add_break_if_none 1 b (make b prods)
 	else if is_right_bracket s && is_next_terminal prods then
           (* Always no space after right bracked, but possibly a break *)
-	  UnpTerminal s :: add_break_if_none 0 (make prods)
-        else if is_left_bracket s  && is_next_non_terminal prods then
-	  UnpTerminal s :: make prods
+          (None, UnpTerminal s) :: add_break_if_none 0 b (make b prods)
+        else if is_left_bracket s  && is_next_non_terminal b prods then
+          (None, UnpTerminal s) :: make b prods
 	else if not (is_next_break prods) then
           (* Add rigid space, no break, unless user asked for something *)
-          UnpTerminal (s^" ") :: make prods
+          (None, UnpTerminal (s^" ")) :: make b prods
         else
           (* Rely on user spaces *)
-          UnpTerminal s :: make prods
+          (None, UnpTerminal s) :: make b prods
 
     | Terminal s :: prods ->
         (* Separate but do not cut a trailing sequence of terminal *)
         (match prods with
-        | Terminal _ :: _ -> UnpTerminal (s^" ") :: make prods
-        | _ -> UnpTerminal s :: make prods)
+        | Terminal _ :: _ -> (None,UnpTerminal (s^" ")) :: make b prods
+        | _ -> (None,UnpTerminal s) :: make b prods)
 
     | Break n :: prods ->
-	add_break n (make prods)
+        add_break n (make b prods)
 
     | SProdList (m,sl) :: prods ->
 	let i = index_id m vars in
@@ -450,95 +422,104 @@ let make_hunks etyps symbols from =
           (* If no separator: add a break *)
 	  if List.is_empty sl then add_break 1 []
           (* We add NonTerminal for simulation but remove it afterwards *)
-	  else snd (List.sep_last (make (sl@[NonTerminal m]))) in
+          else make true sl in
 	let hunk = match typ with
-	  | ETConstr _ -> UnpListMetaVar (i,prec,sl')
+	  | ETConstr _ -> UnpListMetaVar (i,prec,List.map snd sl')
 	  | ETBinder isopen ->
 	      check_open_binder isopen sl m;
-	      UnpBinderListMetaVar (i,isopen,sl')
+	      UnpBinderListMetaVar (i,isopen,List.map snd sl')
 	  | _ -> assert false in
-	hunk :: make_with_space prods
+        (None, hunk) :: make_with_space b prods
 
     | [] -> []
 
-  and make_with_space prods =
+  and make_with_space b prods =
     match prods with
     | Terminal s' :: prods'->
         if is_operator s' then
           (* A rigid space before operator and a breakable after *)
-          UnpTerminal (" "^s') :: add_break_if_none 1 (make prods')
+          (None,UnpTerminal (" "^s')) :: add_break_if_none 1 b (make b prods')
         else if is_comma s' then
           (* No space whatsoever before comma *)
-          make prods
+          make b prods
         else if is_right_bracket s' then
-          make prods
+          make b prods
         else
           (* A breakable space between any other two terminals *)
-          add_break_if_none 1 (make prods)
+          add_break_if_none 1 b (make b prods)
     | (NonTerminal _ | SProdList _) :: _ ->
         (* A breakable space before a non-terminal *)
-        add_break_if_none 1 (make prods)
+        add_break_if_none 1 b (make b prods)
     | Break _ :: _ ->
         (* Rely on user wish *)
-        make prods
+        make b prods
     | [] -> []
 
-  in make symbols
+  in make false symbols
 
 (* Build default printing rules from explicit format *)
 
-let error_format () = user_err Pp.(str "The format does not match the notation.")
+let error_format ?loc () = user_err ?loc Pp.(str "The format does not match the notation.")
+
+let warn_format_break =
+  CWarnings.create ~name:"notation-both-format-and-spaces" ~category:"parsing"
+         (fun () ->
+          strbrk "Discarding format implicitly indicated by multiple spaces in notation because an explicit format modifier is given.")
 
 let rec split_format_at_ldots hd = function
-  | UnpTerminal s :: fmt when String.equal s (Id.to_string ldots_var) -> List.rev hd, fmt
+  | (loc,UnpTerminal s) :: fmt when String.equal s (Id.to_string Notation_ops.ldots_var) -> loc, List.rev hd, fmt
   | u :: fmt ->
       check_no_ldots_in_box u;
       split_format_at_ldots (u::hd) fmt
   | [] -> raise Exit
 
 and check_no_ldots_in_box = function
-  | UnpBox (_,fmt) ->
+  | (_,UnpBox (_,fmt)) ->
       (try
-        let _ = split_format_at_ldots [] fmt in
-        user_err Pp.(str ("The special symbol \"..\" must occur at the same formatting depth than the variables of which it is the ellipse."))
+        let loc,_,_ = split_format_at_ldots [] fmt in
+        user_err ?loc Pp.(str ("The special symbol \"..\" must occur at the same formatting depth than the variables of which it is the ellipse."))
       with Exit -> ())
   | _ -> ()
 
+let error_not_same ?loc () =
+  user_err ?loc Pp.(str "The format is not the same on the right- and left-hand sides of the special token \"..\".")
+
 let skip_var_in_recursive_format = function
-  | UnpTerminal _ :: sl (* skip first var *) ->
+  | (_,UnpTerminal s) :: sl (* skip first var *) when not (List.for_all (fun c -> c = " ") (String.explode s)) ->
       (* To do, though not so important: check that the names match
          the names in the notation *)
       sl
-  | _ -> error_format ()
+  | (loc,_) :: _ -> error_not_same ?loc ()
+  | [] -> assert false
 
 let read_recursive_format sl fmt =
   let get_head fmt =
     let sl = skip_var_in_recursive_format fmt in
-    try split_format_at_ldots [] sl with Exit -> error_format () in
+    try split_format_at_ldots [] sl with Exit -> error_not_same ?loc:(fst (List.last (if sl = [] then fmt else sl))) () in
   let rec get_tail = function
-    | a :: sepfmt, b :: fmt when Pervasives.(=) a b -> get_tail (sepfmt, fmt) (* FIXME *)
+    | (loc,a) :: sepfmt, (_,b) :: fmt when Pervasives.(=) a b -> get_tail (sepfmt, fmt) (* FIXME *)
     | [], tail -> skip_var_in_recursive_format tail
-    | _ -> user_err Pp.(str "The format is not the same on the right and left hand side of the special token \"..\".") in
-  let slfmt, fmt = get_head fmt in
+    | (loc,_) :: _, ([] | (_,UnpTerminal _) :: _)-> error_not_same ?loc ()
+    | _, (loc,_)::_ -> error_not_same ?loc () in
+  let loc, slfmt, fmt = get_head fmt in
   slfmt, get_tail (slfmt, fmt)
 
 let hunks_of_format (from,(vars,typs)) symfmt =
   let rec aux = function
-  | symbs, (UnpTerminal s' as u) :: fmt
+  | symbs, (_,(UnpTerminal s' as u)) :: fmt
       when String.equal s' (String.make (String.length s') ' ') ->
       let symbs, l = aux (symbs,fmt) in symbs, u :: l
-  | Terminal s :: symbs, (UnpTerminal s') :: fmt
+  | Terminal s :: symbs, (_,UnpTerminal s') :: fmt
       when String.equal s (String.drop_simple_quotes s') ->
       let symbs, l = aux (symbs,fmt) in symbs, UnpTerminal s :: l
-  | NonTerminal s :: symbs, UnpTerminal s' :: fmt when Id.equal s (Id.of_string s') ->
+  | NonTerminal s :: symbs, (_,UnpTerminal s') :: fmt when Id.equal s (Id.of_string s') ->
       let i = index_id s vars in
-      let _,prec = precedence_of_entry_type from (List.nth typs (i-1)) in
-      let symbs, l = aux (symbs,fmt) in symbs, UnpMetaVar (i,prec) :: l
-  | symbs, UnpBox (a,b) :: fmt ->
+      let symbs, l = aux (symbs,fmt) in symbs, unparsing_metavar i from typs :: l
+  | symbs, (_,UnpBox (a,b)) :: fmt ->
       let symbs', b' = aux (symbs,b) in
       let symbs', l = aux (symbs',fmt) in
-      symbs', UnpBox (a,b') :: l
-  | symbs, (UnpCut _ as u) :: fmt ->
+      symbs', UnpBox (a,List.map (fun x -> (None,x)) b') :: l
+  | symbs, (_,(UnpCut _ as u)) :: fmt ->
       let symbs, l = aux (symbs,fmt) in symbs, u :: l
   | SProdList (m,sl) :: symbs, fmt ->
       let i = index_id m vars in
@@ -546,7 +527,7 @@ let hunks_of_format (from,(vars,typs)) symfmt =
       let _,prec = precedence_of_entry_type from typ in
       let slfmt,fmt = read_recursive_format sl fmt in
       let sl, slfmt = aux (sl,slfmt) in
-      if not (List.is_empty sl) then error_format ();
+      if not (List.is_empty sl) then error_format ?loc:(fst (List.last fmt)) ();
       let symbs, l = aux (symbs,fmt) in
       let hunk = match typ with
 	| ETConstr _ -> UnpListMetaVar (i,prec,slfmt)
@@ -556,7 +537,8 @@ let hunks_of_format (from,(vars,typs)) symfmt =
 	| _ -> assert false in
       symbs, hunk :: l
   | symbs, [] -> symbs, []
-  | _, _ -> error_format ()
+  | Break _ :: symbs, fmt -> warn_format_break (); aux (symbs,fmt)
+  | _, fmt -> error_format ?loc:(fst (List.hd fmt)) ()
   in
   match aux symfmt with
   | [], l -> l
@@ -568,8 +550,8 @@ let hunks_of_format (from,(vars,typs)) symfmt =
 let assoc_of_type n (_,typ) = precedence_of_entry_type n typ
 
 let is_not_small_constr = function
-    ETConstr _ -> true
-  | ETOther("constr","binder_constr") -> true
+    ETProdConstr _ -> true
+  | ETProdOther("constr","binder_constr") -> true
   | _ -> false
 
 let rec define_keywords_aux = function
@@ -600,15 +582,15 @@ let distribute a ll = List.map (fun l -> a @ l) ll
      t;sep;t;...;t;sep;t;...;t;sep;t;LIST1(t,sep) *)
 
 let expand_list_rule typ tkl x n p ll =
-  let camlp4_message_name = Some (add_suffix x ("_"^string_of_int n)) in
-  let main = GramConstrNonTerminal (ETConstr typ, camlp4_message_name) in
+  let camlp5_message_name = Some (add_suffix x ("_"^string_of_int n)) in
+  let main = GramConstrNonTerminal (ETProdConstr typ, camlp5_message_name) in
   let tks = List.map (fun x -> GramConstrTerminal x) tkl in
   let rec aux i hds ll =
   if i < p then aux (i+1) (main :: tks @ hds) ll
   else if Int.equal i (p+n) then
     let hds =
       GramConstrListMark (p+n,true,p) :: hds
-      @	[GramConstrNonTerminal (ETConstrList (typ,tkl), Some x)] in
+      @	[GramConstrNonTerminal (ETProdConstrList (typ,tkl), Some x)] in
     distribute hds ll
   else
     distribute (GramConstrListMark (i+1,false,p) :: hds @ [main]) ll @
@@ -617,7 +599,7 @@ let expand_list_rule typ tkl x n p ll =
 
 let is_constr_typ typ x etyps =
   match List.assoc x etyps with
-  | ETConstr typ' -> typ = typ'
+  | ETConstr typ' | ETConstrAsBinder (_,typ') -> typ = typ'
   | _ -> false
 
 let include_possible_similar_trailing_pattern typ etyps sl l =
@@ -630,12 +612,21 @@ let include_possible_similar_trailing_pattern typ etyps sl l =
     with Exit -> n,l in
   try_aux 0 l
 
+let prod_entry_type = function
+  | ETName -> ETProdName
+  | ETReference -> ETProdReference
+  | ETBigint -> ETProdBigint
+  | ETBinder _ -> assert false (* See check_binder_type *)
+  | ETConstr p | ETConstrAsBinder (_,p) -> ETProdConstr p
+  | ETPattern (_,n) -> ETProdPattern (match n with None -> 0 | Some n -> n)
+  | ETOther (s,t) -> ETProdOther (s,t)
+
 let make_production etyps symbols =
   let rec aux = function
     | [] -> [[]]
     | NonTerminal m :: l ->
         let typ = List.assoc m etyps in
-        distribute [GramConstrNonTerminal (typ, Some m)] (aux l)
+        distribute [GramConstrNonTerminal (prod_entry_type typ, Some m)] (aux l)
     | Terminal s :: l ->
         distribute [GramConstrTerminal (CLexer.terminal s)] (aux l)
     | Break _ :: l ->
@@ -650,8 +641,10 @@ let make_production etyps symbols =
             let p,l' = include_possible_similar_trailing_pattern typ etyps sl l in
             expand_list_rule typ tkl x 1 p (aux l')
         | ETBinder o ->
-	    distribute
-              [GramConstrNonTerminal (ETBinderList (o,tkl), Some x)] (aux l)
+            check_open_binder o sl x;
+            let typ = if o then (assert (tkl = []); ETBinderOpen) else ETBinderClosed tkl in
+            distribute
+              [GramConstrNonTerminal (ETProdBinderList typ, Some x)] (aux l)
         | _ ->
            user_err Pp.(str "Components of recursive patterns in notation must be terms or binders.") in
   let prods = aux symbols in
@@ -669,6 +662,7 @@ let rec find_symbols c_current c_next c_last = function
 
 let border = function
   | (_,ETConstr(_,BorderProd (_,a))) :: _ -> a
+  | (_,(ETConstrAsBinder(_,(_,BorderProd (_,a))))) :: _ -> a
   | _ -> None
 
 let recompute_assoc typs =
@@ -682,17 +676,16 @@ let recompute_assoc typs =
 (* Registration of syntax extensions (parsing/printing, no interpretation)*)
 
 let pr_arg_level from (lev,typ) =
-  let pplev = match lev with
+  let pplev = function
   | (n,L) when Int.equal n from -> str "at next level"
   | (n,E) -> str "at level " ++ int n
   | (n,L) -> str "at level below " ++ int n
   | (n,Prec m) when Int.equal m n -> str "at level " ++ int n
   | (n,_) -> str "Unknown level" in
-  let pptyp = match typ with
-  | NtnInternTypeConstr -> mt ()
-  | NtnInternTypeBinder -> str " " ++ surround (str "binder")
-  | NtnInternTypeIdent -> str " " ++ surround (str "ident") in
-  pplev ++ pptyp
+  Ppvernac.pr_set_entry_type (fun _ -> (*TO CHECK*) mt()) typ ++
+  (match typ with
+   | ETConstr _ | ETConstrAsBinder _ | ETPattern _ -> spc () ++ pplev lev
+   | _ -> mt ())
 
 let pr_level ntn (from,args,typs) =
   str "at level " ++ int from ++ spc () ++ str "with arguments" ++ spc() ++
@@ -795,8 +788,8 @@ type notation_modifier = {
   (* common to syn_data below *)
   only_parsing  : bool;
   only_printing : bool;
-  compat        : compat_version option;
-  format        : string Loc.located option;
+  compat        : Flags.compat_version option;
+  format        : Misctypes.lstring option;
   extra         : (string * string) list;
 }
 
@@ -824,15 +817,23 @@ let interp_modifiers modl = let open NotationMods in
         interp { acc with etyps = (id,typ) :: acc.etyps; } l
     | SetItemLevel ([],n) :: l ->
         interp acc l
+    | SetItemLevelAsBinder ([],_,_) :: l ->
+        interp acc l
     | SetItemLevel (s::idl,n) :: l ->
 	let id = Id.of_string s in
 	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
+        let typ = ETConstr (Some n) in
         interp { acc with etyps = (id,typ)::acc.etyps; } (SetItemLevel (idl,n)::l)
+    | SetItemLevelAsBinder (s::idl,bk,n) :: l ->
+        let id = Id.of_string s in
+        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 = ETConstrAsBinder (bk,n) in
+        interp { acc with etyps = (id,typ)::acc.etyps; } (SetItemLevelAsBinder (idl,bk,n)::l)
     | SetLevel n :: l ->
-
         interp { acc with level = Some n; } l
     | SetAssoc a :: l ->
 	if not (Option.is_empty acc.assoc) then user_err Pp.(str "An associativity is given more than once.");
@@ -846,7 +847,7 @@ let interp_modifiers modl = let open NotationMods in
     | SetFormat ("text",s) :: l ->
 	if not (Option.is_empty acc.format) then user_err Pp.(str "A format is given more than once.");
         interp { acc with format = Some s; } l
-    | SetFormat (k,(_,s)) :: l ->
+    | SetFormat (k,{CAst.v=s}) :: l ->
         interp { acc with extra = (k,s)::acc.extra; } l
   in interp default modl
 
@@ -859,7 +860,7 @@ 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,_)::_ -> user_err ~hdr:"Metasyntax.check_useless_entry_types"
-                  (pr_id x ++ str " is unbound in the notation.")
+                  (Id.print x ++ str " is unbound in the notation.")
   | _ -> ()
 
 let check_binder_type recvars etyps =
@@ -896,12 +897,17 @@ let get_compat_version mods =
 let set_entry_type etyps (x,typ) =
   let typ = try
     match List.assoc x etyps, typ with
-      | ETConstr (n,()), (_,BorderProd (left,_)) ->
+      | ETConstr (Some n), (_,BorderProd (left,_)) ->
           ETConstr (n,BorderProd (left,None))
-      | ETConstr (n,()), (_,InternalProd) -> ETConstr (n,InternalProd)
-      | (ETPattern | ETName | ETBigint | ETOther _ |
-	 ETReference | ETBinder _ as t), _ -> t
-      | (ETBinderList _ |ETConstrList _), _ -> assert false
+      | ETConstr (Some n), (_,InternalProd) -> ETConstr (n,InternalProd)
+      | ETConstrAsBinder (bk, Some n), (_,BorderProd (left,_)) ->
+          ETConstrAsBinder (bk, (n,BorderProd (left,None)))
+      | ETConstrAsBinder (bk, Some n), (_,InternalProd) ->
+         ETConstrAsBinder (bk, (n,InternalProd))
+      | ETPattern (b,n), _ -> ETPattern (b,n)
+      | (ETName | ETBigint | ETReference | ETBinder _ | ETOther _ as x), _ -> x
+      | ETConstr None, _ -> ETConstr typ
+      | ETConstrAsBinder (bk,None), _ -> ETConstrAsBinder (bk,typ)
     with Not_found -> ETConstr typ
   in (x,typ)
 
@@ -916,17 +922,14 @@ let join_auxiliary_recursive_types recvars etyps =
     | Some xtyp, Some ytyp when Pervasives.(=) xtyp ytyp -> typs (* FIXME *)
     | Some xtyp, Some ytyp ->
 	user_err 
-	  (strbrk "In " ++ pr_id x ++ str " .. " ++ pr_id y ++
+	  (strbrk "In " ++ Id.print x ++ str " .. " ++ Id.print y ++
 	   strbrk ", both ends have incompatible types."))
     recvars etyps
 
 let internalization_type_of_entry_type = function
-  | ETConstr _ -> NtnInternTypeConstr
-  | ETBigint | ETReference -> NtnInternTypeConstr
-  | ETBinder _ -> NtnInternTypeBinder
-  | ETName -> NtnInternTypeIdent
-  | ETPattern | ETOther _ -> user_err Pp.(str "Not supported.")
-  | ETBinderList _ | ETConstrList _ -> assert false
+  | ETBinder _ -> NtnInternTypeOnlyBinder
+  | ETConstr _ | ETConstrAsBinder _ | ETBigint | ETReference
+  | ETName | ETPattern _ | ETOther _ -> NtnInternTypeAny
 
 let set_internalization_type typs =
   List.map (fun (_, e) -> internalization_type_of_entry_type e) typs
@@ -937,28 +940,36 @@ let make_internalization_vars recvars mainvars typs =
   maintyps @ extratyps
 
 let make_interpretation_type isrec isonlybinding = function
-  | NtnInternTypeConstr when isrec -> NtnTypeConstrList
-  | NtnInternTypeConstr | NtnInternTypeIdent ->
-     if isonlybinding then NtnTypeOnlyBinder else NtnTypeConstr
-  | NtnInternTypeBinder when isrec -> NtnTypeBinderList
-   | NtnInternTypeBinder -> user_err Pp.(str "Type binder is only for use in recursive notations for binders.")
-
-let make_interpretation_vars recvars allvars =
+  | ETConstr _ ->
+     if isrec then NtnTypeConstrList else
+     if isonlybinding then
+       (* Parsed as constr, but interpreted as a binder: default is to parse it as an ident only *)
+       NtnTypeBinder (NtnBinderParsedAsConstr AsIdent)
+     else NtnTypeConstr
+  | ETConstrAsBinder (bk,_) -> NtnTypeBinder (NtnBinderParsedAsConstr bk)
+  | ETName -> NtnTypeBinder NtnParsedAsIdent
+  | ETPattern (ppstrict,_) -> NtnTypeBinder (NtnParsedAsPattern ppstrict) (* Parsed as ident/pattern, primarily interpreted as binder; maybe strict at printing *)
+  | ETBigint | ETReference | ETOther _ -> NtnTypeConstr
+  | ETBinder _ ->
+     if isrec then NtnTypeBinderList
+     else anomaly Pp.(str "Type binder is only for use in recursive notations for binders.")
+
+let make_interpretation_vars recvars allvars typs =
   let eq_subscope (sc1, l1) (sc2, l2) =
     Option.equal String.equal sc1 sc2 &&
     List.equal String.equal l1 l2
   in
   let check (x, y) =
-    let (_,scope1, _) = Id.Map.find x allvars in
-    let (_,scope2, _) = Id.Map.find y allvars in
+    let (_,scope1) = Id.Map.find x allvars in
+    let (_,scope2) = Id.Map.find y allvars in
     if not (eq_subscope scope1 scope2) then error_not_same_scope x y
   in
   let () = List.iter check recvars in
   let useless_recvars = List.map snd recvars in
   let mainvars =
     Id.Map.filter (fun x _ -> not (Id.List.mem x useless_recvars)) allvars in
-  Id.Map.mapi (fun x (isonlybinding, sc, typ) ->
-    (sc, make_interpretation_type (Id.List.mem_assoc x recvars) isonlybinding typ)) mainvars
+  Id.Map.mapi (fun x (isonlybinding, sc) ->
+    (sc, make_interpretation_type (Id.List.mem_assoc x recvars) isonlybinding (Id.List.assoc x typs))) mainvars
 
 let check_rule_productivity l =
   if List.for_all (function NonTerminal _ | Break _ -> true | _ -> false) l then
@@ -973,19 +984,28 @@ let warn_notation_bound_to_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
+         (function
+          | APrioriReversible -> assert false
+          | HasLtac ->
+             strbrk "This notation contains Ltac expressions: it will not be used for printing."
+          | NonInjective ids ->
+             let n = List.length ids in
+             strbrk (String.plural n "Variable") ++ spc () ++ pr_enum Id.print ids ++ spc () ++
+             strbrk (if n > 1 then "do" else "does") ++
+             str " not occur in the right-hand side." ++ spc() ++
+             strbrk "The notation will not be used for printing as it is not reversible.")
+
+let is_not_printable onlyparse reversibility = function
 | NVar _ ->
   if not onlyparse then warn_notation_bound_to_variable ();
   true
 | _ ->
-   if not onlyparse && nonreversible then
-     (warn_non_reversible_notation (); true)
+   if not onlyparse && reversibility <> APrioriReversible then
+     (warn_non_reversible_notation reversibility; true)
   else onlyparse
 
-let find_precedence lev etyps symbols =
+
+let find_precedence lev etyps symbols onlyprint =
   let first_symbol =
     let rec aux = function
       | Break _ :: t -> aux t
@@ -1002,24 +1022,30 @@ let find_precedence lev etyps symbols =
   match first_symbol with
   | None -> [],0
   | Some (NonTerminal x) ->
+      let test () =
+        if onlyprint then
+          if Option.is_empty lev then
+            user_err Pp.(str "Explicit level needed in only-printing mode when the level of the leftmost non-terminal is given.")
+          else [],Option.get lev
+        else
+          user_err Pp.(str "The level of the leftmost non-terminal cannot be changed.") in
       (try match List.assoc x etyps with
-	| ETConstr _ ->
-	    user_err Pp.(str "The level of the leftmost non-terminal cannot be changed.")
-	| ETName | ETBigint | ETReference ->
+        | ETConstr _ -> test ()
+        | ETConstrAsBinder (_,Some _) -> test ()
+        | (ETName | ETBigint | ETReference) ->
             begin match lev with
             | None ->
 	      ([Feedback.msg_info ?loc:None ,strbrk "Setting notation at level 0."],0)
             | Some 0 ->
               ([],0)
             | _ ->
-	      user_err Pp.(str "A notation starting with an atomic expression must be at level 0.")
+              user_err Pp.(str "A notation starting with an atomic expression must be at level 0.")
             end
-	| ETPattern | ETBinder _ | ETOther _ -> (* Give a default ? *)
-	    if Option.is_empty lev then
-	      user_err Pp.(str "Need an explicit level.")
-	    else [],Option.get lev
-        | ETConstrList _ | ETBinderList _ ->
-	    assert false (* internally used in grammar only *)
+        | (ETPattern _ | ETBinder _ | ETOther _ | ETConstrAsBinder _) ->
+            (* Give a default ? *)
+            if Option.is_empty lev then
+              user_err Pp.(str "Need an explicit level.")
+            else [],Option.get lev
       with Not_found ->
 	if Option.is_empty lev then
 	  user_err Pp.(str "A left-recursive notation must have an explicit level.")
@@ -1063,7 +1089,7 @@ let remove_curly_brackets l =
 
 module SynData = struct
 
-  type subentry_types = (Id.t * (production_level, production_position) constr_entry_key_gen) list
+  type subentry_types = (Id.t * (production_level * production_position) constr_entry_key_gen) list
 
   (* XXX: Document *)
   type syn_data = {
@@ -1074,8 +1100,8 @@ module SynData = struct
     (* Fields coming from the vernac-level modifiers *)
     only_parsing  : bool;
     only_printing : bool;
-    compat        : compat_version option;
-    format        : string Loc.located option;
+    compat        : Flags.compat_version option;
+    format        : Misctypes.lstring option;
     extra         : (string * string) list;
 
     (* XXX: Callback to printing, must remove *)
@@ -1117,8 +1143,7 @@ let compute_syntax_data df modifiers =
   let onlyparse = mods.only_parsing in
   if onlyprint && onlyparse then user_err (str "A notation cannot be both 'only printing' and 'only parsing'.");
   let assoc = Option.append mods.assoc (Some NonA) in
-  let toks = split_notation_string df in
-  let (recvars,mainvars,symbols) = analyze_notation_tokens ~onlyprint toks in
+  let (recvars,mainvars,symbols) = analyze_notation_tokens ~onlyprint df in
   let _ = check_useless_entry_types recvars mainvars mods.etyps in
   let _ = check_binder_type recvars mods.etyps in
 
@@ -1128,7 +1153,7 @@ let compute_syntax_data df modifiers =
   let need_squash = not (List.equal Notation.symbol_eq symbols symbols_for_grammar) in
   let ntn_for_grammar = if need_squash then make_notation_key symbols_for_grammar else ntn_for_interp in
   if not onlyprint then check_rule_productivity symbols_for_grammar;
-  let msgs,n = find_precedence mods.level mods.etyps symbols in
+  let msgs,n = find_precedence mods.level mods.etyps symbols onlyprint in
   (* To globalize... *)
   let etyps = join_auxiliary_recursive_types recvars mods.etyps in
   let sy_typs, prec =
@@ -1141,7 +1166,7 @@ let compute_syntax_data df modifiers =
   let i_typs = set_internalization_type sy_typs in
   let pa_sy_data = (sy_typs_for_grammar,symbols_for_grammar) in
   let pp_sy_data = (sy_typs,symbols) in
-  let sy_fulldata = (ntn_for_grammar,(n,prec_for_grammar,i_typs),need_squash) in
+  let sy_fulldata = (ntn_for_grammar,(n,prec_for_grammar,List.map snd sy_typs_for_grammar),need_squash) in
   let df' = ((Lib.library_dp(),Lib.current_dirpath true),df) in
   let i_data = ntn_for_interp, df' in
 
@@ -1160,7 +1185,7 @@ let compute_syntax_data df modifiers =
     mainvars;
     intern_typs = i_typs;
 
-    level  = (n,prec,i_typs);
+    level  = (n,prec,List.map snd sy_typs);
     pa_syntax_data = pa_sy_data;
     pp_syntax_data = pp_sy_data;
     not_data    = sy_fulldata;
@@ -1307,7 +1332,7 @@ let to_map l =
   let fold accu (x, v) = Id.Map.add x v accu in
   List.fold_left fold Id.Map.empty l
 
-let add_notation_in_scope local df c mods scope =
+let add_notation_in_scope local df env c mods scope =
   let open SynData in
   let sd = compute_syntax_data df mods in
   (* Prepare the interpretation *)
@@ -1318,10 +1343,10 @@ let add_notation_in_scope local df c mods scope =
     ninterp_var_type = to_map i_vars;
     ninterp_rec_vars = to_map sd.recvars;
   } in
-  let (acvars, ac, reversible) = interp_notation_constr nenv c in
-  let interp = make_interpretation_vars sd.recvars acvars in
+  let (acvars, ac, reversibility) = interp_notation_constr env nenv c in
+  let interp = make_interpretation_vars sd.recvars acvars (fst sd.pa_syntax_data) in
   let map (x, _) = try Some (x, Id.Map.find x interp) with Not_found -> None in
-  let onlyparse = is_not_printable sd.only_parsing (not reversible) ac in
+  let onlyparse = is_not_printable sd.only_parsing reversibility ac in
   let notation = {
     notobj_local = local;
     notobj_scope = scope;
@@ -1338,9 +1363,8 @@ let add_notation_in_scope local df c mods scope =
   Lib.add_anonymous_leaf (inNotation notation);
   sd.info
 
-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 ~onlyprint dfs in
+let add_notation_interpretation_core local df env ?(impls=empty_internalization_env) c scope onlyparse onlyprint compat =
+  let (recvars,mainvars,symbs) = analyze_notation_tokens ~onlyprint df in
   (* Recover types of variables and pa/pp rules; redeclare them if needed *)
   let i_typs, onlyprint = if not (is_numeral symbs) then begin
     let sy = recover_notation_syntax (make_notation_key symbs) in
@@ -1352,15 +1376,15 @@ let add_notation_interpretation_core local df ?(impls=empty_internalization_env)
   (* Declare interpretation *)
   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 i_vars = make_internalization_vars recvars mainvars (List.map internalization_type_of_entry_type i_typs) in
   let nenv = {
     ninterp_var_type = to_map i_vars;
     ninterp_rec_vars = to_map recvars;
   } in
-  let (acvars, ac, reversible) = interp_notation_constr ~impls nenv c in
-  let interp = make_interpretation_vars recvars acvars in
+  let (acvars, ac, reversibility) = interp_notation_constr env ~impls nenv c in
+  let interp = make_interpretation_vars recvars acvars (List.combine mainvars i_typs) in
   let map (x, _) = try Some (x, Id.Map.find x interp) with Not_found -> None in
-  let onlyparse = is_not_printable onlyparse (not reversible) ac in
+  let onlyparse = is_not_printable onlyparse reversibility ac in
   let notation = {
     notobj_local = local;
     notobj_scope = scope;
@@ -1376,7 +1400,7 @@ 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 open SynData in
+let add_syntax_extension local ({CAst.loc;v=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;
@@ -1384,40 +1408,39 @@ let add_syntax_extension local ((loc,df),mods) = let open SynData in
 
 (* Notations with only interpretation *)
 
-let add_notation_interpretation ((loc,df),c,sc) =
-  let df' = add_notation_interpretation_core false df c sc false false None in
+let add_notation_interpretation env ({CAst.loc;v=df},c,sc) =
+  let df' = add_notation_interpretation_core false df env c sc false false None in
   Dumpglob.dump_notation (loc,df') sc true
 
-let set_notation_for_interpretation impls ((_,df),c,sc) =
+let set_notation_for_interpretation env impls ({CAst.v=df},c,sc) =
   (try ignore
-    (silently (fun () -> add_notation_interpretation_core false df ~impls c sc false false None) ());
+    (Flags.silently (fun () -> add_notation_interpretation_core false df env ~impls c sc false false None) ());
   with NoSyntaxRule ->
     user_err Pp.(str "Parsing rule for this notation has to be previously declared."));
   Option.iter (fun sc -> Notation.open_close_scope (false,true,sc)) sc
 
 (* Main entry point *)
 
-let add_notation local c ((loc,df),modifiers) sc =
+let add_notation local env c ({CAst.loc;v=df},modifiers) sc =
   let df' =
    if no_syntax_modifiers modifiers then
     (* No syntax data: try to rely on a previously declared rule *)
     let onlyparse = is_only_parsing modifiers in
     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
+    try add_notation_interpretation_core local df env c sc onlyparse onlyprint compat
     with NoSyntaxRule ->
       (* Try to determine a default syntax rule *)
-      add_notation_in_scope local df c modifiers sc
+      add_notation_in_scope local df env c modifiers sc
    else
     (* Declare both syntax and interpretation *)
-    add_notation_in_scope local df c modifiers sc
+    add_notation_in_scope local df env c modifiers sc
   in
   Dumpglob.dump_notation (loc,df') sc true
 
 let add_notation_extra_printing_rule df k v =
   let notk = 
-    let dfs = split_notation_string df in
-    let _,_, symbs = analyze_notation_tokens ~onlyprint:true dfs in
+    let _,_, symbs = analyze_notation_tokens ~onlyprint:true df in
     make_notation_key symbs in
   Notation.add_notation_extra_printing_rule notk k v
 
@@ -1425,13 +1448,13 @@ let add_notation_extra_printing_rule df k v =
 
 let inject_var x = CAst.make @@ CRef (Ident (Loc.tag @@ Id.of_string x),None)
 
-let add_infix local ((loc,inf),modifiers) pr sc =
+let add_infix local env ({CAst.loc;v=inf},modifiers) pr sc =
   check_infix_modifiers modifiers;
   (* check the precedence *)
   let metas = [inject_var "x"; inject_var "y"] in
   let c = mkAppC (pr,metas) in
-  let df = "x "^(quote_notation_token inf)^" y" in
-  add_notation local c ((loc,df),modifiers) sc
+  let df = CAst.make ?loc @@ "x "^(quote_notation_token inf)^" y" in
+  add_notation local env c (df,modifiers) sc
 
 (**********************************************************************)
 (* Delimiters and classes bound to scopes                             *)
@@ -1487,24 +1510,22 @@ let try_interp_name_alias = function
   | [], { CAst.v = CRef (ref,_) } -> intern_reference ref
   | _ -> raise Not_found
 
-let add_syntactic_definition ident (vars,c) local onlyparse =
-  let nonprintable = ref false in
-  let vars,pat =
-    try [], NRef (try_interp_name_alias (vars,c))
+let add_syntactic_definition env ident (vars,c) local onlyparse =
+  let vars,reversibility,pat =
+    try [], APrioriReversible, NRef (try_interp_name_alias (vars,c))
     with Not_found ->
-      let fold accu id = Id.Map.add id NtnInternTypeConstr accu in
+      let fold accu id = Id.Map.add id NtnInternTypeAny accu in
       let i_vars = List.fold_left fold Id.Map.empty vars in
       let nenv = {
         ninterp_var_type = i_vars;
         ninterp_rec_vars = Id.Map.empty;
       } 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
+      let nvars, pat, reversibility = interp_notation_constr env nenv c in
+      let map id = let (_,sc) = Id.Map.find id nvars in (id, sc) in
+      List.map map vars, reversibility, pat
   in
   let onlyparse = match onlyparse with
-    | None when (is_not_printable false !nonprintable pat) -> Some Flags.Current
+    | None when (is_not_printable false reversibility pat) -> Some Flags.Current
     | p -> p
   in
   Syntax_def.declare_syntactic_definition local ident onlyparse (vars,pat)
diff --git a/vernac/metasyntax.mli b/vernac/metasyntax.mli
index 9cd00cbcb..7740604c3 100644
--- a/vernac/metasyntax.mli
+++ b/vernac/metasyntax.mli
@@ -11,15 +11,17 @@ open Vernacexpr
 open Notation
 open Constrexpr
 open Notation_term
+open Environ
+open Misctypes
 
 val add_token_obj : string -> unit
 
 (** Adding a (constr) notation in the environment*)
 
-val add_infix : locality_flag -> (lstring * syntax_modifier list) ->
+val add_infix : locality_flag -> env -> (lstring * syntax_modifier list) ->
   constr_expr -> scope_name option -> unit
 
-val add_notation : locality_flag -> constr_expr ->
+val add_notation : locality_flag -> env -> constr_expr ->
   (lstring * syntax_modifier list) -> scope_name option -> unit
 
 val add_notation_extra_printing_rule : string -> string -> string -> unit
@@ -33,11 +35,11 @@ val add_class_scope : scope_name -> scope_class list -> unit
 (** Add only the interpretation of a notation that already has pa/pp rules *)
 
 val add_notation_interpretation :
-  (lstring * constr_expr * scope_name option) -> unit
+  env -> (lstring * constr_expr * scope_name option) -> unit
 
 (** Add a notation interpretation for supporting the "where" clause *)
 
-val set_notation_for_interpretation : Constrintern.internalization_env ->
+val set_notation_for_interpretation : env -> Constrintern.internalization_env ->
   (lstring * constr_expr * scope_name option) -> unit
 
 (** Add only the parsing/printing rule of a notation *)
@@ -47,17 +49,13 @@ val add_syntax_extension :
 
 (** Add a syntactic definition (as in "Notation f := ...") *)
 
-val add_syntactic_definition : Id.t -> Id.t list * constr_expr ->
+val add_syntactic_definition : env -> Id.t -> Id.t list * constr_expr ->
   bool -> Flags.compat_version option -> unit
 
-(** Print the Camlp4 state of a grammar *)
+(** Print the Camlp5 state of a grammar *)
 
 val pr_grammar : string -> Pp.t
 
-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/vernac/mltop.ml b/vernac/mltop.ml
index e8a0ba3dd..053b9d070 100644
--- a/vernac/mltop.ml
+++ b/vernac/mltop.ml
@@ -9,7 +9,6 @@
 open CErrors
 open Util
 open Pp
-open Flags
 open Libobject
 open System
 
@@ -175,6 +174,7 @@ let warn_cannot_use_directory =
 let convert_string d =
   try Names.Id.of_string d
   with UserError _ ->
+    let d = Unicode.escaped_if_non_utf8 d in
     warn_cannot_use_directory d;
     raise Exit
 
@@ -184,10 +184,28 @@ let warn_cannot_open_path =
 
 type add_ml = AddNoML | AddTopML | AddRecML
 
-let add_rec_path add_ml ~unix_path ~coq_root ~implicit =
+type vo_path_spec = {
+  unix_path : string;
+  coq_path  : Names.DirPath.t;
+  implicit  : bool;
+  has_ml    : add_ml;
+}
+
+type coq_path_spec =
+  | VoPath of vo_path_spec
+  | MlPath of string
+
+type coq_path = {
+  path_spec: coq_path_spec;
+  recursive: bool;
+}
+
+let add_vo_path ~recursive lp =
+  let unix_path = lp.unix_path in
+  let implicit = lp.implicit in
   if exists_dir unix_path then
-    let dirs = all_subdirs ~unix_path in
-    let prefix = Names.DirPath.repr coq_root in
+    let dirs = if recursive then all_subdirs ~unix_path else [] in
+    let prefix = Names.DirPath.repr lp.coq_path in
     let convert_dirs (lp, cp) =
       try
         let path = List.rev_map convert_string cp @ prefix in
@@ -195,17 +213,23 @@ let add_rec_path add_ml ~unix_path ~coq_root ~implicit =
       with Exit -> None
     in
     let dirs = List.map_filter convert_dirs dirs in
-    let () = match add_ml with
+    let () = match lp.has_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
+    Loadpath.add_load_path unix_path ~implicit lp.coq_path
   else
     warn_cannot_open_path unix_path
 
+let add_coq_path { recursive; path_spec } = match path_spec with
+  | VoPath lp ->
+    add_vo_path ~recursive lp
+  | MlPath dir ->
+    if recursive then add_rec_ml_dir dir else add_ml_dir dir
+
 (* convertit un nom quelconque en nom de fichier ou de module *)
 let mod_of_name name =
     if Filename.check_suffix name ".cmo" then
@@ -365,7 +389,7 @@ let trigger_ml_object verb cache reinit ?path name =
   else begin
     let file = file_of_name (Option.default name path) in
     let path =
-      if_verbose_load (verb && not !quiet) load_ml_object name ?path file in
+      if_verbose_load (verb && not !Flags.quiet) load_ml_object name ?path file in
     add_loaded_module name (Some path);
     if cache then perform_cache_obj name
   end
@@ -378,7 +402,7 @@ let unfreeze_ml_modules x =
     (fun (name,path) -> trigger_ml_object false false false ?path name) x
 
 let _ =
-  Summary.declare_summary Summary.ml_modules
+  Summary.declare_ml_modules_summary
     { Summary.freeze_function = (fun _ -> get_loaded_modules ());
       Summary.unfreeze_function = unfreeze_ml_modules;
       Summary.init_function = reset_loaded_modules }
diff --git a/vernac/mltop.mli b/vernac/mltop.mli
index 324a66d38..e44a7c243 100644
--- a/vernac/mltop.mli
+++ b/vernac/mltop.mli
@@ -42,14 +42,26 @@ val dir_ml_load : string -> unit
 (** Dynamic interpretation of .ml *)
 val dir_ml_use : string -> unit
 
-(** Adds a path to the ML paths *)
-val add_ml_dir : string -> unit
-val add_rec_ml_dir : string -> unit
-
+(** Adds a path to the Coq and ML paths *)
 type add_ml = AddNoML | AddTopML | AddRecML
 
-(** Adds a path to the Coq and ML paths *)
-val add_rec_path : add_ml -> unix_path:string -> coq_root:Names.DirPath.t -> implicit:bool -> unit
+type vo_path_spec = {
+  unix_path : string;           (* Filesystem path contaning vo/ml files *)
+  coq_path  : Names.DirPath.t;  (* Coq prefix for the path *)
+  implicit  : bool;             (* [implicit = true] avoids having to qualify with [coq_path] *)
+  has_ml    : add_ml;           (* If [has_ml] is true, the directory will also be search for plugins *)
+}
+
+type coq_path_spec =
+  | VoPath of vo_path_spec
+  | MlPath of string
+
+type coq_path = {
+  path_spec: coq_path_spec;
+  recursive: bool;
+}
+
+val add_coq_path : coq_path -> unit
 
 (** List of modules linked to the toplevel *)
 val add_known_module : string -> unit
diff --git a/vernac/obligations.ml b/vernac/obligations.ml
index a4fe49020..e4bcbc4bb 100644
--- a/vernac/obligations.ml
+++ b/vernac/obligations.ml
@@ -13,6 +13,7 @@ open Declare
 *)
 
 open Term
+open Constr
 open Vars
 open Names
 open Evd
@@ -55,7 +56,7 @@ let subst_evar_constr evs n idf t =
   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
-  let rec substrec (depth, fixrels) c = match kind_of_term c with
+  let rec substrec (depth, fixrels) c = match Constr.kind c with
     | Evar (k, args) ->
 	let { ev_name = (id, idstr) ;
 	      ev_hyps = hyps ; ev_chop = chop } =
@@ -85,15 +86,15 @@ let subst_evar_constr evs n idf t =
 	  in aux hyps args []
 	in
 	  if List.exists
-            (fun x -> match kind_of_term x with
+            (fun x -> match Constr.kind x with
             | Rel n -> Int.List.mem n fixrels
             | _ -> false) args
           then
 	    transparent := Id.Set.add idstr !transparent;
 	  mkApp (idf idstr, Array.of_list args)
     | Fix _ ->
-	map_constr_with_binders succfix substrec (depth, 1 :: fixrels) c
-    | _ -> map_constr_with_binders succfix substrec (depth, fixrels) c
+	Constr.map_with_binders succfix substrec (depth, 1 :: fixrels) c
+    | _ -> Constr.map_with_binders succfix substrec (depth, fixrels) c
   in
   let t' = substrec (0, []) t in
     t', !seen, !transparent
@@ -103,9 +104,9 @@ let subst_evar_constr evs n idf t =
   where n binders were passed through. *)
 let subst_vars acc n t =
   let var_index id = Util.List.index Id.equal id acc in
-  let rec substrec depth c = match kind_of_term c with
+  let rec substrec depth c = match Constr.kind c with
     | Var v -> (try mkRel (depth + (var_index v)) with Not_found -> c)
-    | _ -> map_constr_with_binders succ substrec depth c
+    | _ -> Constr.map_with_binders succ substrec depth c
   in
     substrec 0 t
 
@@ -144,7 +145,7 @@ let rec chop_product n t =
   let pop t = Vars.lift (-1) t in
   if Int.equal n 0 then Some t
   else
-    match kind_of_term t with
+    match Constr.kind t with
       | Prod (_, _, b) ->  if noccurn 1 b then chop_product (pred n) (pop b) else None
       | _ -> None
 
@@ -154,7 +155,7 @@ let evar_dependencies evm oev =
       let evi = Evd.find evm ev in
       let deps' = evars_of_filtered_evar_info evi in
       if Evar.Set.mem oev deps' then
-	invalid_arg ("Ill-formed evar map: cycle detected for evar " ^ string_of_existential oev)
+        invalid_arg ("Ill-formed evar map: cycle detected for evar " ^ Pp.string_of_ppcmds @@ Evar.print oev)
       else Evar.Set.union deps' s)
       deps deps
   in
@@ -163,7 +164,7 @@ let evar_dependencies evm oev =
       if Evar.Set.equal deps deps' then deps
       else aux deps'
   in aux (Evar.Set.singleton oev)
-      
+
 let move_after (id, ev, deps as obl) l = 
   let rec aux restdeps = function
     | (id', _, _) as obl' :: tl -> 
@@ -273,7 +274,7 @@ let explain_no_obligations = function
   | None -> str "No obligations remaining"
 
 type obligation_info =
-    (Names.Id.t * Term.types * Evar_kinds.t Loc.located *
+    (Names.Id.t * types * Evar_kinds.t Loc.located *
        (bool * Evar_kinds.obligation_definition_status)
        * Int.Set.t * unit Proofview.tactic option) array
 
@@ -294,17 +295,17 @@ type obligation =
 type obligations = (obligation array * int)
 
 type fixpoint_kind =
-  | IsFixpoint of (Id.t Loc.located option * Constrexpr.recursion_order_expr) list
+  | IsFixpoint of (Misctypes.lident option * Constrexpr.recursion_order_expr) list
   | IsCoFixpoint
 
-type notations = (Vernacexpr.lstring * Constrexpr.constr_expr * Notation_term.scope_name option) list
+type notations = (Misctypes.lstring * Constrexpr.constr_expr * Notation_term.scope_name option) list
 
 type program_info_aux = {
   prg_name: Id.t;
   prg_body: constr;
   prg_type: constr;
-  prg_ctx:  Evd.evar_universe_context;
-  prg_pl: Id.t Loc.located list option;
+  prg_ctx:  UState.t;
+  prg_univdecl: Univdecls.universe_decl;
   prg_obligations: obligations;
   prg_deps : Id.t list;
   prg_fixkind : fixpoint_kind option ;
@@ -312,7 +313,7 @@ type program_info_aux = {
   prg_notations : notations ;
   prg_kind : definition_kind;
   prg_reduce : constr -> constr;
-  prg_hook : (Evd.evar_universe_context -> unit) Lemmas.declaration_hook;
+  prg_hook : (UState.t -> unit) Lemmas.declaration_hook;
   prg_opaque : bool;
   prg_sign: named_context_val;
 }
@@ -384,7 +385,7 @@ 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 (EConstr.Unsafe.to_constr (Termops.strip_outer_cast Evd.empty (EConstr.of_constr t))) (** FIXME *) with
+  match Constr.kind (EConstr.Unsafe.to_constr (Termops.strip_outer_cast Evd.empty (EConstr.of_constr t))) (** FIXME *) with
     | Prod (_,_,b) -> subst1 n b
     | LetIn (_, b, t, b') -> prod_app (subst1 b b') n
     | _ ->
@@ -400,13 +401,13 @@ let replace_appvars subst =
     let f, l = decompose_app c in
       if isVar f then
 	try
-	  let c' = List.map (map_constr aux) l in
+	  let c' = List.map (Constr.map aux) l in
 	  let (t, b) = Id.List.assoc (destVar f) subst in
 	    mkApp (delayed_force hide_obligation, 
 		   [| prod_applist t c'; applistc b c' |])
-	with Not_found -> map_constr aux c
-      else map_constr aux c
-  in map_constr aux
+	with Not_found -> Constr.map aux c
+      else Constr.map aux c
+  in Constr.map aux
        
 let subst_prog expand obls ints prg =
   let subst = obl_substitution expand obls ints in
@@ -428,15 +429,15 @@ let map_replace k v m = ProgMap.add k (CEphemeron.create v) (ProgMap.remove k m)
 
 let map_keys m = ProgMap.fold (fun k _ l -> k :: l) m []
 
-let from_prg : program_info ProgMap.t ref =
-  Summary.ref ProgMap.empty ~name:"program-tcc-table"
+let from_prg, program_tcc_summary_tag =
+  Summary.ref_tag ProgMap.empty ~name:"program-tcc-table"
 
 let close sec =
   if not (ProgMap.is_empty !from_prg) then
     let keys = map_keys !from_prg in
       user_err ~hdr:"Program" 
 	(str "Unsolved obligations when closing " ++ str sec ++ str":" ++ spc () ++
-	   prlist_with_sep spc (fun x -> Nameops.pr_id x) keys ++
+	   prlist_with_sep spc (fun x -> Id.print x) keys ++
 	   (str (if Int.equal (List.length keys) 1 then " has " else " have ") ++
 	      str "unsolved obligations"))
 
@@ -474,24 +475,23 @@ let declare_definition prg =
     (Evd.evar_universe_context_subst prg.prg_ctx) in
   let opaque = prg.prg_opaque 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 =
-    definition_entry ~fix_exn
-     ~opaque ~types:(nf typ) ~poly:(pi2 prg.prg_kind)
-     ~univs:(Evd.evar_context_universe_context prg.prg_ctx) (nf body)
-  in
+  let typ = nf typ in
+  let body = nf body in
+  let env = Global.env () in
+  let uvars = Univ.LSet.union
+      (Univops.universes_of_constr env typ)
+      (Univops.universes_of_constr env body) in
+  let uctx = UState.restrict prg.prg_ctx uvars in
+  let univs = UState.check_univ_decl ~poly:(pi2 prg.prg_kind) uctx prg.prg_univdecl in
+  let ce = definition_entry ~fix_exn ~opaque ~types:typ ~univs body in
   let () = progmap_remove prg in
-  let cst =
-    DeclareDef.declare_definition prg.prg_name
-     prg.prg_kind ce [] prg.prg_implicits
-     (Lemmas.mk_hook (fun l r -> Lemmas.call_hook fix_exn prg.prg_hook l r prg.prg_ctx; r))
-  in
-  Universes.register_universe_binders cst pl;
-  cst
+  let ubinders = UState.universe_binders uctx in
+  DeclareDef.declare_definition prg.prg_name
+    prg.prg_kind ce ubinders prg.prg_implicits
+    (Lemmas.mk_hook (fun l r -> Lemmas.call_hook fix_exn prg.prg_hook l r uctx; r))
 
 let rec lam_index n t acc =
-  match kind_of_term t with
+  match Constr.kind t with
     | Lambda (Name n', _, _) when Id.equal n n' ->
       acc
     | Lambda (_, _, b) ->
@@ -500,7 +500,7 @@ let rec lam_index n t acc =
 
 let compute_possible_guardness_evidences (n,_) fixbody fixtype =
   match n with
-  | Some (loc, n) -> [lam_index n fixbody 0]
+  | Some { CAst.loc; v = n } -> [lam_index n fixbody 0]
   | None ->
       (* If recursive argument was not given by user, we try all args.
 	 An earlier approach was to look only for inductive arguments,
@@ -552,12 +552,12 @@ let declare_mutual_definition l =
             mk_proof (mkCoFix (i,fixdecls))) 0 l
   in
   (* Declare the recursive definitions *)
-  let ctx = Evd.evar_context_universe_context first.prg_ctx in
+  let univs = UState.const_univ_entry ~poly first.prg_ctx in
   let fix_exn = Hook.get get_fix_exn () in
-  let kns = List.map4 (DeclareDef.declare_fix ~opaque (local, poly, kind) [] ctx)
+  let kns = List.map4 (DeclareDef.declare_fix ~opaque (local, poly, kind) Universes.empty_binders univs)
     fixnames fixdecls fixtypes fiximps in
     (* Declare notations *)
-    List.iter Metasyntax.add_notation_interpretation first.prg_notations;
+    List.iter (Metasyntax.add_notation_interpretation (Global.env())) first.prg_notations;
     Declare.recursive_message (fixkind != IsCoFixpoint) indexes fixnames;
     let gr = List.hd kns in
     let kn = match gr with ConstRef kn -> kn | _ -> assert false in
@@ -567,9 +567,9 @@ let declare_mutual_definition l =
 let decompose_lam_prod c ty =
   let open Context.Rel.Declaration in
   let rec aux ctx c ty =
-    match kind_of_term c, kind_of_term ty with
+    match Constr.kind c, Constr.kind ty with
     | LetIn (x, b, t, c), LetIn (x', b', t', ty)
-	 when eq_constr b b' && eq_constr t t' ->
+	 when Constr.equal b b' && Constr.equal t t' ->
        let ctx' = Context.Rel.add (LocalDef (x,b',t')) ctx in
        aux ctx' c ty
     | _, LetIn (x', b', t', ty) ->
@@ -636,12 +636,11 @@ let declare_obligation prg obl body ty uctx =
 	  shrink_body body ty else [], body, ty, [||]
       in
       let body = ((body,Univ.ContextSet.empty),Safe_typing.empty_private_constants) in
-      let univs = if poly then Polymorphic_const_entry uctx else Monomorphic_const_entry uctx in
       let ce =
         { const_entry_body = Future.from_val ~fix_exn:(fun x -> x) body;
           const_entry_secctx = None;
 	  const_entry_type = ty;
-	  const_entry_universes = univs;
+          const_entry_universes = uctx;
 	  const_entry_opaque = opaque;
           const_entry_inline_code = false;
           const_entry_feedback = None;
@@ -650,15 +649,17 @@ let declare_obligation prg obl body ty uctx =
       let constant = Declare.declare_constant obl.obl_name ~local:true
 	(DefinitionEntry ce,IsProof Property)
       in
-	if not opaque then add_hint (Locality.make_section_locality None) prg constant;
-	definition_message obl.obl_name;
-	true, { obl with obl_body =
-	    if poly then
-	      Some (DefinedObl (constant, Univ.UContext.instance uctx))
-	    else
-	      Some (TermObl (it_mkLambda_or_LetIn_or_clean (mkApp (mkConst constant, args)) ctx)) }
-
-let init_prog_info ?(opaque = false) sign n pl b t ctx deps fixkind
+      if not opaque then add_hint (Locality.make_section_locality None) prg constant;
+      definition_message obl.obl_name;
+      let body = match uctx with
+        | Polymorphic_const_entry uctx ->
+          Some (DefinedObl (constant, Univ.UContext.instance uctx))
+        | Monomorphic_const_entry _ ->
+          Some (TermObl (it_mkLambda_or_LetIn_or_clean (mkApp (mkConst constant, args)) ctx))
+      in
+      true, { obl with obl_body = body }
+
+let init_prog_info ?(opaque = false) sign n udecl b t ctx deps fixkind
 		   notations obls impls kind reduce hook =
   let obls', b =
     match b with
@@ -678,8 +679,9 @@ let init_prog_info ?(opaque = false) sign n pl b t ctx deps fixkind
 	      obl_deps = d; obl_tac = tac })
 	  obls, b
   in
+  let ctx = UState.make_flexible_nonalgebraic ctx in
     { prg_name = n ; prg_body = b; prg_type = reduce t; 
-      prg_ctx = ctx; prg_pl = pl;
+      prg_ctx = ctx; prg_univdecl = udecl;
       prg_obligations = (obls', Array.length obls');
       prg_deps = deps; prg_fixkind = fixkind ; prg_notations = notations ;
       prg_implicits = impls; prg_kind = kind; prg_reduce = reduce; 
@@ -716,10 +718,10 @@ 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
+                let progs = prlist_with_sep pr_comma Id.print progs in
                 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 "\""))
+                  ++ str "; use the \"of\" clause to specify, as in \"Obligation 1 of " ++ Id.print prog ++ str "\""))
 
 let get_any_prog () =
   let prg_infos = !from_prg in
@@ -829,46 +831,63 @@ let obligation_terminator name num guard hook auto pf =
   match pf with
   | Admitted _ -> apply_terminator term pf
   | Proved (opq, id, proof) ->
-    if not !shrink_obligations then apply_terminator term pf
-    else
-      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 (body, cstr), () = Future.force entry.Entries.const_entry_body in
-      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 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 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
+    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 (body, cstr), () = Future.force entry.Entries.const_entry_body in
+    let sigma = Evd.from_ctx 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
+    (** Ensure universes are substituted properly in body and type *)
+    let body = EConstr.to_constr sigma (EConstr.of_constr body) in
+    let ty = Option.map (fun x -> EConstr.to_constr sigma (EConstr.of_constr x)) ty in
+    let ctx = Evd.evar_universe_context sigma in
+    let obls, rem = prg.prg_obligations in
+    let obl = obls.(num) 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 ctx =
+      if pi2 prg.prg_kind then ctx
+      else UState.union prg.prg_ctx ctx
+    in
+    let uctx = UState.const_univ_entry ~poly:(pi2 prg.prg_kind) ctx in
+    let (_, obl) = declare_obligation prg obl body ty uctx in
+    let obls = Array.copy obls in
+    let _ = obls.(num) <- obl in
+    let prg_ctx =
+      if pi2 (prg.prg_kind) then (* Polymorphic *)
+        (** We merge the new universes and constraints of the
+            polymorphic obligation with the existing ones *)
+        UState.union prg.prg_ctx ctx
+      else
+        (** The first obligation declares the univs of the constant,
+            each subsequent obligation declares its own additional
+            universes and constraints if any *)
+        UState.make (Global.universes ())
+    in
+    let prg = { prg with prg_ctx } in
+    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 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
@@ -889,7 +908,8 @@ in
       let ctx' = Evd.merge_universe_subst evd (Evd.universe_subst (Evd.from_ctx ctx')) in
       Univ.Instance.empty, Evd.evar_universe_context ctx'
     else
-      let (_, uctx) = UState.universe_context ctx' in
+      (* We get the right order somehow, but surely it could be enforced in a clearer way. *)
+      let uctx = UState.context ctx' in
       Univ.UContext.instance uctx, ctx'
   in
   let obl = { obl with obl_body = Some (DefinedObl (cst, inst)) } in
@@ -965,13 +985,16 @@ and solve_obligation_by_tac prg obls i tac =
 	    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)
-	    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
-	      obls.(i) <- obl';
+              solve_by_tac obl.obl_name (evar_of_obligation obl) tac
+                (pi2 prg.prg_kind) (Evd.evar_universe_context evd)
+            in
+            let uctx = if pi2 prg.prg_kind
+              then Polymorphic_const_entry (UState.context ctx)
+              else Monomorphic_const_entry (UState.context_set ctx)
+            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 (
 	        (* Declare the term constraints with the first obligation only *)
 	        let evd = Evd.from_env (Global.env ()) in
@@ -1068,11 +1091,12 @@ let show_term n =
 	     Printer.pr_constr_env (Global.env ()) Evd.empty prg.prg_type ++ spc () ++ str ":=" ++ fnl ()
 	    ++ Printer.pr_constr_env (Global.env ()) Evd.empty prg.prg_body)
 
-let add_definition n ?term t ctx ?pl ?(implicits=[]) ?(kind=Global,false,Definition) ?tactic
+let add_definition n ?term t ctx ?(univdecl=Univdecls.default_univ_decl)
+                   ?(implicits=[]) ?(kind=Global,false,Definition) ?tactic
     ?(reduce=reduce) ?(hook=Lemmas.mk_hook (fun _ _ _ -> ())) ?(opaque = false) obls =
   let sign = Decls.initialize_named_context_for_proof () in
   let info = Id.print n ++ str " has type-checked" in
-  let prg = init_prog_info sign ~opaque n pl term t ctx [] None [] obls implicits kind reduce hook in
+  let prg = init_prog_info sign ~opaque n univdecl term t ctx [] None [] obls implicits kind reduce hook in
   let obls,_ = prg.prg_obligations in
   if Int.equal (Array.length obls) 0 then (
     Flags.if_verbose Feedback.msg_info (info ++ str ".");
@@ -1087,13 +1111,14 @@ let add_definition n ?term t ctx ?pl ?(implicits=[]) ?(kind=Global,false,Definit
 	| Remain rem -> Flags.if_verbose (fun () -> show_obligations ~msg:false (Some n)) (); res
 	| _ -> res)
 
-let add_mutual_definitions l ctx ?pl ?tactic ?(kind=Global,false,Definition) ?(reduce=reduce)
+let add_mutual_definitions l ctx ?(univdecl=Univdecls.default_univ_decl) ?tactic
+                           ?(kind=Global,false,Definition) ?(reduce=reduce)
     ?(hook=Lemmas.mk_hook (fun _ _ _ -> ())) ?(opaque = false) notations fixkind =
   let sign = Decls.initialize_named_context_for_proof () in
   let deps = List.map (fun (n, b, t, imps, obls) -> n) l in
     List.iter
     (fun  (n, b, t, imps, obls) ->
-     let prg = init_prog_info sign ~opaque n pl (Some b) t ctx deps (Some fixkind)
+     let prg = init_prog_info sign ~opaque n univdecl (Some b) t ctx deps (Some fixkind)
        notations obls imps kind reduce hook 
      in progmap_add n (CEphemeron.create prg)) l;
     let _defined =
@@ -1117,9 +1142,9 @@ let admit_prog prg =
         match x.obl_body with
         | None ->
             let x = subst_deps_obl obls x in
-	    let ctx = Evd.evar_context_universe_context prg.prg_ctx in
+            let ctx = Monomorphic_const_entry (UState.context_set prg.prg_ctx) in
             let kn = Declare.declare_constant x.obl_name ~local:true
-              (ParameterEntry (None,false,(x.obl_type,ctx),None), IsAssumption Conjectural)
+              (ParameterEntry (None,(x.obl_type,ctx),None), IsAssumption Conjectural)
             in
               assumption_message x.obl_name;
               obls.(i) <- { x with obl_body = Some (DefinedObl (kn, Univ.Instance.empty)) }
@@ -1160,7 +1185,6 @@ let init_program () =
   Coqlib.check_required_library ["Coq";"Init";"Specif"];
   Coqlib.check_required_library ["Coq";"Program";"Tactics"]
 
-
 let set_program_mode c =
   if c then
     if !Flags.program_mode then ()
diff --git a/vernac/obligations.mli b/vernac/obligations.mli
index 5614403ba..0ec127152 100644
--- a/vernac/obligations.mli
+++ b/vernac/obligations.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Environ
-open Term
+open Constr
 open Evd
 open Names
 open Globnames
@@ -32,14 +32,14 @@ val eterm_obligations : env -> Id.t -> evar_map -> int ->
     (* Existential key, obl. name, type as product, 
        location of the original evar, associated tactic,
        status and dependencies as indexes into the array *)
-  * ((existential_key * Id.t) list * ((Id.t -> constr) -> constr -> constr)) *
+  * ((Evar.t * Id.t) list * ((Id.t -> constr) -> constr -> constr)) *
     constr * types
     (* Translations from existential identifiers to obligation identifiers 
        and for terms with existentials to closed terms, given a 
        translation from obligation identifiers to constrs, new term, new type *)
 
 type obligation_info =
-  (Id.t * Term.types * Evar_kinds.t Loc.located *
+  (Id.t * types * Evar_kinds.t Loc.located *
       (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 *)
@@ -51,31 +51,31 @@ type progress = (* Resolution status of a program *)
 
 val default_tactic : unit Proofview.tactic ref
 
-val add_definition : Names.Id.t -> ?term:Term.constr -> Term.types -> 
-  Evd.evar_universe_context ->
-  ?pl:(Id.t Loc.located list) -> (* Universe binders *)
+val add_definition : Names.Id.t -> ?term:constr -> types -> 
+  UState.t ->
+  ?univdecl:Univdecls.universe_decl -> (* Universe binders and constraints *)
   ?implicits:(Constrexpr.explicitation * (bool * bool * bool)) list ->
   ?kind:Decl_kinds.definition_kind ->
   ?tactic:unit Proofview.tactic ->
-  ?reduce:(Term.constr -> Term.constr) ->
-  ?hook:(Evd.evar_universe_context -> unit) Lemmas.declaration_hook -> ?opaque:bool -> obligation_info -> progress
+  ?reduce:(constr -> constr) ->
+  ?hook:(UState.t -> unit) Lemmas.declaration_hook -> ?opaque:bool -> obligation_info -> progress
 
 type notations =
-    (Vernacexpr.lstring * Constrexpr.constr_expr * Notation_term.scope_name option) list
+    (Misctypes.lstring * Constrexpr.constr_expr * Notation_term.scope_name option) list
 
 type fixpoint_kind =
-  | IsFixpoint of (Id.t Loc.located option * Constrexpr.recursion_order_expr) list
+  | IsFixpoint of (Misctypes.lident option * Constrexpr.recursion_order_expr) list
   | IsCoFixpoint
 
 val add_mutual_definitions :
-  (Names.Id.t * Term.constr * Term.types *
+  (Names.Id.t * constr * types *
       (Constrexpr.explicitation * (bool * bool * bool)) list * obligation_info) list ->
-  Evd.evar_universe_context ->
-  ?pl:(Id.t Loc.located list) -> (* Universe binders *)
+  UState.t ->
+  ?univdecl:Univdecls.universe_decl -> (* Universe binders and constraints *)
   ?tactic:unit Proofview.tactic ->
   ?kind:Decl_kinds.definition_kind ->
-  ?reduce:(Term.constr -> Term.constr) ->
-  ?hook:(Evd.evar_universe_context -> unit) Lemmas.declaration_hook -> ?opaque:bool ->
+  ?reduce:(constr -> constr) ->
+  ?hook:(UState.t -> unit) Lemmas.declaration_hook -> ?opaque:bool ->
   notations ->
   fixpoint_kind -> unit
 
@@ -104,3 +104,6 @@ exception NoObligations of Names.Id.t option
 val explain_no_obligations : Names.Id.t option -> Pp.t
 
 val set_program_mode : bool -> unit
+
+type program_info
+val program_tcc_summary_tag : program_info Id.Map.t Summary.Dyn.tag
diff --git a/proofs/proof_using.ml b/vernac/proof_using.ml
index 1a321120c..8422baf57 100644
--- a/proofs/proof_using.ml
+++ b/vernac/proof_using.ml
@@ -14,16 +14,6 @@ open Context.Named.Declaration
 
 module NamedDecl = Context.Named.Declaration
 
-let to_string e =
-  let rec aux = function
-    | SsEmpty -> "()"
-    | SsSingl (_,id) -> "("^Id.to_string id^")"
-    | SsCompl e -> "-" ^ aux e^""
-    | SsUnion(e1,e2) -> "("^aux e1 ^" + "^ aux e2^")"
-    | SsSubstr(e1,e2) -> "("^aux e1 ^" - "^ aux e2^")"
-    | SsFwdClose e -> "("^aux e^")*"
-  in aux e
-
 let known_names = Summary.ref [] ~name:"proofusing-nameset"
 
 let in_nameset =
@@ -48,12 +38,20 @@ let rec close_fwd e s =
     s (named_context e)
     in
   if Id.Set.equal s s' then s else close_fwd e s'
-;;
+
+let set_of_type env ty =
+  List.fold_left (fun acc ty ->
+      Id.Set.union (global_vars_set env ty) acc)
+    Id.Set.empty ty
+
+let full_set env =
+  List.fold_right Id.Set.add (List.map NamedDecl.get_id (named_context env)) Id.Set.empty
 
 let rec process_expr env e ty =
   let rec aux = function
     | SsEmpty -> Id.Set.empty
-    | SsSingl (_,id) -> set_of_id env ty id
+    | SsType -> set_of_type env ty
+    | SsSingl { CAst.v = id } -> set_of_id env id
     | SsUnion(e1,e2) -> Id.Set.union (aux e1) (aux e2)
     | SsSubstr(e1,e2) -> Id.Set.diff (aux e1) (aux e2)
     | SsCompl e -> Id.Set.diff (full_set env) (aux e)
@@ -61,23 +59,15 @@ let rec process_expr env e ty =
   in
     aux e
 
-and set_of_id env ty id =
-  if Id.to_string id = "Type" then
-    List.fold_left (fun acc ty ->
-        Id.Set.union (global_vars_set env ty) acc)
-      Id.Set.empty ty
-  else if Id.to_string id = "All" then
+and set_of_id env id =
+  if Id.to_string id = "All" then
     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 NamedDecl.get_id (named_context env)) Id.Set.empty
-
 let process_expr env e ty =
-  let ty_expr = SsSingl(Loc.tag @@ Id.of_string "Type") in
-  let v_ty = process_expr env ty_expr ty in
+  let v_ty = set_of_type env ty in
   let s = Id.Set.union v_ty (process_expr env e ty) in
   Id.Set.elements s
 
@@ -105,7 +95,13 @@ let remove_ids_and_lets env s ids =
      (no_body id ||
        Id.Set.exists not_ids (Id.Set.filter no_body (deps id)))) s)
 
-let suggest_Proof_using name env vars ids_typ context_ids =
+let record_proof_using expr =
+  Aux_file.record_in_aux "suggest_proof_using" expr
+
+(* Variables in [skip] come from after the definition, so don't count
+   for "All". Used in the variable case since the env contains the
+   variable itself. *)
+let suggest_common env ppid used ids_typ skip =
   let module S = Id.Set in
   let open Pp in
   let print x = Feedback.msg_debug x in
@@ -114,10 +110,13 @@ let suggest_Proof_using name env vars ids_typ context_ids =
       if parens && S.cardinal s > 1 then str "(" ++ ppcmds ++ str ")"
       else ppcmds in
     wrap (prlist_with_sep (fun _ -> str" ") Id.print (S.elements s)) in
-  let used = S.union vars ids_typ in
+
   let needed = minimize_hyps env (remove_ids_and_lets env used ids_typ) in
   let all_needed = really_needed env needed in
-  let all = List.fold_right S.add context_ids S.empty in
+  let all = List.fold_left (fun all d -> S.add (NamedDecl.get_id d) all)
+      S.empty (named_context env)
+  in
+  let all = S.diff all skip in
   let fwd_typ = close_fwd env ids_typ in
   if !Flags.debug then begin
     print (str "All "        ++ pr_set false all);
@@ -133,36 +132,59 @@ let suggest_Proof_using name env vars ids_typ context_ids =
   if S.equal all all_needed then valid(str "All");
   valid (pr_set false needed);
   Feedback.msg_info (
-    str"The proof of "++ str name ++ spc() ++
+    str"The proof of "++ ppid ++ spc() ++
     str "should start with one of the following commands:"++spc()++
     v 0 (
     prlist_with_sep cut (fun x->str"Proof using " ++x++ str". ") !valid_exprs));
-  string_of_ppcmds (prlist_with_sep (fun _ -> str";")  (fun x->x) !valid_exprs)
-;;
+  if !Flags.record_aux_file
+  then
+    let s = string_of_ppcmds (prlist_with_sep (fun _ -> str";")  (fun x->x) !valid_exprs) in
+    record_proof_using s
 
-let value = ref false
+let suggest_proof_using = ref false
 
 let _ =
   Goptions.declare_bool_option
     { Goptions.optdepr  = false;
       Goptions.optname  = "suggest Proof using";
       Goptions.optkey   = ["Suggest";"Proof";"Using"];
-      Goptions.optread  = (fun () -> !value);
-      Goptions.optwrite = (fun b ->
-        value := b;
-        if b then Term_typing.set_suggest_proof_using suggest_Proof_using
-        else Term_typing.set_suggest_proof_using (fun _ _ _ _ _ -> "")
-      ) }
+      Goptions.optread  = (fun () -> !suggest_proof_using);
+      Goptions.optwrite = ((:=) suggest_proof_using) }
+
+let suggest_constant env kn =
+  if !suggest_proof_using
+  then begin
+    let open Declarations in
+    let body = lookup_constant kn env in
+    let used = Id.Set.of_list @@ List.map NamedDecl.get_id body.const_hyps in
+    let ids_typ = global_vars_set env body.const_type in
+    suggest_common env (Printer.pr_constant env kn) used ids_typ Id.Set.empty
+  end
+
+let suggest_variable env id =
+  if !suggest_proof_using
+  then begin
+    match lookup_named id env with
+    | LocalDef (_,body,typ) ->
+      let ids_typ = global_vars_set env typ in
+      let ids_body = global_vars_set env body in
+      let used = Id.Set.union ids_body ids_typ in
+      suggest_common env (Id.print id) used ids_typ (Id.Set.singleton id)
+    | LocalAssum _ -> assert false
+  end
 
 let value = ref None
 
+let using_to_string us = Pp.string_of_ppcmds (Ppvernac.pr_using us)
+let using_from_string us = Pcoq.Gram.(entry_parse G_vernac.section_subset_expr (parsable (Stream.of_string us)))
+
 let _ =
   Goptions.declare_stringopt_option
     { Goptions.optdepr  = false;
       Goptions.optname  = "default value for Proof using";
       Goptions.optkey   = ["Default";"Proof";"Using"];
-      Goptions.optread  = (fun () -> !value);
-      Goptions.optwrite = (fun b -> value := b;) }
-
+      Goptions.optread  = (fun () -> Option.map using_to_string !value);
+      Goptions.optwrite = (fun b -> value := Option.map using_from_string b);
+    }
 
 let get_default_proof_using () = !value
diff --git a/proofs/proof_using.mli b/vernac/proof_using.mli
index c882b1827..f63c8e242 100644
--- a/proofs/proof_using.mli
+++ b/vernac/proof_using.mli
@@ -14,6 +14,8 @@ val process_expr :
 
 val name_set : Names.Id.t -> Vernacexpr.section_subset_expr -> unit
 
-val to_string : Vernacexpr.section_subset_expr -> string
+val suggest_constant : Environ.env -> Names.Constant.t -> unit
 
-val get_default_proof_using : unit -> string option
+val suggest_variable : Environ.env -> Names.Id.t -> unit
+
+val get_default_proof_using : unit -> Vernacexpr.section_subset_expr option
diff --git a/vernac/record.ml b/vernac/record.ml
index a2e443e5f..1140e3d37 100644
--- a/vernac/record.ml
+++ b/vernac/record.ml
@@ -8,11 +8,13 @@
 
 open Pp
 open CErrors
+open Term
+open Sorts
 open Util
 open Names
 open Globnames
 open Nameops
-open Term
+open Constr
 open Vars
 open Environ
 open Declarations
@@ -58,23 +60,25 @@ let _ =
       optread  = (fun () -> !typeclasses_unique);
       optwrite = (fun b -> typeclasses_unique := b); }
 
-let interp_fields_evars env evars impls_env nots l =
+let interp_fields_evars env sigma impls_env nots l =
   List.fold_left2
-    (fun (env, uimpls, params, impls) no ((loc, i), b, t) ->
-      let t', impl = interp_type_evars_impls env evars ~impls t in
-      let b' = Option.map (fun x -> fst (interp_casted_constr_evars_impls env evars ~impls x t')) b in
+    (fun (env, sigma, uimpls, params, impls) no ({CAst.loc;v=i}, b, t) ->
+      let sigma, (t', impl) = interp_type_evars_impls env sigma ~impls t in
+      let sigma, b' =
+        Option.cata (fun x -> on_snd (fun x -> Some (fst x)) @@
+                      interp_casted_constr_evars_impls env sigma ~impls x t') (sigma,None) b in
       let impls =
 	match i with
 	| Anonymous -> impls
-	| Name id -> Id.Map.add id (compute_internalization_data env Constrintern.Method (EConstr.to_constr !evars t') impl) impls
+        | Name id -> Id.Map.add id (compute_internalization_data env Constrintern.Method (EConstr.to_constr sigma t') impl) impls
       in
       let d = match b' with
 	      | None -> LocalAssum (i,t')
 	      | Some b' -> LocalDef (i,b',t')
       in
-      List.iter (Metasyntax.set_notation_for_interpretation impls) no;
-      (EConstr.push_rel d env, impl :: uimpls, d::params, impls))
-    (env, [], [], impls_env) nots l
+      List.iter (Metasyntax.set_notation_for_interpretation env impls) no;
+      (EConstr.push_rel d env, sigma, impl :: uimpls, d::params, impls))
+    (env, sigma, [], [], impls_env) nots l
 
 let compute_constructor_level evars env l =
   List.fold_right (fun d (env, univ) ->
@@ -88,17 +92,17 @@ let compute_constructor_level evars env l =
 
 let binder_of_decl = function
   | Vernacexpr.AssumExpr(n,t) -> (n,None,t)
-  | Vernacexpr.DefExpr(n,c,t) -> (n,Some c, match t with Some c -> c
-                                                       | None   -> CAst.make ?loc:(fst n) @@ CHole (None, Misctypes.IntroAnonymous, None))
+  | Vernacexpr.DefExpr(n,c,t) ->
+    (n,Some c, match t with Some c -> c
+                          | None   -> CAst.make ?loc:n.CAst.loc @@ CHole (None, Misctypes.IntroAnonymous, None))
 
 let binders_of_decls = List.map binder_of_decl
 
-let typecheck_params_and_fields finite def id pl t ps nots fs =
+let typecheck_params_and_fields finite def id poly pl t ps nots fs =
   let env0 = Global.env () in
-  let ctx = Evd.make_evar_universe_context env0 pl in
-  let evars = ref (Evd.from_ctx ctx) in
-  let _ = 
-    let error bk (loc, name) = 
+  let sigma, decl = Univdecls.interp_univ_decl_opt env0 pl in
+  let _ =
+    let error bk {CAst.loc; v=name} =
       match bk, name with
       | Default _, Anonymous ->
         user_err ?loc ~hdr:"record" (str "Record parameters must be named")
@@ -107,67 +111,71 @@ let typecheck_params_and_fields finite def id pl t ps nots fs =
       List.iter 
 	(function CLocalDef (b, _, _) -> error default_binder_kind b
 	   | CLocalAssum (ls, bk, ce) -> List.iter (error bk) ls
-           | CLocalPattern (loc,(_,_)) ->
+           | CLocalPattern {CAst.loc} ->
               Loc.raise ?loc (Stream.Error "pattern with quote not allowed in record parameters.")) ps
   in 
-  let impls_env, ((env1,newps), imps) = interp_context_evars env0 evars ps in
-  let typ, sort, template = match t with
+  let sigma, (impls_env, ((env1,newps), imps)) = interp_context_evars env0 sigma ps in
+  let sigma, typ, sort, template = match t with
     | Some t -> 
        let env = EConstr.push_rel_context newps env0 in
        let poly =
          match t with
          | { CAst.v = CSort (Misctypes.GType []) } -> true | _ -> false in
-       let s = interp_type_evars env evars ~impls:empty_internalization_env t in
-       let sred = Reductionops.whd_all env !evars s in
-	 (match EConstr.kind !evars sred with
+       let sigma, s = interp_type_evars env sigma ~impls:empty_internalization_env t in
+       let sred = Reductionops.whd_all env sigma s in
+         (match EConstr.kind sigma sred with
 	 | Sort s' ->
-            let s' = EConstr.ESorts.kind !evars s' in
+            let s' = EConstr.ESorts.kind sigma s' in
 	    (if poly then
-               match Evd.is_sort_variable !evars s' with
-	       | Some l -> evars := Evd.make_flexible_variable !evars ~algebraic:true l; 
-	                  s, s', true
-	       | None -> s, s', false
-             else s, s', false)
+               match Evd.is_sort_variable sigma s' with
+               | Some l ->
+                 let sigma = Evd.make_flexible_variable sigma ~algebraic:true l in
+                 sigma, s, s', true
+               | None ->
+                 sigma, s, s', false
+             else sigma, s, s', false)
 	 | _ -> user_err ?loc:(constr_loc t) (str"Sort expected."))
     | None -> 
       let uvarkind = Evd.univ_flexible_alg in
-      let s = Evarutil.evd_comb0 (Evd.new_sort_variable uvarkind) evars in
-      EConstr.mkSort s, s, true
+      let sigma, s = Evd.new_sort_variable uvarkind sigma in
+      sigma, EConstr.mkSort s, s, true
   in
   let arity = EConstr.it_mkProd_or_LetIn typ newps in
   let env_ar = EConstr.push_rel_context newps (EConstr.push_rel (LocalAssum (Name id,arity)) env0) in
   let assums = List.filter is_local_assum newps in
-  let params = List.map (RelDecl.get_name %> out_name) assums in
-  let ty = Inductive (params,(finite != BiFinite)) in
-  let impls_env = compute_internalization_env env0 ~impls:impls_env ty [id] [EConstr.to_constr !evars arity] [imps] in
-  let env2,impls,newfs,data =
-    interp_fields_evars env_ar evars impls_env nots (binders_of_decls fs)
+  let params = List.map (RelDecl.get_name %> Name.get_id) assums in
+  let ty = Inductive (params,(finite != Declarations.BiFinite)) in
+  let impls_env = compute_internalization_env env0 ~impls:impls_env ty [id] [EConstr.to_constr sigma arity] [imps] in
+  let env2,sigma,impls,newfs,data =
+    interp_fields_evars env_ar sigma impls_env nots (binders_of_decls fs)
   in
-  let evars =
-    Pretyping.solve_remaining_evars Pretyping.all_and_fail_flags env_ar !evars Evd.empty in
-  let typ, evars =
-    let _, univ = compute_constructor_level evars env_ar newfs in
+  let sigma =
+    Pretyping.solve_remaining_evars Pretyping.all_and_fail_flags env_ar sigma Evd.empty in
+  let sigma, typ =
+    let _, univ = compute_constructor_level sigma env_ar newfs in
       if not def && (Sorts.is_prop sort ||
 	(Sorts.is_set sort && is_impredicative_set env0)) then
-	typ, evars
+        sigma, typ
       else
-	let evars = Evd.set_leq_sort env_ar evars (Type univ) sort in
+        let sigma = Evd.set_leq_sort env_ar sigma (Type univ) sort in
 	if Univ.is_small_univ univ &&
-	   Option.cata (Evd.is_flexible_level evars) false (Evd.is_sort_variable evars sort) then
+           Option.cata (Evd.is_flexible_level sigma) false (Evd.is_sort_variable sigma sort) then
 	   (* We can assume that the level in aritysort is not constrained
 	       and clear it, if it is flexible *)
-	  EConstr.mkSort (Sorts.sort_of_univ univ),
-	  Evd.set_eq_sort env_ar evars (Prop Pos) sort
-	else typ, evars
+          Evd.set_eq_sort env_ar sigma (Prop Pos) sort,
+          EConstr.mkSort (Sorts.sort_of_univ univ)
+        else sigma, typ
   in
-  let evars, nf = Evarutil.nf_evars_and_universes evars in
-  let newfs = List.map (EConstr.to_rel_decl evars) newfs in
-  let newps = List.map (EConstr.to_rel_decl evars) newps in
-  let typ = EConstr.to_constr evars typ in
-  let ce t = Pretyping.check_evars env0 Evd.empty evars (EConstr.of_constr t) in
+  let sigma, _ = Evarutil.nf_evars_and_universes sigma in
+  let newfs = List.map (EConstr.to_rel_decl sigma) newfs in
+  let newps = List.map (EConstr.to_rel_decl sigma) newps in
+  let typ = EConstr.to_constr sigma typ in
+  let ce t = Pretyping.check_evars env0 Evd.empty sigma (EConstr.of_constr t) in
+  let univs = Evd.check_univ_decl ~poly sigma decl in
+  let ubinders = Evd.universe_binders sigma in
     List.iter (iter_constr ce) (List.rev newps);
     List.iter (iter_constr ce) (List.rev newfs);
-    Evd.universe_context ?names:pl evars, typ, template, imps, newps, impls, newfs
+    ubinders, univs, typ, template, imps, newps, impls, newfs
 
 let degenerate_decl decl =
   let id = match RelDecl.get_name decl with
@@ -192,24 +200,24 @@ let warning_or_error coe indsp err =
   let st = match err with
     | MissingProj (fi,projs) ->
 	let s,have = if List.length projs > 1 then "s","were" else "","was" in
-        (pr_id fi ++
+        (Id.print fi ++
 	   strbrk" cannot be defined because the projection" ++ str s ++ spc () ++
-           prlist_with_sep pr_comma pr_id projs ++ spc () ++ str have ++
+           prlist_with_sep pr_comma Id.print projs ++ spc () ++ str have ++
 	   strbrk " not defined.")
     | BadTypedProj (fi,ctx,te) ->
 	match te with
 	  | ElimArity (_,_,_,_,Some (_,_,NonInformativeToInformative)) ->
-              (pr_id fi ++
+              (Id.print fi ++
 		strbrk" cannot be defined because it is informative and " ++
 		Printer.pr_inductive (Global.env()) indsp ++
 		strbrk " is not.")
 	  | ElimArity (_,_,_,_,Some (_,_,StrongEliminationOnNonSmallType)) ->
-	      (pr_id fi ++
+	      (Id.print fi ++
 		strbrk" cannot be defined because it is large and " ++
 		Printer.pr_inductive (Global.env()) indsp ++
 		strbrk " is not.")
 	  | _ ->
-              (pr_id fi ++ strbrk " cannot be defined because it is not typable.")
+              (Id.print fi ++ strbrk " cannot be defined because it is not typable.")
   in
   if coe then user_err ~hdr:"structure" st;
   warn_cannot_define_projection (hov 0 st)
@@ -228,7 +236,7 @@ exception NotDefinable of record_error
 let subst_projection fid l c =
   let lv = List.length l in
   let bad_projs = ref [] in
-  let rec substrec depth c = match kind_of_term c with
+  let rec substrec depth c = match Constr.kind c with
     | Rel k ->
 	(* We are in context [[params;fields;x:ind;...depth...]] *)
         if k <= depth+1 then
@@ -238,12 +246,12 @@ let subst_projection fid l c =
 	    | Projection t -> lift depth t
 	    | NoProjection (Name id) -> bad_projs := id :: !bad_projs; mkRel k
 	    | NoProjection Anonymous ->
-                user_err  (str "Field " ++ pr_id fid ++
+                user_err  (str "Field " ++ Id.print fid ++
                   str " depends on the " ++ pr_nth (k-depth-1) ++ str
                   " field which has no name.")
         else
 	  mkRel (k-lv)
-    | _ -> map_constr_with_binders succ substrec depth c
+    | _ -> Constr.map_with_binders succ substrec depth c
   in
   let c' = lift 1 c in (* to get [c] defined in ctxt [[params;fields;x:ind]] *)
   let c'' = substrec 0 c' in
@@ -262,12 +270,14 @@ let warn_non_primitive_record =
                     strbrk" could not be defined as a primitive record")))
 
 (* We build projections *)
-let declare_projections indsp ?(kind=StructureComponent) binder_name coers fieldimpls fields =
+let declare_projections indsp ctx ?(kind=StructureComponent) binder_name coers ubinders fieldimpls fields =
   let env = Global.env() in
   let (mib,mip) = Global.lookup_inductive indsp in
   let poly = Declareops.inductive_is_polymorphic mib in
-  let ctx = Univ.AUContext.repr (Declareops.inductive_polymorphic_context mib) in
-  let u = Univ.UContext.instance ctx in
+  let u = match ctx with
+    | Polymorphic_const_entry ctx -> Univ.UContext.instance ctx
+    | Monomorphic_const_entry ctx -> Univ.Instance.empty
+  in
   let paramdecls = Inductive.inductive_paramdecls (mib, u) in
   let indu = indsp, u in
   let r = mkIndU (indsp,u) in
@@ -301,9 +311,11 @@ let declare_projections indsp ?(kind=StructureComponent) binder_name coers field
 	    let kn, term = 
 	      if is_local_assum decl && primitive then
 		(** Already defined in the kernel silently *)
-		let kn = destConstRef (Nametab.locate (Libnames.qualid_of_ident fid)) in
-		  Declare.definition_message fid;
-		  kn, mkProj (Projection.make kn false,mkRel 1)
+                let gr = Nametab.locate (Libnames.qualid_of_ident fid) in
+                let kn = destConstRef gr in
+                Declare.definition_message fid;
+                Universes.register_universe_binders gr ubinders;
+                kn, mkProj (Projection.make kn false,mkRel 1)
 	      else
 		let ccl = subst_projection fid subst ti in
 		let body = match decl with
@@ -322,16 +334,12 @@ let declare_projections indsp ?(kind=StructureComponent) binder_name coers field
 		let projtyp =
                   it_mkProd_or_LetIn (mkProd (x,rp,ccl)) paramdecls in
 	        try
-                  let univs =
-                    if poly then Polymorphic_const_entry ctx
-                    else Monomorphic_const_entry ctx
-                  in
 		  let entry = {
 		    const_entry_body =
 		      Future.from_val (Safe_typing.mk_pure_proof proj);
 		    const_entry_secctx = None;
 		    const_entry_type = Some projtyp;
-		    const_entry_universes = univs;
+                    const_entry_universes = ctx;
 		    const_entry_opaque = false;
 		    const_entry_inline_code = false;
 		    const_entry_feedback = None } in
@@ -340,8 +348,9 @@ let declare_projections indsp ?(kind=StructureComponent) binder_name coers field
 		  let constr_fip =
 		    let proj_args = (*Rel 1 refers to "x"*) paramargs@[mkRel 1] in
 		      applist (mkConstU (kn,u),proj_args) 
-		  in
-		    Declare.definition_message fid;
+                  in
+                  Declare.definition_message fid;
+                  Universes.register_universe_binders (ConstRef kn) ubinders;
 		    kn, constr_fip
                 with Type_errors.TypeError (ctx,te) ->
                   raise (NotDefinable (BadTypedProj (fid,ctx,te))) 
@@ -361,35 +370,22 @@ let declare_projections indsp ?(kind=StructureComponent) binder_name coers field
       (List.length fields,0,[],[],[]) coers (List.rev fields) (List.rev fieldimpls)
   in (kinds,sp_projs)
 
-let structure_signature ctx =
-  let rec deps_to_evar evm l =
-    match l with [] -> Evd.empty
-      | [decl] ->
-        let env = Environ.empty_named_context_val in
-        let (evm, _) = Evarutil.new_pure_evar env evm (EConstr.of_constr (RelDecl.get_type decl)) in
-        evm
-      | decl::tl ->
-          let env = Environ.empty_named_context_val in
-          let (evm, ev) = Evarutil.new_pure_evar env evm (EConstr.of_constr (RelDecl.get_type decl)) in
-	  let new_tl = Util.List.map_i
-	    (fun pos decl ->
-	       RelDecl.map_type (fun t -> EConstr.Unsafe.to_constr (Termops.replace_term evm (EConstr.mkRel pos) (EConstr.mkEvar(ev,[||])) (EConstr.of_constr t))) decl) 1 tl in
-	  deps_to_evar evm new_tl in
-  deps_to_evar Evd.empty (List.rev ctx)
-
 open Typeclasses
 
-let declare_structure finite univs id idbuild paramimpls params arity template 
-    fieldimpls fields ?(kind=StructureComponent) ?name is_coe coers sign =
+let declare_structure finite ubinders univs id idbuild paramimpls params arity template
+    fieldimpls fields ?(kind=StructureComponent) ?name is_coe coers =
   let nparams = List.length params and nfields = List.length fields in
   let args = Context.Rel.to_extended_list mkRel nfields params in
   let ind = applist (mkRel (1+nparams+nfields), args) in
   let type_constructor = it_mkProd_or_LetIn ind fields in
-  let poly, ctx =
+  let template, ctx =
     match univs with
-    | Monomorphic_ind_entry ctx -> false, ctx
-    | Polymorphic_ind_entry ctx -> true, ctx
-    | Cumulative_ind_entry cumi -> true, (Univ.CumulativityInfo.univ_context cumi)
+    | Monomorphic_ind_entry ctx ->
+      template, Monomorphic_const_entry Univ.ContextSet.empty
+    | Polymorphic_ind_entry ctx ->
+      false, Polymorphic_const_entry ctx
+    | Cumulative_ind_entry cumi ->
+      false, Polymorphic_const_entry (Univ.CumulativityInfo.univ_context cumi)
   in
   let binder_name = 
     match name with
@@ -399,7 +395,7 @@ let declare_structure finite univs id idbuild paramimpls params arity template
   let mie_ind =
     { mind_entry_typename = id;
       mind_entry_arity = arity;
-      mind_entry_template = not poly && template;
+      mind_entry_template = template;
       mind_entry_consnames = [idbuild];
       mind_entry_lc = [type_constructor] }
   in
@@ -412,29 +408,13 @@ let declare_structure finite univs id idbuild paramimpls params arity template
       mind_entry_universes = univs;
     }
   in
-  let mie =
-    if poly then
-      begin
-        let env = Global.env () in
-        let env' = Environ.push_context ctx env in
-        (* let env'' = Environ.push_rel_context params env' in *)
-        let evd = Evd.from_env env' in
-        Inductiveops.infer_inductive_subtyping env' evd mie
-      end
-    else
-       mie
-  in
-  let kn = Command.declare_mutual_inductive_with_eliminations mie [] [(paramimpls,[])] in
+  let mie = InferCumulativity.infer_inductive (Global.env ()) mie in
+  let kn = ComInductive.declare_mutual_inductive_with_eliminations mie ubinders [(paramimpls,[])] in
   let rsp = (kn,0) in (* This is ind path of idstruc *)
   let cstr = (rsp,1) in
-  let fields =
-    if poly then
-      let subst, _ = Univ.abstract_universes ctx in
-      Context.Rel.map (fun c -> Vars.subst_univs_level_constr subst c) fields
-    else fields
-  in
-  let kinds,sp_projs = declare_projections rsp ~kind binder_name coers fieldimpls fields in
+  let kinds,sp_projs = declare_projections rsp ctx ~kind binder_name coers ubinders fieldimpls fields in
   let build = ConstructRef cstr in
+  let poly = match ctx with | Polymorphic_const_entry _ -> true | Monomorphic_const_entry _ -> false in
   let () = if is_coe then Class.try_add_new_coercion build ~local:false poly in
   Recordops.declare_structure(rsp,cstr,List.rev kinds,List.rev sp_projs);
   rsp
@@ -448,42 +428,44 @@ let implicits_of_context ctx =
     in ExplByPos (i, explname), (true, true, true))
     1 (List.rev (Anonymous :: (List.map RelDecl.get_name ctx)))
 
-let declare_class finite def cum poly ctx id idbuild paramimpls params arity 
-    template fieldimpls fields ?(kind=StructureComponent) is_coe coers priorities sign =
+let declare_class finite def cum ubinders univs id idbuild paramimpls params arity
+    template fieldimpls fields ?(kind=StructureComponent) is_coe coers priorities =
   let fieldimpls =
     (* Make the class implicit in the projections, and the params if applicable. *)
     let len = List.length params in
     let impls = implicits_of_context params in
       List.map (fun x -> impls @ Impargs.lift_implicits (succ len) x) fieldimpls
   in
-  let binder_name = Namegen.next_ident_away (snd id) (Termops.ids_of_context (Global.env())) in
+  let binder_name = Namegen.next_ident_away (snd id) (Termops.vars_of_env (Global.env())) in
   let impl, projs =
     match fields with
     | [LocalAssum (Name proj_name, field) | LocalDef (Name proj_name, _, field)] when def ->
       let class_body = it_mkLambda_or_LetIn field params in
       let class_type = it_mkProd_or_LetIn arity params in
       let class_entry = 
-	Declare.definition_entry ~types:class_type ~poly ~univs:ctx class_body in
+        Declare.definition_entry ~types:class_type ~univs class_body in
       let cst = Declare.declare_constant (snd id)
 	(DefinitionEntry class_entry, IsDefinition Definition)
       in
-      let cstu = (cst, if poly then Univ.UContext.instance ctx else Univ.Instance.empty) in
+      let cstu = (cst, match univs with
+        | Polymorphic_const_entry univs -> Univ.UContext.instance univs
+        | Monomorphic_const_entry _ -> Univ.Instance.empty)
+      in
       let inst_type = appvectc (mkConstU cstu)
 			       (Termops.rel_vect 0 (List.length params)) in
       let proj_type =
 	it_mkProd_or_LetIn (mkProd(Name binder_name, inst_type, lift 1 field)) params in
       let proj_body =
 	it_mkLambda_or_LetIn (mkLambda (Name binder_name, inst_type, mkRel 1)) params in
-      let proj_entry =
-	Declare.definition_entry ~types:proj_type ~poly
-	    ~univs:(if poly then ctx else Univ.UContext.empty) proj_body
-      in
+      let proj_entry = Declare.definition_entry ~types:proj_type ~univs proj_body in
       let proj_cst = Declare.declare_constant proj_name
         (DefinitionEntry proj_entry, IsDefinition Definition)
       in
       let cref = ConstRef cst in
       Impargs.declare_manual_implicits false cref [paramimpls];
+      Universes.register_universe_binders cref ubinders;
       Impargs.declare_manual_implicits false (ConstRef proj_cst) [List.hd fieldimpls];
+      Universes.register_universe_binders (ConstRef proj_cst) ubinders;
       Classes.set_typeclass_transparency (EvalConstRef cst) false false;
       let sub = match List.hd coers with
 	| Some b -> Some ((if b then Backward else Forward), List.hd priorities) 
@@ -492,17 +474,18 @@ let declare_class finite def cum poly ctx id idbuild paramimpls params arity
       cref, [Name proj_name, sub, Some proj_cst]
     | _ ->
        let univs =
-         if poly then
+         match univs with
+         | Polymorphic_const_entry univs ->
            if cum then
-             Cumulative_ind_entry (Universes.univ_inf_ind_from_universe_context ctx)
+             Cumulative_ind_entry (Univ.CumulativityInfo.from_universe_context univs)
            else
-             Polymorphic_ind_entry ctx
-         else
-           Monomorphic_ind_entry ctx
+             Polymorphic_ind_entry univs
+         | Monomorphic_const_entry univs ->
+           Monomorphic_ind_entry univs
        in
-       let ind = declare_structure BiFinite univs (snd id) idbuild paramimpls
+       let ind = declare_structure Declarations.BiFinite ubinders univs (snd id) idbuild paramimpls
 	  params arity template fieldimpls fields
-	  ~kind:Method ~name:binder_name false (List.map (fun _ -> false) fields) sign
+          ~kind:Method ~name:binder_name false (List.map (fun _ -> false) fields)
        in
        let coers = List.map2 (fun coe pri -> 
 			      Option.map (fun b -> 
@@ -516,18 +499,21 @@ let declare_class finite def cum poly ctx id idbuild paramimpls params arity
   let ctx_context =
     List.map (fun decl ->
       match Typeclasses.class_of_constr Evd.empty (EConstr.of_constr (RelDecl.get_type decl)) with
-      | Some (_, ((cl,_), _)) -> Some (cl.cl_impl, true)
+      | Some (_, ((cl,_), _)) -> Some cl.cl_impl
       | None -> None)
       params, params
   in
   let univs, ctx_context, fields =
-    if poly then
-      let usubst, auctx = Univ.abstract_universes ctx in
+    match univs with
+    | Polymorphic_const_entry univs ->
+      let usubst, auctx = Univ.abstract_universes univs in
+      let usubst = Univ.make_instance_subst usubst in
       let map c = Vars.subst_univs_level_constr usubst c in
       let fields = Context.Rel.map map fields in
       let ctx_context = on_snd (fun d -> Context.Rel.map map d) ctx_context in
       auctx, ctx_context, fields
-    else Univ.AUContext.empty, ctx_context, fields
+    | Monomorphic_const_entry _ ->
+      Univ.AUContext.empty, ctx_context, fields
   in
   let k =
     { cl_univs = univs;
@@ -586,13 +572,13 @@ 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. *)
-let definition_structure (kind,cum,poly,finite,(is_coe,((loc,idstruc),pl)),ps,cfs,idbuild,s) =
+let definition_structure (kind,cum,poly,finite,(is_coe,({CAst.loc;v=idstruc},pl)),ps,cfs,idbuild,s) =
   let cfs,notations = List.split cfs in
   let cfs,priorities = List.split cfs in
   let coers,fs = List.split cfs in
   let extract_name acc = function
-      Vernacexpr.AssumExpr((_,Name id),_) -> id::acc
-    | Vernacexpr.DefExpr ((_,Name id),_,_) -> id::acc
+      Vernacexpr.AssumExpr({CAst.v=Name id},_) -> id::acc
+    | Vernacexpr.DefExpr ({CAst.v=Name id},_,_) -> id::acc
     | _ -> acc in
   let allnames =  idstruc::(List.fold_left extract_name [] fs) in
   let () = match List.duplicates Id.equal allnames with
@@ -603,15 +589,14 @@ let definition_structure (kind,cum,poly,finite,(is_coe,((loc,idstruc),pl)),ps,cf
   if isnot_class && List.exists (fun opt -> not (Option.is_empty opt)) priorities then
     user_err Pp.(str "Priorities only allowed for type class substructures");
   (* Now, younger decl in params and fields is on top *)
-  let (pl, ctx), arity, template, implpars, params, implfs, fields =
+  let pl, univs, arity, template, implpars, params, implfs, fields =
     States.with_state_protection (fun () ->
-      typecheck_params_and_fields finite (kind = Class true) idstruc pl s ps notations fs) () in
-  let sign = structure_signature (fields@params) in
+      typecheck_params_and_fields finite (kind = Class true) idstruc poly pl s ps notations fs) () in
   let gr = match kind with
   | Class def ->
      let priorities = List.map (fun id -> {hint_priority = id; hint_pattern = None}) priorities in
-     let gr = declare_class finite def cum poly ctx (loc,idstruc) idbuild
-	  implpars params arity template implfs fields is_coe coers priorities sign in
+     let gr = declare_class finite def cum pl univs (loc,idstruc) idbuild
+          implpars params arity template implfs fields is_coe coers priorities in
 	gr
     | _ ->
       let implfs = List.map
@@ -619,18 +604,19 @@ let definition_structure (kind,cum,poly,finite,(is_coe,((loc,idstruc),pl)),ps,cf
 	           (succ (List.length params)) impls) implfs 
       in
       let univs =
-        if poly then
+        match univs with
+        | Polymorphic_const_entry univs ->
           if cum then
-            Cumulative_ind_entry (Universes.univ_inf_ind_from_universe_context ctx)
+            Cumulative_ind_entry (Univ.CumulativityInfo.from_universe_context univs)
           else
-            Polymorphic_ind_entry ctx
-        else
-          Monomorphic_ind_entry ctx
+            Polymorphic_ind_entry univs
+        | Monomorphic_const_entry univs ->
+          Monomorphic_ind_entry univs
       in
-      let ind = declare_structure finite univs idstruc
+      let ind = declare_structure finite pl univs idstruc
 	  idbuild implpars params arity template implfs 
-	  fields is_coe (List.map (fun coe -> not (Option.is_empty coe)) coers) sign in
+          fields is_coe (List.map (fun coe -> not (Option.is_empty coe)) coers) in
 	IndRef ind
   in
-  Universes.register_universe_binders gr pl;
+  Declare.declare_univ_binders gr pl;
   gr
diff --git a/vernac/record.mli b/vernac/record.mli
index 9a0c9ef9d..e0a4b8fdd 100644
--- a/vernac/record.mli
+++ b/vernac/record.mli
@@ -7,39 +7,26 @@
 (************************************************************************)
 
 open Names
-open Term
 open Vernacexpr
 open Constrexpr
-open Impargs
 open Globnames
 
 val primitive_flag : bool ref
 
-(** [declare_projections ref name coers params fields] declare projections of
-   record [ref] (if allowed) using the given [name] as argument, and put them
-   as coercions accordingly to [coers]; it returns the absolute names of projections *)
-
 val declare_projections :
-  inductive -> ?kind:Decl_kinds.definition_object_kind -> Id.t ->
-  coercion_flag list -> manual_explicitation list list -> Context.Rel.t ->
-  (Name.t * bool) list * constant option list
-
-val declare_structure :
-  Decl_kinds.recursivity_kind ->
-  Entries.inductive_universes ->
-  Id.t -> Id.t ->
-  manual_explicitation list -> Context.Rel.t -> (** params *) constr -> (** arity *)
-  bool (** template arity ? *) ->
-  Impargs.manual_explicitation list list -> Context.Rel.t -> (** fields *)
-  ?kind:Decl_kinds.definition_object_kind -> ?name:Id.t ->
-  bool -> (** coercion? *)
-  bool list -> (** field coercions *)
-  Evd.evar_map ->
-  inductive
+  inductive ->
+  Entries.constant_universes_entry ->
+  ?kind:Decl_kinds.definition_object_kind ->
+  Id.t ->
+  bool list ->
+  Universes.universe_binders ->
+  Impargs.manual_implicits list ->
+  Context.Rel.t ->
+    (Name.t * bool) list * Constant.t option list
 
 val definition_structure :
   inductive_kind * Decl_kinds.cumulative_inductive_flag * Decl_kinds.polymorphic *
-  Decl_kinds.recursivity_kind * plident with_coercion * local_binder_expr list *
+  Declarations.recursivity_kind * ident_decl with_coercion * local_binder_expr list *
   (local_decl_expr with_instance with_priority with_notation) list *
   Id.t * constr_expr option -> global_reference
 
diff --git a/vernac/search.ml b/vernac/search.ml
index 0f56f81e7..6da6a0c2d 100644
--- a/vernac/search.ml
+++ b/vernac/search.ml
@@ -9,7 +9,7 @@
 open Pp
 open Util
 open Names
-open Term
+open Constr
 open Declarations
 open Libobject
 open Environ
diff --git a/vernac/search.mli b/vernac/search.mli
index db54d732b..2eda3980a 100644
--- a/vernac/search.mli
+++ b/vernac/search.mli
@@ -7,7 +7,7 @@
 (************************************************************************)
 
 open Names
-open Term
+open Constr
 open Environ
 open Pattern
 open Globnames
diff --git a/vernac/topfmt.ml b/vernac/topfmt.ml
index e7b14309d..1ad7ead72 100644
--- a/vernac/topfmt.ml
+++ b/vernac/topfmt.ml
@@ -6,7 +6,6 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-open Feedback
 open Pp
 
 (** Pp control also belongs here as the terminal is private to the toplevel *)
@@ -138,7 +137,7 @@ let make_body quoter info ?pre_hdr s =
 (* The empty quoter *)
 let noq x = x
 (* Generic logger *)
-let gen_logger dbg warn ?pre_hdr level msg = match level with
+let gen_logger dbg warn ?pre_hdr level msg = let open Feedback in match level with
   | Debug   -> msgnl_with !std_ft (make_body dbg  dbg_hdr ?pre_hdr msg)
   | Info    -> msgnl_with !std_ft (make_body dbg info_hdr ?pre_hdr msg)
   | Notice  -> msgnl_with !std_ft (make_body noq info_hdr ?pre_hdr msg)
@@ -288,14 +287,14 @@ let init_terminal_output ~color =
  *)
 let emacs_logger = gen_logger Emacs.quote_info Emacs.quote_warning
 
-
 (* This is specific to the toplevel *)
 let pr_loc loc =
     let fname = loc.Loc.fname in
-    if CString.equal fname "" then
+    match fname with
+    | Loc.ToplevelInput ->
       Loc.(str"Toplevel input, characters " ++ int loc.bp ++
 	   str"-" ++ int loc.ep ++ str":")
-    else
+    | Loc.InFile fname ->
       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) ++
@@ -310,17 +309,23 @@ let print_err_exn ?extra any =
   std_logger ~pre_hdr Feedback.Error msg
 
 let with_output_to_file fname func input =
-  (* XXX FIXME: redirect std_ft  *)
-  (* let old_logger = !logger in *)
   let channel = open_out (String.concat "." [fname; "out"]) in
-  (* logger := ft_logger old_logger (Format.formatter_of_out_channel channel); *)
+  let old_fmt = !std_ft, !err_ft, !deep_ft in
+  let new_ft = Format.formatter_of_out_channel channel in
+  std_ft := new_ft;
+  err_ft := new_ft;
+  deep_ft := new_ft;
   try
     let output = func input in
-    (* logger := old_logger; *)
+    std_ft := Util.pi1 old_fmt;
+    err_ft := Util.pi2 old_fmt;
+    deep_ft := Util.pi3 old_fmt;
     close_out channel;
     output
   with reraise ->
     let reraise = Backtrace.add_backtrace reraise in
-    (* logger := old_logger; *)
+    std_ft := Util.pi1 old_fmt;
+    err_ft := Util.pi2 old_fmt;
+    deep_ft := Util.pi3 old_fmt;
     close_out channel;
     Exninfo.iraise reraise
diff --git a/vernac/vernac.mllib b/vernac/vernac.mllib
index f74073e1f..f001b572a 100644
--- a/vernac/vernac.mllib
+++ b/vernac/vernac.mllib
@@ -1,4 +1,5 @@
 Vernacprop
+Proof_using
 Lemmas
 Himsg
 ExplainErr
@@ -10,10 +11,15 @@ Search
 Indschemes
 DeclareDef
 Obligations
-Command
+ComDefinition
+ComAssumption
+ComInductive
+ComFixpoint
+ComProgramFixpoint
 Classes
 Record
 Assumptions
+Vernacstate
 Vernacinterp
 Mltop
 Topfmt
diff --git a/vernac/vernacentries.ml b/vernac/vernacentries.ml
index 8738e58e8..4613100fc 100644
--- a/vernac/vernacentries.ml
+++ b/vernac/vernacentries.ml
@@ -10,8 +10,8 @@
 
 open Pp
 open CErrors
+open CAst
 open Util
-open Flags
 open Names
 open Nameops
 open Term
@@ -19,7 +19,6 @@ open Tacmach
 open Constrintern
 open Prettyp
 open Printer
-open Command
 open Goptions
 open Libnames
 open Globnames
@@ -30,6 +29,7 @@ open Redexpr
 open Lemmas
 open Misctypes
 open Locality
+open Vernacinterp
 
 module NamedDecl = Context.Named.Declaration
 
@@ -57,39 +57,39 @@ let scope_class_of_qualid qid =
 let show_proof () =
   (* spiwack: this would probably be cooler with a bit of polishing. *)
   let p = Proof_global.give_me_the_proof () in
+  let sigma, env = Pfedit.get_current_context () in
   let pprf = Proof.partial_proof p in
-  Feedback.msg_notice (Pp.prlist_with_sep Pp.fnl Printer.pr_econstr pprf)
+  Pp.prlist_with_sep Pp.fnl (Printer.pr_econstr_env env sigma) pprf
 
 let show_top_evars () =
   (* spiwack: new as of Feb. 2010: shows goal evars in addition to non-goal evars. *)
   let pfts = Proof_global.give_me_the_proof () in
-  let gls = Proof.V82.subgoals pfts in
-  let sigma = gls.Evd.sigma in
-  Feedback.msg_notice (pr_evars_int sigma 1 (Evd.undefined_map sigma))
+  let gls,_,_,_,sigma = Proof.proof pfts in
+  pr_evars_int sigma 1 (Evd.undefined_map sigma)
 
 let show_universes () =
   let pfts = Proof_global.give_me_the_proof () in
-  let gls = Proof.V82.subgoals pfts in
-  let sigma = gls.Evd.sigma in
+  let gls,_,_,_,sigma = Proof.proof pfts in
   let ctx = Evd.universe_context_set (Evd.nf_constraints sigma) in
-    Feedback.msg_notice (Termops.pr_evar_universe_context (Evd.evar_universe_context sigma));
-    Feedback.msg_notice (str"Normalized constraints: " ++ Univ.pr_universe_context_set (Termops.pr_evd_level sigma) ctx)
+  Termops.pr_evar_universe_context (Evd.evar_universe_context sigma) ++ fnl () ++
+  str "Normalized constraints: " ++ Univ.pr_universe_context_set (Termops.pr_evd_level sigma) ctx
 
 (* Simulate the Intro(s) tactic *)
 let show_intro all =
   let open EConstr in
   let pf = Proof_global.give_me_the_proof() in
-  let {Evd.it=gls ; sigma=sigma; } = Proof.V82.subgoals pf in
+  let gls,_,_,_,sigma = Proof.proof 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 sigma (Termops.strip_outer_cast sigma (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))
+      hov 0 (prlist_with_sep  spc Id.print lid)
     else if not (List.is_empty l) then
       let n = List.last l in
-      Feedback.msg_notice (pr_id (List.hd (Tactics.find_intro_names [n] gl)))
-  end
+      Id.print (List.hd (Tactics.find_intro_names [n] gl))
+    else mt ()
+  end else mt ()
 
 (** Prepare a "match" template for a given inductive type.
     For each branch of the match, we list the constructor name
@@ -126,8 +126,8 @@ let make_cases_aux glob_ref =
 	       | [] -> []
 	       | (n,_)::l ->
 		   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 n' :: rename (Id.Set.add n' avoid) l in
+	     let al' = rename Id.Set.empty al in
 	     let consref = ConstructRef (ith_constructor_of_inductive ind (i + 1)) in
 	     (Libnames.string_of_qualid (Nametab.shortest_qualid_of_global Id.Set.empty consref) :: al') :: l)
 	  tarr []
@@ -148,14 +148,14 @@ let show_match id =
   let pr_branch l =
     str "| " ++ hov 1 (prlist_with_sep spc str l) ++ str " =>"
   in
-  Feedback.msg_notice (v 1 (str "match # with" ++ fnl () ++
-	    prlist_with_sep fnl pr_branch patterns ++ fnl () ++ str "end" ++ fnl ()))
+  v 1 (str "match # with" ++ fnl () ++
+       prlist_with_sep fnl pr_branch patterns ++ fnl () ++ str "end" ++ fnl ())
 
 (* "Print" commands *)
 
 let print_path_entry p =
-  let dir = pr_dirpath (Loadpath.logical p) in
-  let path = str (Loadpath.physical p) in
+  let dir = DirPath.print (Loadpath.logical p) in
+  let path = str (CUnix.escaped_string_of_physical_path (Loadpath.physical p)) in
   Pp.hov 2 (dir ++ spc () ++ path)
 
 let print_loadpath dir =
@@ -177,9 +177,9 @@ let print_modules () =
   let loaded_opened = List.intersect DirPath.equal opened loaded
   and only_loaded = List.subtract DirPath.equal loaded opened in
   str"Loaded and imported library files: " ++
-  pr_vertical_list pr_dirpath loaded_opened ++ fnl () ++
+  pr_vertical_list DirPath.print loaded_opened ++ fnl () ++
   str"Loaded and not imported library files: " ++
-  pr_vertical_list pr_dirpath only_loaded
+  pr_vertical_list DirPath.print only_loaded
 
 
 let print_module r =
@@ -187,24 +187,24 @@ let print_module r =
   try
     let globdir = Nametab.locate_dir qid in
       match globdir with
-	  DirModule (dirpath,(mp,_)) ->
-	    Feedback.msg_notice (Printmod.print_module (Printmod.printable_body dirpath) mp)
+          DirModule { obj_dir; obj_mp; _ } ->
+          Printmod.print_module (Printmod.printable_body obj_dir) obj_mp
 	| _ -> raise Not_found
   with
-      Not_found -> Feedback.msg_error (str"Unknown Module " ++ pr_qualid qid)
+    Not_found -> user_err (str"Unknown Module " ++ pr_qualid qid)
 
 let print_modtype r =
   let (loc,qid) = qualid_of_reference r in
   try
     let kn = Nametab.locate_modtype qid in
-    Feedback.msg_notice (Printmod.print_modtype kn)
+    Printmod.print_modtype kn
   with Not_found ->
     (* Is there a module of this name ? If yes we display its type *)
     try
       let mp = Nametab.locate_module qid in
-      Feedback.msg_notice (Printmod.print_module false mp)
+      Printmod.print_module false mp
     with Not_found ->
-      Feedback.msg_error (str"Unknown Module Type or Module " ++ pr_qualid qid)
+      user_err (str"Unknown Module Type or Module " ++ pr_qualid qid)
 
 let print_namespace ns =
   let ns = List.rev (Names.DirPath.repr ns) in
@@ -251,14 +251,15 @@ let print_namespace ns =
   let print_list pr l = prlist_with_sep (fun () -> str".") pr l in
   let print_kn kn =
     (* spiwack: I'm ignoring the dirpath, is that bad? *)
-    let (mp,_,lbl) = Names.repr_kn kn in
+    let (mp,_,lbl) = Names.KerName.repr kn in
     let qn = (qualified_minus (List.length ns) mp)@[Names.Label.to_id lbl] in
-    print_list pr_id qn
+    print_list Id.print qn
   in
   let print_constant k body =
     (* FIXME: universes *)
     let t = body.Declarations.const_type in
-    print_kn k ++ str":" ++ spc() ++ Printer.pr_type t
+    let sigma, env = Pfedit.get_current_context () in
+    print_kn k ++ str":" ++ spc() ++ Printer.pr_type_env env sigma t
   in
   let matches mp = match match_modulepath ns mp with
   | Some [] -> true
@@ -266,14 +267,14 @@ let print_namespace ns =
   let constants = (Environ.pre_env (Global.env ())).Pre_env.env_globals.Pre_env.env_constants in
   let constants_in_namespace =
     Cmap_env.fold (fun c (body,_) acc ->
-      let kn = user_con c in
-      if matches (modpath kn) then
+      let kn = Constant.user c in
+      if matches (KerName.modpath kn) then
         acc++fnl()++hov 2 (print_constant kn body)
       else
         acc
     ) constants (str"")
   in
-  Feedback.msg_notice ((print_list pr_id ns)++str":"++fnl()++constants_in_namespace)
+  (print_list Id.print ns)++str":"++fnl()++constants_in_namespace
 
 let print_strategy r =
   let open Conv_oracle in
@@ -303,7 +304,7 @@ let print_strategy r =
       else str "Constant strategies" ++ fnl () ++
         hov 0 (prlist_with_sep fnl pr_strategy cst_lvl)
     in
-    Feedback.msg_notice (var_msg ++ cst_msg)
+    var_msg ++ cst_msg
   | Some r ->
     let r = Smartlocate.smart_global r in
     let key = match r with
@@ -312,7 +313,7 @@ let print_strategy r =
     | IndRef _ | ConstructRef _ -> user_err Pp.(str "The reference is not unfoldable")
     in
     let lvl = get_strategy oracle key in
-    Feedback.msg_notice (pr_strategy (r, lvl))
+    pr_strategy (r, lvl)
 
 let dump_universes_gen g s =
   let output = open_out s in
@@ -346,7 +347,7 @@ let dump_universes_gen g s =
   try
     UGraph.dump_universes output_constraint g;
     close ();
-    Feedback.msg_info (str "Universes written to file \"" ++ str s ++ str "\".")
+    str "Universes written to file \"" ++ str s ++ str "\"."
   with reraise ->
     let reraise = CErrors.push reraise in
     close ();
@@ -361,30 +362,27 @@ let locate_file f =
 
 let msg_found_library = function
   | Library.LibLoaded, fulldir, file ->
-      Feedback.msg_info (hov 0
-	(pr_dirpath fulldir ++ strbrk " has been loaded from file " ++
-	 str file))
+    hov 0 (DirPath.print fulldir ++ strbrk " has been loaded from file " ++ str file)
   | Library.LibInPath, fulldir, file ->
-      Feedback.msg_info (hov 0
-	(pr_dirpath fulldir ++ strbrk " is bound to file " ++ str file))
+    hov 0 (DirPath.print fulldir ++ strbrk " is bound to file " ++ str file)
 
 let err_unmapped_library ?loc ?from qid =
   let dir = fst (repr_qualid qid) in
   let prefix = match from with
   | None -> str "."
   | Some from ->
-    str " and prefix " ++ pr_dirpath from ++ str "."
+    str " and prefix " ++ DirPath.print from ++ str "."
   in
   user_err ?loc
     ~hdr:"locate_library"
     (strbrk "Cannot find a physical path bound to logical path matching suffix " ++
-       pr_dirpath dir ++ prefix)
+       DirPath.print dir ++ prefix)
 
 let err_notfound_library ?loc ?from qid =
   let prefix = match from with
   | None -> str "."
   | Some from ->
-    str " with prefix " ++ pr_dirpath from ++ str "."
+    str " with prefix " ++ DirPath.print from ++ str "."
   in
   user_err ?loc ~hdr:"locate_library"
      (strbrk "Unable to locate library " ++ pr_qualid qid ++ prefix)
@@ -409,9 +407,10 @@ let dump_global r =
 (**********)
 (* Syntax *)
 
-let vernac_syntax_extension locality local =
-  let local = enforce_module_locality locality local in
-  Metasyntax.add_syntax_extension local
+let vernac_syntax_extension atts infix l =
+  let local = enforce_module_locality atts.locality in
+  if infix then Metasyntax.check_infix_modifiers (snd l);
+  Metasyntax.add_syntax_extension local l
 
 let vernac_delimiters sc = function
   | Some lr -> Metasyntax.add_delimiters sc lr
@@ -420,21 +419,21 @@ let vernac_delimiters sc = function
 let vernac_bind_scope sc cll =
   Metasyntax.add_class_scope sc (List.map scope_class_of_qualid cll)
 
-let vernac_open_close_scope locality local (b,s) =
-  let local = enforce_section_locality locality local in
+let vernac_open_close_scope ~atts (b,s) =
+  let local = enforce_section_locality atts.locality in
   Notation.open_close_scope (local,b,s)
 
-let vernac_arguments_scope locality r scl =
-  let local = make_section_locality locality in
+let vernac_arguments_scope ~atts r scl =
+  let local = make_section_locality atts.locality in
   Notation.declare_arguments_scope local (smart_global r) scl
 
-let vernac_infix locality local =
-  let local = enforce_module_locality locality local in
-  Metasyntax.add_infix local
+let vernac_infix ~atts =
+  let local = enforce_module_locality atts.locality in
+  Metasyntax.add_infix local (Global.env())
 
-let vernac_notation locality local =
-  let local = enforce_module_locality locality local in
-  Metasyntax.add_notation local
+let vernac_notation ~atts =
+  let local = enforce_module_locality atts.locality in
+  Metasyntax.add_notation local (Global.env())
 
 (***********)
 (* Gallina *)
@@ -445,11 +444,13 @@ let start_proof_and_print k l hook =
       let hook env sigma ev =
         let tac = !Obligations.default_tactic in
         let evi = Evd.find sigma ev in
+        let evi = Evarutil.nf_evar_info sigma evi in
         let env = Evd.evar_filtered_env evi in
         try
-          let concl = Evarutil.nf_evars_universes sigma evi.Evd.evar_concl in
-          let concl = EConstr.of_constr concl in
-          if Evarutil.has_undefined_evars sigma concl then raise Exit;
+          let concl = EConstr.of_constr evi.Evd.evar_concl in
+          if not (Evarutil.is_ground_env sigma env &&
+                  Evarutil.is_ground_term sigma concl)
+          then raise Exit;
           let c, _, ctx =
             Pfedit.build_by_tactic env (Evd.evar_universe_context sigma)
                                    concl (Tacticals.New.tclCOMPLETE tac)
@@ -471,33 +472,41 @@ let vernac_definition_hook p = function
 | SubClass -> Class.add_subclass_hook p
 | _ -> no_hook
 
-let vernac_definition locality p (local,k) ((loc,id as lid),pl) def =
-  let local = enforce_locality_exp locality local in
-  let hook = vernac_definition_hook p k in
-  let () = match local with
-  | Discharge -> Dumpglob.dump_definition lid true "var"
-  | Local | Global -> Dumpglob.dump_definition lid false "def"
+let vernac_definition ~atts discharge kind ({loc;v=id}, pl) def =
+  let local = enforce_locality_exp atts.locality discharge in
+  let hook = vernac_definition_hook atts.polymorphic kind in
+  let () =
+    match id with
+    | Anonymous -> ()
+    | Name n -> let lid = CAst.make ?loc n in
+      match local with
+      | Discharge -> Dumpglob.dump_definition lid true "var"
+      | Local | Global -> Dumpglob.dump_definition lid false "def"
+  in
+  let program_mode = Flags.is_program_mode () in
+  let name =
+    match id with
+    | Anonymous -> fresh_name_for_anonymous_theorem ()
+    | Name n -> n
   in
   (match def with
     | ProveBody (bl,t) ->   (* local binders, typ *)
-	  start_proof_and_print (local,p,DefinitionBody k)
-	    [Some (lid,pl), (bl,t)] hook
+      start_proof_and_print (local, atts.polymorphic, DefinitionBody kind)
+        [(CAst.make ?loc name, pl), (bl, t)] hook
     | DefineBody (bl,red_option,c,typ_opt) ->
- 	let red_option = match red_option with
+      let red_option = match red_option with
           | None -> None
           | Some r ->
-	      let (evc,env)= get_current_context () in
- 		Some (snd (Hook.get f_interp_redexp env evc r)) in
-	do_definition id (local,p,k) pl bl red_option c typ_opt hook)
+            let sigma, env = Pfedit.get_current_context () in
+            Some (snd (Hook.get f_interp_redexp env sigma r)) in
+      ComDefinition.do_definition ~program_mode name
+        (local, atts.polymorphic, kind) pl bl red_option c typ_opt hook)
 
-let vernac_start_proof locality p kind l =
-  let local = enforce_locality_exp locality None in
+let vernac_start_proof ~atts kind l =
+  let local = enforce_locality_exp atts.locality NoDischarge in
   if Dumpglob.dump () then
-    List.iter (fun (id, _) ->
-      match id with
-	| Some (lid,_) -> Dumpglob.dump_definition lid false "prf"
-	| None -> ()) l;
-  start_proof_and_print (local, p, Proof kind) l no_hook
+    List.iter (fun ((id, _), _) -> Dumpglob.dump_definition id false "prf") l;
+  start_proof_and_print (local, atts.polymorphic, Proof kind) l no_hook
 
 let vernac_end_proof ?proof = function
   | Admitted          -> save_proof ?proof Admitted
@@ -507,19 +516,19 @@ let vernac_exact_proof c =
   (* spiwack: for simplicity I do not enforce that "Proof proof_term" is
      called only at the begining of a proof. *)
   let status = Pfedit.by (Tactics.exact_proof c) in
-  save_proof (Vernacexpr.(Proved(Opaque None,None)));
+  save_proof (Vernacexpr.(Proved(Opaque,None)));
   if not status then Feedback.feedback Feedback.AddedAxiom
 
-let vernac_assumption locality poly (local, kind) l nl =
-  let local = enforce_locality_exp locality local in
+let vernac_assumption ~atts discharge kind l nl =
+  let local = enforce_locality_exp atts.locality discharge in
   let global = local == Global in
-  let kind = local, poly, kind in
+  let kind = local, atts.polymorphic, kind in
   List.iter (fun (is_coe,(idl,c)) ->
     if Dumpglob.dump () then
       List.iter (fun (lid, _) ->
 	if global then Dumpglob.dump_definition lid false "ax"
 	else Dumpglob.dump_definition lid true "var") idl) l;
-  let status = do_assumptions kind nl l in
+  let status = ComAssumption.do_assumptions kind nl l in
   if not status then Feedback.feedback Feedback.AddedAxiom
 
 let should_treat_as_cumulative cum poly =
@@ -538,14 +547,14 @@ let should_treat_as_cumulative cum poly =
 let vernac_record cum k poly finite struc binders sort nameopt cfs =
   let is_cumulative = should_treat_as_cumulative cum poly in
   let const = match nameopt with
-    | None -> add_prefix "Build_" (snd (fst (snd struc)))
-    | Some (_,id as lid) ->
+    | None -> add_prefix "Build_" (fst (snd struc)).v
+    | Some ({v=id} as lid) ->
 	Dumpglob.dump_definition lid false "constr"; id in
     if Dumpglob.dump () then (
       Dumpglob.dump_definition (fst (snd struc)) false "rec";
       List.iter (fun (((_, x), _), _) ->
 	match x with
-	| Vernacexpr.AssumExpr ((loc, Name id), _) -> Dumpglob.dump_definition (loc,id) false "proj"
+        | Vernacexpr.AssumExpr ({loc;v=Name id}, _) -> Dumpglob.dump_definition (make ?loc id) false "proj"
 	| _ -> ()) cfs);
     ignore(Record.definition_structure (k,is_cumulative,poly,finite,struc,binders,cfs,const,sort))
 
@@ -553,8 +562,8 @@ let vernac_record cum k poly finite struc binders sort nameopt cfs =
     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 cum poly lo finite indl =
-  let is_cumulative = should_treat_as_cumulative cum poly in
+let vernac_inductive ~atts cum lo finite indl =
+  let is_cumulative = should_treat_as_cumulative cum atts.polymorphic in
   if Dumpglob.dump () then
     List.iter (fun (((coe,(lid,_)), _, _, _, cstrs), _) ->
       match cstrs with
@@ -571,13 +580,13 @@ let vernac_inductive cum poly lo finite indl =
       user_err Pp.(str "The Variant keyword does not support syntax { ... }.")
   | [ ( id , bl , c , b, RecordDecl (oc,fs) ), [] ] ->
       vernac_record cum (match b with Class _ -> Class false | _ -> b)
-       poly finite id bl c oc fs
+       atts.polymorphic finite id bl c oc fs
   | [ ( id , bl , c , Class _, Constructors [l]), [] ] ->
       let f =
-	let (coe, ((loc, id), ce)) = l in
+        let (coe, ({loc;v=id}, ce)) = l in
 	let coe' = if coe then Some true else None in
-  	  (((coe', AssumExpr ((loc, Name id), ce)), None), [])
-      in vernac_record cum (Class true) poly finite id bl c None [f]
+          (((coe', AssumExpr ((make ?loc @@ Name id), ce)), None), [])
+      in vernac_record cum (Class true) atts.polymorphic finite id bl c None [f]
   | [ ( _ , _, _, Class _, Constructors _), [] ] ->
       user_err Pp.(str "Inductive classes not supported")
   | [ ( id , bl , c , Class _, _), _ :: _ ] ->
@@ -591,19 +600,30 @@ let vernac_inductive cum poly lo finite indl =
       | _ -> user_err Pp.(str "Cannot handle mutually (co)inductive records.")
     in
     let indl = List.map unpack indl in
-    do_mutual_inductive indl is_cumulative poly lo finite
+    ComInductive.do_mutual_inductive indl is_cumulative atts.polymorphic lo finite
 
-let vernac_fixpoint locality poly local l =
-  let local = enforce_locality_exp locality local in
+let vernac_fixpoint ~atts discharge l =
+  let local = enforce_locality_exp atts.locality discharge in
   if Dumpglob.dump () then
     List.iter (fun (((lid,_), _, _, _, _), _) -> Dumpglob.dump_definition lid false "def") l;
-  do_fixpoint local poly l
+  (* XXX: Switch to the attribute system and match on ~atts *)
+  let do_fixpoint = if Flags.is_program_mode () then
+      ComProgramFixpoint.do_fixpoint
+    else
+      ComFixpoint.do_fixpoint
+  in
+  do_fixpoint local atts.polymorphic l
 
-let vernac_cofixpoint locality poly local l =
-  let local = enforce_locality_exp locality local in
+let vernac_cofixpoint ~atts discharge l =
+  let local = enforce_locality_exp atts.locality discharge in
   if Dumpglob.dump () then
     List.iter (fun (((lid,_), _, _, _), _) -> Dumpglob.dump_definition lid false "def") l;
-  do_cofixpoint local poly l
+  let do_cofixpoint = if Flags.is_program_mode () then
+      ComProgramFixpoint.do_cofixpoint
+    else
+      ComFixpoint.do_cofixpoint
+  in
+  do_cofixpoint local atts.polymorphic l
 
 let vernac_scheme l =
   if Dumpglob.dump () then
@@ -618,22 +638,22 @@ let vernac_scheme l =
 let vernac_combined_scheme lid l =
   if Dumpglob.dump () then
     (Dumpglob.dump_definition lid false "def";
-     List.iter (fun lid -> dump_global (Misctypes.AN (Ident lid))) l);
+     List.iter (fun {loc;v=id} -> dump_global (Misctypes.AN (Ident (Loc.tag ?loc id)))) l);
  Indschemes.do_combined_scheme lid l
 
-let vernac_universe loc poly l =
-  if poly && not (Lib.sections_are_opened ()) then
-    user_err ?loc ~hdr:"vernac_universe"
+let vernac_universe ~atts l =
+  if atts.polymorphic && not (Lib.sections_are_opened ()) then
+    user_err ?loc:atts.loc ~hdr:"vernac_universe"
 		 (str"Polymorphic universes can only be declared inside sections, " ++
 		  str "use Monomorphic Universe instead");
-  do_universe poly l
+  Declare.do_universe atts.polymorphic l
 
-let vernac_constraint loc poly l =
-  if poly && not (Lib.sections_are_opened ()) then
-    user_err ?loc ~hdr:"vernac_constraint"
+let vernac_constraint ~atts l =
+  if atts.polymorphic && not (Lib.sections_are_opened ()) then
+    user_err ?loc:atts.loc ~hdr:"vernac_constraint"
 		 (str"Polymorphic universe constraints can only be declared"
 		  ++ str " inside sections, use Monomorphic Constraint instead");
-  do_constraint poly l
+  Declare.do_constraint atts.polymorphic l
 
 (**********************)
 (* Modules            *)
@@ -641,7 +661,7 @@ let vernac_constraint loc poly l =
 let vernac_import export refl =
   Library.import_module export (List.map qualid_of_reference refl)
 
-let vernac_declare_module export (loc, id) binders_ast mty_ast =
+let vernac_declare_module export {loc;v=id} binders_ast mty_ast =
   (* We check the state of the system (in section, in module type)
      and what module information is supplied *)
   if Lib.sections_are_opened () then
@@ -656,10 +676,10 @@ let vernac_declare_module export (loc, id) binders_ast mty_ast =
       id binders_ast (Enforce mty_ast) []
   in
   Dumpglob.dump_moddef ?loc mp "mod";
-  if_verbose Feedback.msg_info (str "Module " ++ pr_id id ++ str " is declared");
+  Flags.if_verbose Feedback.msg_info (str "Module " ++ Id.print id ++ str " is declared");
   Option.iter (fun export -> vernac_import export [Ident (Loc.tag id)]) export
 
-let vernac_define_module export (loc, id) binders_ast mty_ast_o mexpr_ast_l =
+let vernac_define_module export {loc;v=id} (binders_ast : module_binder list) mty_ast_o mexpr_ast_l =
   (* We check the state of the system (in section, in module type)
      and what module information is supplied *)
   if Lib.sections_are_opened () then
@@ -670,15 +690,15 @@ let vernac_define_module export (loc, id) binders_ast mty_ast_o mexpr_ast_l =
        let binders_ast,argsexport =
         List.fold_right
          (fun (export,idl,ty) (args,argsexport) ->
-           (idl,ty)::args, (List.map (fun (_,i) -> export,i)idl)@argsexport) binders_ast
+           (idl,ty)::args, (List.map (fun {v=i} -> export,i)idl)@argsexport) binders_ast
              ([],[]) in
        let mp =
          Declaremods.start_module Modintern.interp_module_ast
            export id binders_ast mty_ast_o
        in
        Dumpglob.dump_moddef ?loc mp "mod";
-       if_verbose Feedback.msg_info
-         (str "Interactive Module " ++ pr_id id ++ str " started");
+       Flags.if_verbose Feedback.msg_info
+         (str "Interactive Module " ++ Id.print id ++ str " started");
        List.iter
          (fun (export,id) ->
            Option.iter
@@ -695,18 +715,18 @@ let vernac_define_module export (loc, id) binders_ast mty_ast_o mexpr_ast_l =
 	   id binders_ast mty_ast_o mexpr_ast_l
        in
        Dumpglob.dump_moddef ?loc mp "mod";
-       if_verbose Feedback.msg_info
-	 (str "Module " ++ pr_id id ++ str " is defined");
+       Flags.if_verbose Feedback.msg_info
+	 (str "Module " ++ Id.print id ++ str " is defined");
        Option.iter (fun export -> vernac_import export [Ident (Loc.tag id)])
          export
 
-let vernac_end_module export (loc,id as lid) =
+let vernac_end_module export {loc;v=id} =
   let mp = Declaremods.end_module () in
   Dumpglob.dump_modref ?loc mp "mod";
-  if_verbose Feedback.msg_info (str "Module " ++ pr_id id ++ str " is defined");
-  Option.iter (fun export -> vernac_import export [Ident lid]) export
+  Flags.if_verbose Feedback.msg_info (str "Module " ++ Id.print id ++ str " is defined");
+  Option.iter (fun export -> vernac_import export [Ident (Loc.tag ?loc id)]) export
 
-let vernac_declare_module_type (loc,id) binders_ast mty_sign mty_ast_l =
+let vernac_declare_module_type {loc;v=id} binders_ast mty_sign mty_ast_l =
   if Lib.sections_are_opened () then
     user_err Pp.(str "Modules and Module Types are not allowed inside sections.");
 
@@ -716,7 +736,7 @@ let vernac_declare_module_type (loc,id) binders_ast mty_sign mty_ast_l =
        let binders_ast,argsexport =
 	 List.fold_right
          (fun (export,idl,ty) (args,argsexport) ->
-           (idl,ty)::args, (List.map (fun (_,i) -> export,i)idl)@argsexport) binders_ast
+           (idl,ty)::args, (List.map (fun {v=i} -> export,i)idl)@argsexport) binders_ast
              ([],[]) in
 
        let mp =
@@ -724,8 +744,8 @@ let vernac_declare_module_type (loc,id) binders_ast mty_sign mty_ast_l =
            id binders_ast mty_sign
        in
        Dumpglob.dump_moddef ?loc mp "modtype";
-       if_verbose Feedback.msg_info
-	 (str "Interactive Module Type " ++ pr_id id ++ str " started");
+       Flags.if_verbose Feedback.msg_info
+	 (str "Interactive Module Type " ++ Id.print id ++ str " started");
        List.iter
          (fun (export,id) ->
            Option.iter
@@ -743,13 +763,13 @@ let vernac_declare_module_type (loc,id) binders_ast mty_sign mty_ast_l =
 	    id binders_ast mty_sign mty_ast_l
         in
         Dumpglob.dump_moddef ?loc mp "modtype";
-	if_verbose Feedback.msg_info
-	  (str "Module Type " ++ pr_id id ++ str " is defined")
+	Flags.if_verbose Feedback.msg_info
+	  (str "Module Type " ++ Id.print id ++ str " is defined")
 
-let vernac_end_modtype (loc,id) =
+let vernac_end_modtype {loc;v=id} =
   let mp = Declaremods.end_modtype () in
   Dumpglob.dump_modref ?loc mp "modtype";
-  if_verbose Feedback.msg_info (str "Module Type " ++ pr_id id ++ str " is defined")
+  Flags.if_verbose Feedback.msg_info (str "Module Type " ++ Id.print id ++ str " is defined")
 
 let vernac_include l =
   Declaremods.declare_include Modintern.interp_module_ast l
@@ -759,21 +779,21 @@ let vernac_include l =
 
 (* Sections *)
 
-let vernac_begin_section (_, id as lid) =
+let vernac_begin_section ({v=id} as lid) =
   Proof_global.check_no_pending_proof ();
   Dumpglob.dump_definition lid true "sec";
   Lib.open_section id
 
-let vernac_end_section (loc,_) =
+let vernac_end_section {CAst.loc} =
   Dumpglob.dump_reference ?loc
     (DirPath.to_string (Lib.current_dirpath true)) "<>" "sec";
   Lib.close_section ()
 
-let vernac_name_sec_hyp (_,id) set = Proof_using.name_set id set
+let vernac_name_sec_hyp {v=id} set = Proof_using.name_set id set
 
 (* Dispatcher of the "End" command *)
 
-let vernac_end_segment (_,id as lid) =
+let vernac_end_segment ({v=id} as lid) =
   Proof_global.check_no_pending_proof ();
   match Lib.find_opening_node id with
   | Lib.OpenedModule (false,export,_,_) -> vernac_end_module export lid
@@ -811,32 +831,33 @@ let vernac_require from import qidl =
 let vernac_canonical r =
   Recordops.declare_canonical_structure (smart_global r)
 
-let vernac_coercion locality poly local ref qids qidt =
-  let local = enforce_locality locality local in
+let vernac_coercion ~atts ref qids qidt =
+  let local = enforce_locality atts.locality in
   let target = cl_of_qualid qidt in
   let source = cl_of_qualid qids in
   let ref' = smart_global ref in
-  Class.try_add_new_coercion_with_target ref' ~local poly ~source ~target;
-  if_verbose Feedback.msg_info (pr_global ref' ++ str " is now a coercion")
+  Class.try_add_new_coercion_with_target ref' ~local atts.polymorphic ~source ~target;
+  Flags.if_verbose Feedback.msg_info (pr_global ref' ++ str " is now a coercion")
 
-let vernac_identity_coercion locality poly local id qids qidt =
-  let local = enforce_locality locality local in
+let vernac_identity_coercion ~atts id qids qidt =
+  let local = enforce_locality atts.locality in
   let target = cl_of_qualid qidt in
   let source = cl_of_qualid qids in
-  Class.try_add_new_identity_coercion id ~local poly ~source ~target
+  Class.try_add_new_identity_coercion id ~local atts.polymorphic ~source ~target
 
 (* Type classes *)
 
-let vernac_instance abst locality poly sup inst props pri =
-  let global = not (make_section_locality locality) in
+let vernac_instance ~atts abst sup inst props pri =
+  let global = not (make_section_locality atts.locality) in
   Dumpglob.dump_constraint inst false "inst";
-  ignore(Classes.new_instance ~abstract:abst ~global poly sup inst props pri)
+  let program_mode = Flags.is_program_mode () in
+  ignore(Classes.new_instance ~program_mode ~abstract:abst ~global atts.polymorphic sup inst props pri)
 
-let vernac_context poly l =
-  if not (Classes.context poly l) then Feedback.feedback Feedback.AddedAxiom
+let vernac_context ~atts l =
+  if not (Classes.context atts.polymorphic l) then Feedback.feedback Feedback.AddedAxiom
 
-let vernac_declare_instances locality insts =
-  let glob = not (make_section_locality locality) in
+let vernac_declare_instances ~atts insts =
+  let glob = not (make_section_locality atts.locality) in
   List.iter (fun (id, info) -> Classes.existing_instance glob id (Some info)) insts
 
 let vernac_declare_class id =
@@ -874,7 +895,7 @@ let vernac_set_used_variables e =
   List.iter (fun id -> 
     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))
+        (str "Unknown variable: " ++ Id.print id))
     l;
   let _, to_clear = Proof_global.set_used_variables l in
   let to_clear = List.map snd to_clear in
@@ -892,9 +913,11 @@ let expand filename =
   Envars.expand_path_macros ~warn:(fun x -> Feedback.msg_warning (str x)) filename
 
 let vernac_add_loadpath implicit pdir ldiropt =
+  let open Mltop in
   let pdir = expand pdir in
-  let alias = Option.default Nameops.default_root_prefix ldiropt in
-  Mltop.add_rec_path Mltop.AddTopML ~unix_path:pdir ~coq_root:alias ~implicit
+  let alias = Option.default Libnames.default_root_prefix ldiropt in
+  add_coq_path { recursive = true;
+                 path_spec = VoPath { unix_path = pdir; coq_path = alias; has_ml = AddTopML; implicit } }
 
 let vernac_remove_loadpath path =
   Loadpath.remove_load_path (expand path)
@@ -902,10 +925,11 @@ let vernac_remove_loadpath path =
   (* Coq syntax for ML or system commands *)
 
 let vernac_add_ml_path isrec path =
-  (if isrec then Mltop.add_rec_ml_dir else Mltop.add_ml_dir) (expand path)
+  let open Mltop in
+  add_coq_path { recursive = isrec; path_spec = MlPath (expand path) }
 
-let vernac_declare_ml_module locality l =
-  let local = make_locality locality in
+let vernac_declare_ml_module ~atts l =
+  let local = make_locality atts.locality in
   Mltop.declare_ml_modules local (List.map expand l)
 
 let vernac_chdir = function
@@ -919,8 +943,7 @@ let vernac_chdir = function
 	  so we make it an error. *)
 	  user_err Pp.(str ("Cd failed: " ^ err))
       end;
-      if_verbose Feedback.msg_info (str (Sys.getcwd()))
-
+      Flags.if_verbose Feedback.msg_info (str (Sys.getcwd()))
 
 (********************)
 (* State management *)
@@ -938,25 +961,25 @@ let vernac_restore_state file =
 (************)
 (* Commands *)
 
-let vernac_create_hintdb locality id b =
-  let local = make_module_locality locality in
+let vernac_create_hintdb ~atts id b =
+  let local = make_module_locality atts.locality in
   Hints.create_hint_db local id full_transparent_state b
 
-let vernac_remove_hints locality dbs ids =
-  let local = make_module_locality locality in
+let vernac_remove_hints ~atts dbs ids =
+  let local = make_module_locality atts.locality in
   Hints.remove_hints local dbs (List.map Smartlocate.global_with_alias ids)
 
-let vernac_hints locality poly local lb h =
-  let local = enforce_module_locality locality local in
-  Hints.add_hints local lb (Hints.interp_hints poly h)
+let vernac_hints ~atts lb h =
+  let local = enforce_module_locality atts.locality in
+  Hints.add_hints local lb (Hints.interp_hints atts.polymorphic h)
 
-let vernac_syntactic_definition locality lid x local y =
+let vernac_syntactic_definition ~atts lid x y =
   Dumpglob.dump_definition lid false "syndef";
-  let local = enforce_module_locality locality local in
-  Metasyntax.add_syntactic_definition (snd lid) x local y
+  let local = enforce_module_locality atts.locality in
+  Metasyntax.add_syntactic_definition (Global.env()) lid.v x local y
 
-let vernac_declare_implicits locality r l =
-  let local = make_section_locality locality in
+let vernac_declare_implicits ~atts r l =
+  let local = make_section_locality atts.locality in
   match l with
   | [] ->
       Impargs.declare_implicits local (smart_global r)
@@ -976,7 +999,7 @@ let warn_arguments_assert =
 (* [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 vernac_arguments ~atts 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
@@ -1184,30 +1207,30 @@ let vernac_arguments locality reference args more_implicits nargs_for_red flags
   (* Actions *)
 
   if renaming_specified then begin
-    let local = make_section_locality locality in
+    let local = make_section_locality atts.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 (loc,k) -> 
+      let scopes = List.map (Option.map (fun {loc;v=k} ->
         try ignore (Notation.find_scope k); k
         with UserError _ ->
           Notation.find_delimiters_scope ?loc k)) scopes
       in
-      vernac_arguments_scope locality reference scopes
+      vernac_arguments_scope ~atts reference scopes
     end;
 
   if implicits_specified || clear_implicits_flag then
-    vernac_declare_implicits locality reference implicits;
+    vernac_declare_implicits ~atts reference implicits;
 
   if default_implicits_flag then
-    vernac_declare_implicits locality reference [];
+    vernac_declare_implicits ~atts reference [];
 
   if red_modifiers_specified then begin
     match sr with
     | ConstRef _ as c ->
        Reductionops.ReductionBehaviour.set
-         (make_section_locality locality) c
+         (make_section_locality atts.locality) c
          (rargs, Option.default ~-1 nargs_for_red, red_flags)
     | _ -> user_err
              (strbrk "Modifiers of the behavior of the simpl tactic "++
@@ -1230,13 +1253,13 @@ let vernac_reserve bl =
     let env = Global.env() in
     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) (EConstr.of_constr t) in
+    let t = Detyping.detype Detyping.Now false Id.Set.empty env (Evd.from_ctx ctx) (EConstr.of_constr 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
 
-let vernac_generalizable locality =
-  let local = make_non_locality locality in
+let vernac_generalizable ~atts =
+  let local = make_non_locality atts.locality in
   Implicit_quantifiers.declare_generalizable local
 
 let _ =
@@ -1301,7 +1324,7 @@ let _ =
       optname  = "automatic introduction of variables";
       optkey   = ["Automatic";"Introduction"];
       optread  = Flags.is_auto_intros;
-      optwrite = make_auto_intros }
+      optwrite = Flags.make_auto_intros }
 
 let _ =
   declare_bool_option
@@ -1367,11 +1390,13 @@ let _ =
       optread  = (fun () -> !Flags.program_mode);
       optwrite = (fun b -> Flags.program_mode:=b) }
 
+let universe_polymorphism_option_name = ["Universe"; "Polymorphism"]
+
 let _ =
   declare_bool_option
     { optdepr  = false;
       optname  = "universe polymorphism";
-      optkey   = ["Universe"; "Polymorphism"];
+      optkey   = universe_polymorphism_option_name;
       optread  = Flags.is_universe_polymorphism;
       optwrite = Flags.make_universe_polymorphism }
 
@@ -1444,6 +1469,14 @@ let _ =
 let _ =
   declare_bool_option
     { optdepr  = false;
+      optname  = "dumping VM lambda code after compilation";
+      optkey   = ["Dump";"Lambda"];
+      optread  = Flags.get_dump_lambda;
+      optwrite = Flags.set_dump_lambda }
+
+let _ =
+  declare_bool_option
+    { optdepr  = false;
       optname  = "explicitly parsing implicit arguments";
       optkey   = ["Parsing";"Explicit"];
       optread  = (fun () -> !Constrintern.parsing_explicit);
@@ -1473,8 +1506,8 @@ let _ =
       optread  = Nativenorm.get_profiling_enabled;
       optwrite = Nativenorm.set_profiling_enabled }
 
-let vernac_set_strategy locality l =
-  let local = make_locality locality in
+let vernac_set_strategy ~atts l =
+  let local = make_locality atts.locality in
   let glob_ref r =
     match smart_global r with
       | ConstRef sp -> EvalConstRef sp
@@ -1484,8 +1517,8 @@ let vernac_set_strategy locality l =
   let l = List.map (fun (lev,ql) -> (lev,List.map glob_ref ql)) l in
   Redexpr.set_strategy local l
 
-let vernac_set_opacity locality (v,l) =
-  let local = make_non_locality locality in
+let vernac_set_opacity ~atts (v,l) =
+  let local = make_non_locality atts.locality in
   let glob_ref r =
     match smart_global r with
       | ConstRef sp -> EvalConstRef sp
@@ -1495,18 +1528,18 @@ let vernac_set_opacity locality (v,l) =
   let l = List.map glob_ref l in
   Redexpr.set_strategy local [v,l]
 
-let vernac_set_option locality key = function
-  | StringValue s -> set_string_option_value_gen locality key s
-  | StringOptValue (Some s) -> set_string_option_value_gen locality key s
-  | StringOptValue None -> unset_option_value_gen locality key
-  | IntValue n -> set_int_option_value_gen locality key n
-  | BoolValue b -> set_bool_option_value_gen locality key b
+let vernac_set_option ~atts key = function
+  | StringValue s -> set_string_option_value_gen atts.locality key s
+  | StringOptValue (Some s) -> set_string_option_value_gen atts.locality key s
+  | StringOptValue None -> unset_option_value_gen atts.locality key
+  | IntValue n -> set_int_option_value_gen atts.locality key n
+  | BoolValue b -> set_bool_option_value_gen atts.locality key b
 
-let vernac_set_append_option locality key s =
-  set_string_option_append_value_gen locality key s
+let vernac_set_append_option ~atts key s =
+  set_string_option_append_value_gen atts.locality key s
 
-let vernac_unset_option locality key =
-  unset_option_value_gen locality key
+let vernac_unset_option ~atts key =
+  unset_option_value_gen atts.locality key
 
 let vernac_add_option key lv =
   let f = function
@@ -1539,7 +1572,7 @@ let vernac_print_option key =
 
 let get_current_context_of_args = function
   | Some n -> Pfedit.get_goal_context n
-  | None -> get_current_context ()
+  | None -> Pfedit.get_current_context ()
 
 let query_command_selector ?loc = function
   | None -> None
@@ -1547,16 +1580,16 @@ let query_command_selector ?loc = function
   | _ -> user_err ?loc ~hdr:"query_command_selector"
       (str "Query commands only support the single numbered goal selector.")
 
-let vernac_check_may_eval ?loc redexp glopt rc =
-  let glopt = query_command_selector ?loc glopt in
+let vernac_check_may_eval ~atts redexp glopt rc =
+  let glopt = query_command_selector ?loc:atts.loc glopt in
   let (sigma, env) = get_current_context_of_args glopt in
   let sigma', c = interp_open_constr env sigma rc in
   let c = EConstr.Unsafe.to_constr c 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
-  let env = Environ.push_context uctx (Evarutil.nf_env_evar sigma' env) in
+  let uctx = Evd.universe_context_set sigma' in
+  let env = Environ.push_context_set uctx (Evarutil.nf_env_evar sigma' env) in
   let c = nf c in
   let j =
     if Evarutil.has_undefined_evars sigma' (EConstr.of_constr c) then
@@ -1569,10 +1602,10 @@ let vernac_check_may_eval ?loc redexp glopt rc =
     | None ->
         let evars_of_term c = Evarutil.undefined_evars_of_term sigma' c in
         let l = Evar.Set.union (evars_of_term j.Environ.uj_val) (evars_of_term j.Environ.uj_type) in
-        let j = { j with Environ.uj_type = Reductionops.nf_betaiota sigma' j.Environ.uj_type } in
-	Feedback.msg_notice (print_judgment env sigma' j ++
-                    pr_ne_evar_set (fnl () ++ str "where" ++ fnl ()) (mt ()) sigma' l ++
-                    Printer.pr_universe_ctx sigma uctx)
+        let j = { j with Environ.uj_type = Reductionops.nf_betaiota env sigma' j.Environ.uj_type } in
+        print_judgment env sigma' j ++
+        pr_ne_evar_set (fnl () ++ str "where" ++ fnl ()) (mt ()) sigma' l ++
+        Printer.pr_universe_ctx_set sigma uctx
     | Some r ->
         let (sigma',r_interp) = Hook.get f_interp_redexp env sigma' r in
 	let redfun env evm c =
@@ -1580,38 +1613,40 @@ let vernac_check_may_eval ?loc redexp glopt rc =
           let (_, c) = redfun env evm c in
           c
         in
-	Feedback.msg_notice (print_eval redfun env sigma' rc j)
+        print_eval redfun env sigma' rc j
 
-let vernac_declare_reduction locality s r =
-  let local = make_locality locality in
+let vernac_declare_reduction ~atts s r =
+  let local = make_locality atts.locality in
   declare_red_expr local s (snd (Hook.get f_interp_redexp (Global.env()) Evd.empty r))
 
   (* The same but avoiding the current goal context if any *)
 let vernac_global_check c =
   let env = Global.env() in
   let sigma = Evd.from_env env in
-  let c,ctx = interp_constr env sigma c in
+  let c,uctx = interp_constr env sigma c in
   let senv = Global.safe_env() in
-  let cstrs = snd (UState.context_set ctx) in
-  let senv = Safe_typing.add_constraints cstrs senv in
+  let uctx = UState.context_set uctx in
+  let senv = Safe_typing.push_context_set false uctx senv in
   let j = Safe_typing.typing senv c in
   let env = Safe_typing.env_of_safe_env senv in
-    Feedback.msg_notice (print_safe_judgment env sigma j)
+  print_safe_judgment env sigma j ++
+  pr_universe_ctx_set sigma uctx
 
 
 let get_nth_goal n =
   let pf = Proof_global.give_me_the_proof() in
-  let {Evd.it=gls ; sigma=sigma; } = Proof.V82.subgoals pf in
+  let gls,_,_,_,sigma = Proof.proof pf in
   let gl = {Evd.it=List.nth gls (n-1) ; sigma = sigma; } in
   gl
-  
+
 exception NoHyp
 (* Printing "About" information of a hypothesis of the current goal.
    We only print the type and a small statement to this comes from the
    goal. Precondition: there must be at least one current goal. *)
-let print_about_hyp_globs ?loc ref_or_by_not glopt =
+let print_about_hyp_globs ?loc ref_or_by_not udecl glopt =
   let open Context.Named.Declaration in
   try
+    (* FIXME error on non None udecl if we find the hyp. *)
     let glnumopt = query_command_selector ?loc glopt in
     let gl,id =
       match glnumopt,ref_or_by_not with
@@ -1628,35 +1663,41 @@ let print_about_hyp_globs ?loc ref_or_by_not glopt =
     let natureofid = match decl with
                      | LocalAssum _ -> "Hypothesis"
                      | LocalDef (_,bdy,_) ->"Constant (let in)" in
-    v 0 (pr_id id ++ str":" ++ pr_econstr (NamedDecl.get_type decl) ++ fnl() ++ fnl()
+    let sigma, env = Pfedit.get_current_context () in
+    v 0 (Id.print id ++ str":" ++ pr_econstr_env env sigma (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
-
-	       
-let vernac_print ?loc = let open Feedback in function
-  | PrintTables -> msg_notice (print_tables ())
-  | PrintFullContext-> msg_notice (print_full_context_typ ())
-  | PrintSectionContext qid -> msg_notice (print_sec_context_typ qid)
-  | PrintInspect n -> msg_notice (inspect n)
-  | PrintGrammar ent -> msg_notice (Metasyntax.pr_grammar ent)
-  | PrintLoadPath dir -> (* For compatibility ? *) msg_notice (print_loadpath dir)
-  | PrintModules -> msg_notice (print_modules ())
+    | NoHyp | Not_found ->
+    let sigma, env = Pfedit.get_current_context () in
+    print_about env sigma ref_or_by_not udecl
+
+let vernac_print ~atts env sigma =
+  let loc = atts.loc in
+  function
+  | PrintTables -> print_tables ()
+  | PrintFullContext-> print_full_context_typ env sigma
+  | PrintSectionContext qid -> print_sec_context_typ env sigma qid
+  | PrintInspect n -> inspect env sigma n
+  | PrintGrammar ent -> Metasyntax.pr_grammar ent
+  | PrintLoadPath dir -> (* For compatibility ? *) print_loadpath dir
+  | PrintModules -> print_modules ()
   | PrintModule qid -> print_module qid
   | PrintModuleType qid -> print_modtype qid
   | PrintNamespace ns -> print_namespace ns
-  | PrintMLLoadPath -> msg_notice (Mltop.print_ml_path ())
-  | PrintMLModules -> msg_notice (Mltop.print_ml_modules ())
-  | PrintDebugGC -> msg_notice (Mltop.print_gc ())
-  | PrintName qid -> dump_global qid; msg_notice (print_name qid)
-  | PrintGraph -> msg_notice (Prettyp.print_graph())
-  | PrintClasses -> msg_notice (Prettyp.print_classes())
-  | PrintTypeClasses -> msg_notice (Prettyp.print_typeclasses())
-  | PrintInstances c -> msg_notice (Prettyp.print_instances (smart_global c))
-  | PrintCoercions -> msg_notice (Prettyp.print_coercions())
+  | PrintMLLoadPath -> Mltop.print_ml_path ()
+  | PrintMLModules -> Mltop.print_ml_modules ()
+  | PrintDebugGC -> Mltop.print_gc ()
+  | PrintName (qid,udecl) ->
+    dump_global qid;
+    print_name env sigma qid udecl
+  | PrintGraph -> Prettyp.print_graph env sigma
+  | PrintClasses -> Prettyp.print_classes()
+  | PrintTypeClasses -> Prettyp.print_typeclasses()
+  | PrintInstances c -> Prettyp.print_instances (smart_global c)
+  | PrintCoercions -> Prettyp.print_coercions env sigma
   | PrintCoercionPaths (cls,clt) ->
-      msg_notice (Prettyp.print_path_between (cl_of_qualid cls) (cl_of_qualid clt))
-  | PrintCanonicalConversions -> msg_notice (Prettyp.print_canonical_projections ())
+    Prettyp.print_path_between env sigma (cl_of_qualid cls) (cl_of_qualid clt)
+  | PrintCanonicalConversions -> Prettyp.print_canonical_projections env sigma
   | PrintUniverses (b, dst) ->
      let univ = Global.universes () in
      let univ = if b then UGraph.sort_universes univ else univ in
@@ -1665,23 +1706,24 @@ let vernac_print ?loc = let open Feedback in function
        else str"There may remain asynchronous universe constraints"
      in
      begin match dst with
-     | None -> msg_notice (UGraph.pr_universes Universes.pr_with_global_universes univ ++ pr_remaining)
+     | None -> UGraph.pr_universes Universes.pr_with_global_universes univ ++ pr_remaining
      | Some s -> dump_universes_gen univ s
      end
-  | PrintHint r -> msg_notice (Hints.pr_hint_ref (smart_global r))
-  | PrintHintGoal -> msg_notice (Hints.pr_applicable_hint ())
-  | PrintHintDbName s -> msg_notice (Hints.pr_hint_db_by_name s)
-  | PrintHintDb -> msg_notice (Hints.pr_searchtable ())
+  | PrintHint r -> Hints.pr_hint_ref env sigma (smart_global r)
+  | PrintHintGoal -> Hints.pr_applicable_hint ()
+  | PrintHintDbName s -> Hints.pr_hint_db_by_name env sigma s
+  | PrintHintDb -> Hints.pr_searchtable env sigma
   | PrintScopes ->
-      msg_notice (Notation.pr_scopes (Constrextern.without_symbols pr_lglob_constr))
+    Notation.pr_scopes (Constrextern.without_symbols (pr_lglob_constr_env env))
   | PrintScope s ->
-      msg_notice (Notation.pr_scope (Constrextern.without_symbols pr_lglob_constr) s)
+    Notation.pr_scope (Constrextern.without_symbols (pr_lglob_constr_env env)) s
   | PrintVisibility s ->
-      msg_notice (Notation.pr_visibility (Constrextern.without_symbols pr_lglob_constr) s)
-  | PrintAbout (ref_or_by_not,glnumopt) ->
-     msg_notice (print_about_hyp_globs ?loc ref_or_by_not glnumopt)
+    Notation.pr_visibility (Constrextern.without_symbols (pr_lglob_constr_env env)) s
+  | PrintAbout (ref_or_by_not,udecl,glnumopt) ->
+    print_about_hyp_globs ?loc ref_or_by_not udecl glnumopt
   | PrintImplicit qid ->
-    dump_global qid; msg_notice (print_impargs qid)
+    dump_global qid;
+    print_impargs qid
   | PrintAssumptions (o,t,r) ->
       (* Prints all the axioms and section variables used by a term *)
       let gr = smart_global r in
@@ -1689,7 +1731,7 @@ let vernac_print ?loc = let open Feedback in function
       let st = Conv_oracle.get_transp_state (Environ.oracle (Global.env())) in
       let nassums =
 	Assumptions.assumptions st ~add_opaque:o ~add_transparent:t gr cstr in
-      msg_notice (Printer.pr_assumptionset (Global.env ()) nassums)
+      Printer.pr_assumptionset env sigma nassums
   | PrintStrategy r -> print_strategy r
 
 let global_module r =
@@ -1743,8 +1785,8 @@ let _ =
       optread  = (fun () -> !search_output_name_only);
       optwrite = (:=) search_output_name_only }
 
-let vernac_search ?loc s gopt r =
-  let gopt = query_command_selector ?loc gopt in
+let vernac_search ~atts s gopt r =
+  let gopt = query_command_selector ?loc:atts.loc gopt in
   let r = interp_search_restriction r in
   let env,gopt =
     match gopt with | None ->
@@ -1775,23 +1817,23 @@ let vernac_search ?loc s gopt r =
   | SearchAbout sl ->
       (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)
-  | LocateTerm (AN qid) -> msg_notice (print_located_term qid)
+let vernac_locate = function
+  | LocateAny (AN qid)  -> print_located_qualid qid
+  | LocateTerm (AN qid) -> print_located_term qid
   | LocateAny (ByNotation (_, (ntn, sc))) (** TODO : handle Ltac notations *)
   | LocateTerm (ByNotation (_, (ntn, sc))) ->
-      msg_notice
-        (Notation.locate_notation
-          (Constrextern.without_symbols pr_lglob_constr) ntn sc)
+    let _, env = Pfedit.get_current_context () in
+    Notation.locate_notation
+      (Constrextern.without_symbols (pr_lglob_constr_env env)) ntn sc
   | LocateLibrary qid -> print_located_library qid
-  | LocateModule qid -> msg_notice (print_located_module qid)
-  | LocateTactic qid -> msg_notice (print_located_tactic qid)
-  | LocateFile f -> msg_notice (locate_file f)
+  | LocateModule qid -> print_located_module qid
+  | LocateOther (s, qid) -> print_located_other s qid
+  | LocateFile f -> locate_file f
 
 let vernac_register id r =
  if Proof_global.there_are_pending_proofs () then
     user_err Pp.(str "Cannot register a primitive while in proof editing mode.");
-  let kn = Constrintern.global_reference (snd id) in
+  let kn = Constrintern.global_reference id.v in
   if not (isConstRef kn) then
     user_err Pp.(str "Register inline: a constant is expected");
   match r with
@@ -1818,16 +1860,13 @@ let vernac_unfocus () =
 let vernac_unfocused () =
   let p = Proof_global.give_me_the_proof () in
   if Proof.unfocused p then
-    Feedback.msg_notice (str"The proof is indeed fully unfocused.")
+    str"The proof is indeed fully unfocused."
   else
     user_err Pp.(str "The proof is not fully unfocused.")
 
 
-(* BeginSubproof / EndSubproof. 
-    BeginSubproof (vernac_subproof) focuses on the first goal, or the goal
-    given as argument.
-    EndSubproof (vernac_end_subproof) unfocuses from a BeginSubproof, provided
-    that the proof of the goal has been completed.
+(* "{" focuses on the first goal, "n: {" focuses on the n-th goal
+    "}" unfocuses, provided that the proof of the goal has been completed.
 *)
 let subproof_kind = Proof.new_focus_kind ()
 let subproof_cond = Proof.done_cond subproof_kind
@@ -1836,7 +1875,9 @@ let vernac_subproof gln =
   Proof_global.simple_with_current_proof (fun _ p ->
     match gln with
     | None -> Proof.focus subproof_cond () 1 p
-    | Some n -> Proof.focus subproof_cond () n p)
+    | Some (SelectNth n) -> Proof.focus subproof_cond () n p
+    | _ -> user_err ~hdr:"bracket_selector"
+             (str "Brackets only support the single numbered goal selector."))
 
 let vernac_end_subproof () =
   Proof_global.simple_with_current_proof (fun _ p ->
@@ -1846,21 +1887,20 @@ let vernac_bullet (bullet : Proof_bullet.t) =
   Proof_global.simple_with_current_proof (fun _ p ->
     Proof_bullet.put p bullet)
 
-let vernac_show = let open Feedback in function
+let vernac_show = function
   | ShowScript -> assert false  (* Only the stm knows the script *)
   | ShowGoal goalref ->
-    let info = match goalref with
-      | OpenSubgoals -> pr_open_subgoals ()
-      | NthGoal n -> pr_nth_open_subgoal n
-      | GoalId id -> pr_goal_by_id id
-      | GoalUid id -> pr_goal_by_uid id
-    in
-    msg_notice info
+    let proof = Proof_global.give_me_the_proof () in
+    begin match goalref with
+    | OpenSubgoals -> pr_open_subgoals ~proof
+    | NthGoal n -> pr_nth_open_subgoal ~proof n
+    | GoalId id -> pr_goal_by_id ~proof id
+    end
   | ShowProof -> show_proof ()
   | ShowExistentials -> show_top_evars ()
   | ShowUniverses -> show_universes ()
   | ShowProofNames ->
-      msg_notice (pr_sequence pr_id (Proof_global.get_all_proof_names()))
+    pr_sequence Id.print (Proof_global.get_all_proof_names())
   | ShowIntros all -> show_intro all
   | ShowMatch id -> show_match id
 
@@ -1875,8 +1915,7 @@ let vernac_check_guard () =
       (str "The condition holds up to here")
     with UserError(_,s) ->
       (str ("Condition violated: ") ++s)
-  in
-  Feedback.msg_notice message
+  in message
 
 exception End_of_input
 
@@ -1902,7 +1941,7 @@ 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 ~file:longfname (Stream.of_channel in_chan) in
+    Pcoq.Gram.parsable ~file:(Loc.InFile longfname) (Stream.of_channel in_chan) in
   try while true do interp (snd (parse_sentence input)) done
   with End_of_input -> ()
 
@@ -1910,21 +1949,13 @@ let vernac_load interp fname =
  * is the outdated/deprecated "Local" attribute of some vernacular commands
  * still parsed as the obsolete_locality grammar entry for retrocompatibility.
  * loc is the Loc.t of the vernacular command being interpreted. *)
-let interp ?proof ?loc locality poly c =
-  vernac_pperr_endline (fun () -> str "interpreting: " ++ Ppvernac.pr_vernac c);
+let interp ?proof ~atts ~st c =
+  let open Vernacinterp in
+  vernac_pperr_endline (fun () -> str "interpreting: " ++ Ppvernac.pr_vernac_expr c);
   match c with
-  (* 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")
@@ -1944,37 +1975,34 @@ let interp ?proof ?loc locality poly c =
   (* 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
+  | VernacSyntaxExtension (infix, sl) ->
+      vernac_syntax_extension atts infix sl
   | VernacDelimiters (sc,lr) -> vernac_delimiters sc lr
   | VernacBindScope (sc,rl) -> vernac_bind_scope sc rl
-  | VernacOpenCloseScope (local, s) -> vernac_open_close_scope locality local s
-  | VernacArgumentsScope (qid,scl) -> vernac_arguments_scope locality qid scl
-  | VernacInfix (local,mv,qid,sc) -> vernac_infix locality local mv qid sc
-  | VernacNotation (local,c,infpl,sc) ->
-      vernac_notation locality local c infpl sc
+  | VernacOpenCloseScope (b, s) -> vernac_open_close_scope ~atts (b,s)
+  | VernacArgumentsScope (qid,scl) -> vernac_arguments_scope ~atts qid scl
+  | VernacInfix (mv,qid,sc) -> vernac_infix ~atts mv qid sc
+  | VernacNotation (c,infpl,sc) ->
+      vernac_notation ~atts c infpl sc
   | VernacNotationAddFormat(n,k,v) ->
       Metasyntax.add_notation_extra_printing_rule n k v
 
   (* Gallina *)
-  | VernacDefinition (k,lid,d) -> vernac_definition locality poly k lid d
-  | VernacStartTheoremProof (k,l) -> vernac_start_proof locality poly k l
+  | VernacDefinition ((discharge,kind),lid,d) ->
+      vernac_definition ~atts discharge kind lid d
+  | VernacStartTheoremProof (k,l) -> vernac_start_proof ~atts k l
   | VernacEndProof e -> vernac_end_proof ?proof e
   | VernacExactProof c -> vernac_exact_proof c
-  | VernacAssumption (stre,nl,l) -> vernac_assumption locality poly stre l nl
-  | VernacInductive (cum, priv,finite,l) -> vernac_inductive cum poly priv finite l
-  | VernacFixpoint (local, l) -> vernac_fixpoint locality poly local l
-  | VernacCoFixpoint (local, l) -> vernac_cofixpoint locality poly local l
+  | VernacAssumption ((discharge,kind),nl,l) ->
+      vernac_assumption ~atts discharge kind l nl
+  | VernacInductive (cum, priv,finite,l) -> vernac_inductive ~atts cum priv finite l
+  | VernacFixpoint (discharge, l) -> vernac_fixpoint ~atts discharge l
+  | VernacCoFixpoint (discharge, l) -> vernac_cofixpoint ~atts discharge l
   | VernacScheme l -> vernac_scheme l
   | VernacCombinedScheme (id, l) -> vernac_combined_scheme id l
-  | VernacUniverse l -> vernac_universe loc poly l
-  | VernacConstraint l -> vernac_constraint loc poly l
+  | VernacUniverse l -> vernac_universe ~atts l
+  | VernacConstraint l -> vernac_constraint ~atts l
 
   (* Modules *)
   | VernacDeclareModule (export,lid,bl,mtyo) ->
@@ -1995,15 +2023,15 @@ let interp ?proof ?loc locality poly c =
   | VernacRequire (from, export, qidl) -> vernac_require from export qidl
   | VernacImport (export,qidl) -> vernac_import export qidl
   | VernacCanonical qid -> vernac_canonical qid
-  | VernacCoercion (local,r,s,t) -> vernac_coercion locality poly local r s t
-  | VernacIdentityCoercion (local,(_,id),s,t) ->
-      vernac_identity_coercion locality poly local id s t
+  | VernacCoercion (r,s,t) -> vernac_coercion ~atts r s t
+  | VernacIdentityCoercion ({v=id},s,t) ->
+      vernac_identity_coercion ~atts id s t
 
   (* Type classes *)
   | VernacInstance (abst, sup, inst, props, info) ->
-      vernac_instance abst locality poly sup inst props info
-  | VernacContext sup -> vernac_context poly sup
-  | VernacDeclareInstances insts -> vernac_declare_instances locality insts
+      vernac_instance ~atts abst sup inst props info
+  | VernacContext sup -> vernac_context ~atts sup
+  | VernacDeclareInstances insts -> vernac_declare_instances ~atts insts
   | VernacDeclareClass id -> vernac_declare_class id
 
   (* Solving *)
@@ -2013,7 +2041,7 @@ let interp ?proof ?loc locality poly c =
   | VernacAddLoadPath (isrec,s,alias) -> vernac_add_loadpath isrec s alias
   | VernacRemoveLoadPath s -> vernac_remove_loadpath s
   | VernacAddMLPath (isrec,s) -> vernac_add_ml_path isrec s
-  | VernacDeclareMLModule l -> vernac_declare_ml_module locality l
+  | VernacDeclareMLModule l -> vernac_declare_ml_module ~atts l
   | VernacChdir s -> vernac_chdir s
 
   (* State management *)
@@ -2021,61 +2049,67 @@ let interp ?proof ?loc locality poly c =
   | VernacRestoreState s -> vernac_restore_state s
 
   (* Commands *)
-  | VernacCreateHintDb (dbname,b) -> vernac_create_hintdb locality dbname b
-  | VernacRemoveHints (dbnames,ids) -> vernac_remove_hints locality dbnames ids
-  | VernacHints (local,dbnames,hints) ->
-      vernac_hints locality poly local dbnames hints
-  | VernacSyntacticDefinition (id,c,local,b) ->
-      vernac_syntactic_definition locality  id c local b
+  | VernacCreateHintDb (dbname,b) -> vernac_create_hintdb ~atts dbname b
+  | VernacRemoveHints (dbnames,ids) -> vernac_remove_hints ~atts dbnames ids
+  | VernacHints (dbnames,hints) ->
+      vernac_hints ~atts dbnames hints
+  | VernacSyntacticDefinition (id,c,b) ->
+      vernac_syntactic_definition ~atts id c b
   | VernacDeclareImplicits (qid,l) ->
-      vernac_declare_implicits locality qid l
+      vernac_declare_implicits ~atts qid l
   | VernacArguments (qid, args, more_implicits, nargs, flags) ->
-      vernac_arguments locality qid args more_implicits nargs flags
+      vernac_arguments ~atts 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
+  | VernacGeneralizable gen -> vernac_generalizable ~atts gen
+  | VernacSetOpacity qidl -> vernac_set_opacity ~atts qidl
+  | VernacSetStrategy l -> vernac_set_strategy ~atts l
+  | VernacSetOption (key,v) -> vernac_set_option ~atts key v
+  | VernacSetAppendOption (key,v) -> vernac_set_append_option ~atts key v
+  | VernacUnsetOption key -> vernac_unset_option ~atts key
   | VernacRemoveOption (key,v) -> vernac_remove_option key v
   | VernacAddOption (key,v) -> vernac_add_option key v
   | VernacMemOption (key,v) -> vernac_mem_option key v
   | VernacPrintOption key -> vernac_print_option key
-  | VernacCheckMayEval (r,g,c) -> vernac_check_may_eval ?loc r g c
-  | VernacDeclareReduction (s,r) -> vernac_declare_reduction locality s r
-  | VernacGlobalCheck c -> vernac_global_check c
-  | VernacPrint p -> vernac_print ?loc p
-  | VernacSearch (s,g,r) -> vernac_search ?loc s g r
-  | VernacLocate l -> vernac_locate l
+  | VernacCheckMayEval (r,g,c) ->
+    Feedback.msg_notice @@ vernac_check_may_eval ~atts r g c
+  | VernacDeclareReduction (s,r) -> vernac_declare_reduction ~atts s r
+  | VernacGlobalCheck c ->
+    Feedback.msg_notice @@ vernac_global_check c
+  | VernacPrint p ->
+    let sigma, env = Pfedit.get_current_context () in
+    Feedback.msg_notice @@ vernac_print ~atts env sigma p
+  | VernacSearch (s,g,r) -> vernac_search ~atts s g r
+  | VernacLocate l ->
+    Feedback.msg_notice @@ vernac_locate l
   | VernacRegister (id, r) -> vernac_register id r
-  | VernacComments l -> if_verbose Feedback.msg_info (str "Comments ok\n")
+  | VernacComments l -> Flags.if_verbose Feedback.msg_info (str "Comments ok\n")
 
   (* Proof management *)
-  | VernacGoal t -> vernac_start_proof locality poly Theorem [None,([],t)]
   | VernacFocus n -> vernac_focus n
   | VernacUnfocus -> vernac_unfocus ()
-  | VernacUnfocused -> vernac_unfocused ()
+  | VernacUnfocused ->
+    Feedback.msg_notice @@ vernac_unfocused ()
   | VernacBullet b -> vernac_bullet b
   | VernacSubproof n -> vernac_subproof n
   | VernacEndSubproof -> vernac_end_subproof ()
-  | VernacShow s -> vernac_show s
-  | VernacCheckGuard -> vernac_check_guard ()
-  | VernacProof (None, None) ->
-      Aux_file.record_in_aux_at ?loc "VernacProof" "tac:no using:no"
-  | VernacProof (Some tac, None) ->
-      Aux_file.record_in_aux_at ?loc "VernacProof" "tac:yes using:no";
-      vernac_set_end_tac tac
-  | VernacProof (None, Some l) ->
-      Aux_file.record_in_aux_at ?loc "VernacProof" "tac:no using:yes";
-      vernac_set_used_variables l
-  | VernacProof (Some tac, Some l) -> 
-      Aux_file.record_in_aux_at ?loc "VernacProof" "tac:yes using:yes";
-      vernac_set_end_tac tac; vernac_set_used_variables l
+  | VernacShow s ->
+    Feedback.msg_notice @@ vernac_show s
+  | VernacCheckGuard ->
+    Feedback.msg_notice @@ vernac_check_guard ()
+  | VernacProof (tac, using) ->
+    let using = Option.append using (Proof_using.get_default_proof_using ()) in
+    let tacs = if Option.is_empty tac then "tac:no" else "tac:yes" in
+    let usings = if Option.is_empty using then "using:no" else "using:yes" in
+    Aux_file.record_in_aux_at ?loc:atts.loc "VernacProof" (tacs^" "^usings);
+    Option.iter vernac_set_end_tac tac;
+    Option.iter vernac_set_used_variables using
   | VernacProofMode mn -> Proof_global.set_proof_mode mn [@ocaml.warning "-3"]
 
   (* Extensions *)
-  | VernacExtend (opn,args) -> Vernacinterp.call ?locality (opn,args)
+  | VernacExtend (opn,args) ->
+    (* XXX: Here we are returning the state! :) *)
+    let _st : Vernacstate.t = Vernacinterp.call ~atts opn args ~st in
+    ()
 
 (* Vernaculars that take a locality flag *)
 let check_vernac_supports_locality c l =
@@ -2106,7 +2140,7 @@ let check_vernac_supports_polymorphism c p =
   | None, _ -> ()
   | Some _, (
       VernacDefinition _ | VernacFixpoint _ | VernacCoFixpoint _
-    | VernacAssumption _ | VernacInductive _ 
+    | VernacAssumption _ | VernacInductive _
     | VernacStartTheoremProof _
     | VernacCoercion _ | VernacIdentityCoercion _
     | VernacInstance _ | VernacDeclareInstances _
@@ -2114,10 +2148,6 @@ let check_vernac_supports_polymorphism c p =
     | VernacExtend _ | VernacUniverse _ | VernacConstraint _) -> ()
   | Some _, _ -> user_err Pp.(str "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, controlled by option "Set Default Timeout n".
     Use "Unset Default Timeout" to deactivate it (or set it to 0). *)
 
@@ -2140,7 +2170,7 @@ let vernac_timeout f =
   match !current_timeout, !default_timeout with
     | Some n, _ | None, Some n ->
       let f () = f (); current_timeout := None in
-      Control.timeout n f Timeout
+      Control.timeout n f () Timeout
     | None, None -> f ()
 
 let restore_timeout () = current_timeout := None
@@ -2153,73 +2183,95 @@ let locate_if_not_already ?loc (e, info) =
 exception HasNotFailed
 exception HasFailed of Pp.t
 
-let with_fail b f =
-  if not b then f ()
+(* XXX STATE: this type hints that restoring the state should be the
+   caller's responsibility *)
+let with_fail st b f =
+  if not b
+  then f ()
   else begin try
       (* If the command actually works, ignore its effects on the state.
        * Note that error has to be printed in the right state, hence
        * within the purified function *)
-      Future.purify
-        (fun v ->
-           try f v; raise HasNotFailed
-           with
-           | HasNotFailed as e -> raise e
-           | e ->
-              let e = CErrors.push e in
-              raise (HasFailed (CErrors.iprint
-                (ExplainErr.process_vernac_interp_error ~allow_uncaught:false e))))
-        ()
+      try f (); raise HasNotFailed
+      with
+      | HasNotFailed as e -> raise e
+      | e ->
+        let e = CErrors.push e in
+        raise (HasFailed (CErrors.iprint
+                            (ExplainErr.process_vernac_interp_error ~allow_uncaught:false e)))
     with e when CErrors.noncritical e ->
+      (* Restore the previous state XXX Careful here with the cache! *)
+      Vernacstate.invalidate_cache ();
+      Vernacstate.unfreeze_interp_state st;
       let (e, _) = CErrors.push e in
       match e with
       | HasNotFailed ->
           user_err ~hdr:"Fail" (str "The command has not failed!")
       | HasFailed msg ->
-          if not !Flags.quiet || !test_mode || !ide_slave then Feedback.msg_info
+          if not !Flags.quiet || !Flags.test_mode || !Flags.ide_slave then Feedback.msg_info
             (str "The command has indeed failed with message:" ++ fnl () ++ msg)
       | _ -> assert false
   end
 
-let interp ?(verbosely=true) ?proof (loc,c) =
+let interp ?(verbosely=true) ?proof ~st (loc,c) =
+  let orig_univ_poly = Flags.is_universe_polymorphism () in
   let orig_program_mode = Flags.is_program_mode () in
-  let rec aux ?locality ?polymorphism isprogcmd = function
-
-    (* This assert case will be removed when fake_ide can understand
-       completion feedback *)
-    | VernacStm _ -> assert false (* Done by Stm *)
-
-    | VernacProgram c when not isprogcmd -> aux ?locality ?polymorphism true c
-    | VernacProgram _ -> user_err Pp.(str "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) -> user_err Pp.(str "Polymorphism specified twice")
-    | VernacLocal _ -> user_err Pp.(str "Locality specified twice")
-    | VernacFail v ->
-        with_fail true (fun () -> aux ?locality ?polymorphism isprogcmd v)
-    | VernacTimeout (n,v) ->
-        current_timeout := Some n;
-        aux ?locality ?polymorphism isprogcmd v
-    | VernacRedirect (s, (_,v)) ->
-         Topfmt.with_output_to_file s (aux ?locality ?polymorphism isprogcmd) v
-    | VernacTime (_,v) ->
-        System.with_time !Flags.time
-          (aux ?locality ?polymorphism isprogcmd) v;
-    | VernacLoad (_,fname) -> vernac_load (aux false) fname
-    | c -> 
-        check_vernac_supports_locality c locality;
-        check_vernac_supports_polymorphism c polymorphism;
-	let poly = enforce_polymorphism polymorphism in
-        Obligations.set_program_mode isprogcmd;
-        try
-          vernac_timeout begin fun () ->
+  let flags f atts =
+    List.fold_left
+      (fun (polymorphism, atts) f ->
+         match f with
+         | VernacProgram when not atts.program ->
+           (polymorphism, { atts with program = true })
+         | VernacProgram ->
+           user_err Pp.(str "Program mode specified twice")
+         | VernacPolymorphic b when polymorphism = None ->
+           (Some b, atts)
+         | VernacPolymorphic _ ->
+           user_err Pp.(str "Polymorphism specified twice")
+         | VernacLocal b when Option.is_empty atts.locality ->
+           (polymorphism, { atts with locality = Some b })
+         | VernacLocal _ ->
+           user_err Pp.(str "Locality specified twice")
+      )
+      (None, atts)
+      f
+  in
+  let rec control = function
+  | VernacExpr (f, v) ->
+    let (polymorphism, atts) = flags f { loc; locality = None; polymorphic = false; program = orig_program_mode; } in
+    aux ~polymorphism ~atts v
+  | VernacFail v -> with_fail st true (fun () -> control v)
+  | VernacTimeout (n,v) ->
+    current_timeout := Some n;
+    control v
+  | VernacRedirect (s, {v}) ->
+    Topfmt.with_output_to_file s control v
+  | VernacTime (batch, {v}) ->
+    System.with_time ~batch control v;
+
+  and aux ~polymorphism ~atts : _ -> unit =
+    function
+
+    | VernacLoad (_,fname) -> vernac_load control fname
+
+    | c ->
+      check_vernac_supports_locality c atts.locality;
+      check_vernac_supports_polymorphism c polymorphism;
+      let polymorphic = Option.default (Flags.is_universe_polymorphism ()) polymorphism in
+      Flags.make_universe_polymorphism polymorphic;
+      Obligations.set_program_mode atts.program;
+      try
+        vernac_timeout begin fun () ->
+          let atts = { atts with polymorphic } in
           if verbosely
-            then Flags.verbosely (interp ?proof ?loc locality poly) c
-            else Flags.silently  (interp ?proof ?loc locality poly) c;
-          if orig_program_mode || not !Flags.program_mode || isprogcmd then
+          then Flags.verbosely (interp ?proof ~atts ~st) c
+          else Flags.silently  (interp ?proof ~atts ~st) c;
+          (* If the command is `(Un)Set Program Mode` or `(Un)Set Universe Polymorphism`,
+             we should not restore the previous state of the flag... *)
+          if orig_program_mode || not !Flags.program_mode || atts.program then
             Flags.program_mode := orig_program_mode;
-	  ignore (Flags.use_polymorphic_flag ())
+          if (Flags.is_universe_polymorphism() = polymorphic) then
+            Flags.make_universe_polymorphism orig_univ_poly;
           end
         with
         | reraise when
@@ -2230,9 +2282,21 @@ let interp ?(verbosely=true) ?proof (loc,c) =
             let e = CErrors.push reraise in
             let e = locate_if_not_already ?loc e in
             let () = restore_timeout () in
+            Flags.make_universe_polymorphism orig_univ_poly;
             Flags.program_mode := orig_program_mode;
-	    ignore (Flags.use_polymorphic_flag ());
             iraise e
   in
-    if verbosely then Flags.verbosely (aux false) c
-    else aux false c
+  if verbosely
+  then Flags.verbosely control c
+  else control  c
+
+(* Be careful with the cache here in case of an exception. *)
+let interp ?verbosely ?proof ~st cmd =
+  Vernacstate.unfreeze_interp_state st;
+  try
+    interp ?verbosely ?proof ~st cmd;
+    Vernacstate.freeze_interp_state `No
+  with exn ->
+    let exn = CErrors.push exn in
+    Vernacstate.invalidate_cache ();
+    iraise exn
diff --git a/vernac/vernacentries.mli b/vernac/vernacentries.mli
index a09011d24..e99a62fe6 100644
--- a/vernac/vernacentries.mli
+++ b/vernac/vernacentries.mli
@@ -18,7 +18,7 @@ val vernac_require :
 val interp :
   ?verbosely:bool ->
   ?proof:Proof_global.closed_proof ->
-    Vernacexpr.vernac_expr Loc.located -> unit
+  st:Vernacstate.t -> Vernacexpr.vernac_control Loc.located -> Vernacstate.t
 
 (** Prepare a "match" template for a given inductive type.
     For each branch of the match, we list the constructor name
@@ -28,9 +28,13 @@ val interp :
 
 val make_cases : string -> string list list
 
-val with_fail : bool -> (unit -> unit) -> unit
+(* XXX STATE: this type hints that restoring the state should be the
+   caller's responsibility *)
+val with_fail : Vernacstate.t -> bool -> (unit -> unit) -> unit
 
 val command_focus : unit Proof.focus_kind
 
 val interp_redexp_hook : (Environ.env -> Evd.evar_map -> Genredexpr.raw_red_expr ->
   Evd.evar_map * Redexpr.red_expr) Hook.t
+
+val universe_polymorphism_option_name : string list
diff --git a/vernac/vernacinterp.ml b/vernac/vernacinterp.ml
index 2d9c0fa36..c40ca27db 100644
--- a/vernac/vernacinterp.ml
+++ b/vernac/vernacinterp.ml
@@ -11,12 +11,22 @@ open Pp
 open CErrors
 
 type deprecation = bool
-type vernac_command = Genarg.raw_generic_argument list -> unit -> unit
+
+type atts = {
+  loc : Loc.t option;
+  locality : bool option;
+  polymorphic : bool;
+  program : bool;
+}
+
+type 'a vernac_command = 'a -> atts:atts -> st:Vernacstate.t -> Vernacstate.t
+
+type plugin_args = Genarg.raw_generic_argument list
 
 (* Table of vernac entries *)
 let vernac_tab =
-  (Hashtbl.create 51 :
-    (Vernacexpr.extend_name, deprecation * vernac_command) Hashtbl.t)
+  (Hashtbl.create 211 :
+    (Vernacexpr.extend_name, deprecation * plugin_args vernac_command) Hashtbl.t)
 
 let vinterp_add depr s f =
   try
@@ -49,8 +59,8 @@ let warn_deprecated_command =
 
 (* Interpretation of a vernac command *)
 
-let call ?locality (opn,converted_args) =
-  let loc = ref "Looking up command" in
+let call opn converted_args ~atts ~st =
+  let phase = ref "Looking up command" in
   try
     let depr, callback = vinterp_map opn in
     let () = if depr then
@@ -62,16 +72,14 @@ let call ?locality (opn,converted_args) =
       let pr = pr_sequence pr_gram rules in
       warn_deprecated_command pr;
     in
-    loc:= "Checking arguments";
+    phase := "Checking arguments";
     let hunk = callback converted_args in
-    loc:= "Executing command";
-    Locality.LocalityFixme.set locality;
-    hunk();
-    Locality.LocalityFixme.assert_consumed()
+    phase := "Executing command";
+    hunk ~atts ~st
   with
     | Drop -> raise Drop
     | reraise ->
         let reraise = CErrors.push reraise in
         if !Flags.debug then
-	  Feedback.msg_debug (str"Vernac Interpreter " ++ str !loc);
+	  Feedback.msg_debug (str"Vernac Interpreter " ++ str !phase);
         iraise reraise
diff --git a/vernac/vernacinterp.mli b/vernac/vernacinterp.mli
index f58d07086..c5e610f89 100644
--- a/vernac/vernacinterp.mli
+++ b/vernac/vernacinterp.mli
@@ -9,12 +9,20 @@
 (** Interpretation of extended vernac phrases. *)
 
 type deprecation = bool
-type vernac_command = Genarg.raw_generic_argument list -> unit -> unit
 
-val vinterp_add : deprecation -> Vernacexpr.extend_name ->
-  vernac_command -> unit
-val overwriting_vinterp_add :
-  Vernacexpr.extend_name -> vernac_command -> unit
+type atts = {
+  loc : Loc.t option;
+  locality : bool option;
+  polymorphic : bool;
+  program : bool;
+}
+
+type 'a vernac_command = 'a -> atts:atts -> st:Vernacstate.t -> Vernacstate.t
+
+type plugin_args = Genarg.raw_generic_argument list
 
 val vinterp_init : unit -> unit
-val call : ?locality:bool -> Vernacexpr.extend_name * Genarg.raw_generic_argument list -> unit
+val vinterp_add : deprecation -> Vernacexpr.extend_name -> plugin_args vernac_command -> unit
+val overwriting_vinterp_add : Vernacexpr.extend_name -> plugin_args vernac_command -> unit
+
+val call : Vernacexpr.extend_name -> plugin_args -> atts:atts -> st:Vernacstate.t -> Vernacstate.t
diff --git a/vernac/vernacprop.ml b/vernac/vernacprop.ml
index fc11bcf4a..172a20b7a 100644
--- a/vernac/vernacprop.ml
+++ b/vernac/vernacprop.ml
@@ -11,43 +11,48 @@
 
 open Vernacexpr
 
+let rec under_control = function
+  | VernacExpr (_, c) -> c
+  | VernacRedirect (_,{CAst.v=c})
+  | VernacTime (_,{CAst.v=c})
+  | VernacFail c
+  | VernacTimeout (_,c) -> under_control c
+
+let rec has_Fail = function
+  | VernacExpr _ -> false
+  | VernacRedirect (_,{CAst.v=c})
+  | VernacTime (_,{CAst.v=c})
+  | VernacTimeout (_,c) -> has_Fail c
+  | VernacFail _ -> true
+
 (* Navigation commands are allowed in a coqtop session but not in a .v file *)
-let rec is_navigation_vernac = function
+let is_navigation_vernac_expr = function
   | VernacResetInitial
   | VernacResetName _
   | VernacBacktrack _
   | VernacBackTo _
-  | VernacBack _
-  | VernacStm _ -> true
-  | VernacRedirect (_, (_,c))
-  | VernacTime (_,c) ->
-      is_navigation_vernac c (* Time Back* is harmless *)
-  | c -> is_deep_navigation_vernac c
-
-and is_deep_navigation_vernac = function
-  | VernacTimeout (_,c) | VernacFail c -> is_navigation_vernac c
+  | VernacBack _ -> true
   | _ -> false
 
+let is_navigation_vernac c =
+  is_navigation_vernac_expr (under_control c)
+
+let rec is_deep_navigation_vernac = function
+  | VernacTime (_,{CAst.v=c}) -> is_deep_navigation_vernac c
+  | VernacRedirect (_, {CAst.v=c})
+  | VernacTimeout (_,c) | VernacFail c -> is_navigation_vernac c
+  | VernacExpr _ -> false
+
 (* NB: Reset is now allowed again as asked by A. Chlipala *)
 let is_reset = function
-  | VernacResetInitial | VernacResetName _ -> true
+  | VernacExpr ( _, VernacResetInitial)
+  | VernacExpr (_, VernacResetName _) -> true
   | _ -> false
 
-let is_debug cmd = match cmd with
+let is_debug cmd = match under_control cmd with
   | VernacSetOption (["Ltac";"Debug"], _) -> true
   | _ -> false
 
-let is_query cmd = match cmd with
-  | VernacChdir None
-  | VernacMemOption _
-  | VernacPrintOption _
-  | VernacCheckMayEval _
-  | VernacGlobalCheck _
-  | VernacPrint _
-  | VernacSearch _
-  | VernacLocate _ -> true
-  | _ -> false
-
-let is_undo cmd = match cmd with
+let is_undo cmd = match under_control cmd with
   | VernacUndo _ | VernacUndoTo _ -> true
   | _ -> false
diff --git a/vernac/vernacprop.mli b/vernac/vernacprop.mli
index fbdba6bac..df739f96a 100644
--- a/vernac/vernacprop.mli
+++ b/vernac/vernacprop.mli
@@ -11,9 +11,16 @@
 
 open Vernacexpr
 
-val is_navigation_vernac : vernac_expr -> bool
-val is_deep_navigation_vernac : vernac_expr -> bool
-val is_reset : vernac_expr -> bool
-val is_query : vernac_expr -> bool
-val is_debug : vernac_expr -> bool
-val is_undo : vernac_expr -> bool
+(* Return the vernacular command below control (Time, Timeout, Redirect, Fail).
+   Beware that Fail can change many properties of the underlying command, since
+   a success of Fail means the command was backtracked over. *)
+val under_control : vernac_control -> vernac_expr
+
+val has_Fail : vernac_control -> bool
+
+val is_navigation_vernac : vernac_control -> bool
+val is_deep_navigation_vernac : vernac_control -> bool
+val is_reset : vernac_control -> bool
+val is_debug : vernac_control -> bool
+val is_undo : vernac_control -> bool
+
diff --git a/vernac/vernacstate.ml b/vernac/vernacstate.ml
new file mode 100644
index 000000000..4980333b5
--- /dev/null
+++ b/vernac/vernacstate.ml
@@ -0,0 +1,41 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+type t = {
+  system  : States.state;        (* summary + libstack *)
+  proof   : Proof_global.t;      (* proof state *)
+  shallow : bool                 (* is the state trimmed down (libstack) *)
+}
+
+let s_cache = ref None
+let s_proof = ref None
+
+let invalidate_cache () =
+  s_cache := None;
+  s_proof := None
+
+let update_cache rf v =
+  rf := Some v; v
+
+let do_if_not_cached rf f v =
+  match !rf with
+  | None ->
+    rf := Some v; f v
+  | Some vc when vc != v ->
+    rf := Some v; f v
+  | Some _ ->
+    ()
+
+let freeze_interp_state marshallable =
+  { system = update_cache s_cache (States.freeze ~marshallable);
+    proof  = update_cache s_proof (Proof_global.freeze ~marshallable);
+    shallow = marshallable = `Shallow }
+
+let unfreeze_interp_state { system; proof } =
+  do_if_not_cached s_cache States.unfreeze system;
+  do_if_not_cached s_proof Proof_global.unfreeze proof
diff --git a/vernac/vernacstate.mli b/vernac/vernacstate.mli
new file mode 100644
index 000000000..3ed27ddb7
--- /dev/null
+++ b/vernac/vernacstate.mli
@@ -0,0 +1,19 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, *   INRIA - CNRS - LIX - LRI - PPS - Copyright 1999-2017     *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+type t = {
+  system  : States.state;        (* summary + libstack *)
+  proof   : Proof_global.t;      (* proof state *)
+  shallow : bool                 (* is the state trimmed down (libstack) *)
+}
+
+val freeze_interp_state : Summary.marshallable -> t
+val unfreeze_interp_state : t -> unit
+
+(* WARNING: Do not use, it will go away in future releases *)
+val invalidate_cache : unit -> unit